(in-package :cl-user)
(use-package :noffi)
(noffi-syntax)

#_{#include <X11/Xlib.h>}

;; Try to load libX11 somehow, this still is somewhat system dependent.

#+(AND CCL LINUX)       (ccl:open-shared-library "libX11.so")
#+(AND CCL DARWIN)      (ccl:open-shared-library "libX11.dylib")

(defun run ()
  (let* ((w 800) (h 600)
         (dpy (#_XOpenDisplay nil))
         (screen (#_DefaultScreen dpy))
         (fg (#_WhitePixel dpy screen))
         (bg (#_BlackPixel dpy screen))
         (win (#_XCreateSimpleWindow dpy (#_DefaultRootWindow dpy)
                                     0 0 800 600 0
                                     fg bg))
         (gc (#_XCreateGC dpy win 0 nil)))
    (#_XSetForeground dpy gc fg)
    (#_XSetBackground dpy gc bg)
    (#_XSelectInput dpy win (logior #_ExposureMask #_StructureNotifyMask))
    (#_XStoreName dpy win "Noffi Demo")
    (#_XMapWindow dpy win)
    (labels ((repaint ()
               (loop for i from 1 below 19
                     do (loop for j from 1 below 19
                              do (#_XDrawLine dpy win gc
                                              (floor (* w (/ i 20)))
                                              (floor (* 1/10 h))
                                              (floor (* w (/ j 20)))
                                              (floor (* 9/10 h)))))))
      (clet ((ev #_<XEvent*>))
        (unwind-protect
             (loop
               ;; For CCL, while we are in foreign land, interrupts are disabled, work
               ;; around this by blocking on our own.
               #+CCL
               (when (zerop (#_XPending dpy))
                 (do () ((ccl::fd-input-available-p (#_ConnectionNumber dpy)))))
               (#_XNextEvent dpy ev)
               (let ((type (#_.type ev)))
                 (cond ((= #_ConfigureNotify type)
                        (setf (values w h)
                              (values (#_.xconfigure.width ev)
                                      (#_.xconfigure.height ev))))
                       ((= #_Expose type)
                        (repaint)))))
          (#_XCloseDisplay dpy))))))