(ns glimmer-gfx.x11
  "The port layer: Xlib through jolt.ffi, with no toolkit under it. Opens a
   surface, blits an int-array, reports the mouse; it draws nothing itself.

   `run-window` is the loop glimmer-gfx.core drives; nothing else in this
   project talks to X."
  (:require [glimmer-gfx.raster :as r] [jolt.ffi :as ffi]))

(ffi/defcfn x-open      "XOpenDisplay"    [:pointer] :pointer)
(ffi/defcfn x-screen    "XDefaultScreen"  [:pointer] :int)
(ffi/defcfn x-root      "XRootWindow"     [:pointer :int] :ulong)
(ffi/defcfn x-visual    "XDefaultVisual"  [:pointer :int] :pointer)
(ffi/defcfn x-gc        "XDefaultGC"      [:pointer :int] :pointer)
(ffi/defcfn x-depth     "XDefaultDepth"   [:pointer :int] :int)
(ffi/defcfn x-black     "XBlackPixel"     [:pointer :int] :ulong)
(ffi/defcfn x-create    "XCreateSimpleWindow"
  [:pointer :ulong :int :int :uint :uint :uint :ulong :ulong] :ulong)
(ffi/defcfn x-select    "XSelectInput"    [:pointer :ulong :long] :int)
(ffi/defcfn x-map       "XMapWindow"      [:pointer :ulong] :int)
(ffi/defcfn x-store-name "XStoreName"     [:pointer :ulong :pointer] :int)
(ffi/defcfn x-atom      "XInternAtom"     [:pointer :string :int] :ulong)
(ffi/defcfn x-protocols "XSetWMProtocols" [:pointer :ulong :pointer :int] :int)
(ffi/defcfn x-image     "XCreateImage"
  [:pointer :pointer :uint :int :int :pointer :uint :uint :int :int] :pointer)
(ffi/defcfn x-put       "XPutImage"
  [:pointer :ulong :pointer :pointer :int :int :int :int :uint :uint] :int)
(ffi/defcfn x-flush     "XFlush"          [:pointer] :int)
(ffi/defcfn x-pending   "XPending"        [:pointer] :int)
(ffi/defcfn x-next      "XNextEvent"      [:pointer :pointer] :int)
(ffi/defcfn x-close     "XCloseDisplay"   [:pointer] :int)
(ffi/defcfn x-keysym    "XLookupKeysym"   [:pointer :int] :ulong)
;; Without this a held key repeats as release/press pairs, and a frame can catch
;; the key up. Detectable repeat suppresses the synthetic releases.
(ffi/defcfn x-detectable-repeat "XkbSetDetectableAutoRepeat"
  [:pointer :int :pointer] :int)

(def ^:private ZPixmap 2)
(def ^:private event-mask (bit-or 32768 4 8 64 131072 1 2))  ; expose|btn|motion|structure|key

;; XEvent is a 192-byte union. Offsets verified against X11/Xlib.h with
;; offsetof on x86-64 -- do not infer one struct's layout from another's:
;;   XButtonEvent        x=64  y=68
;;   XClientMessageEvent message_type=40 format=48 data=56
;; XClientMessageEvent has no root/subwindow/time, so its data sits 16 bytes
;; earlier than a pointer event's coordinates would suggest. Reading it at 72
;; is why the window close button did nothing: the atom never compared equal.
(def ^:private EV-SIZE 192)
(def ^:private EV-X 64) (def ^:private EV-Y 68) (def ^:private EV-DATA 56)
(def ^:private PRESS 4) (def ^:private RELEASE 5)
(def ^:private MOTION 6) (def ^:private CLIENT 33)
(def ^:private KEY-DOWN 2) (def ^:private KEY-UP 3)

(defn- drain!
  "Fold every queued X event into the input map. :quit? on window close."
  [dpy ev input wm-delete]
  (loop [in input]
    (if (zero? (x-pending dpy))
      in
      (do (x-next dpy ev)
          (let [t (ffi/read ev :int 0)
                p [(ffi/read ev :int EV-X) (ffi/read ev :int EV-Y)]]
            (recur (condp = t
                     PRESS   (assoc in :down? true  :mouse p)
                     RELEASE (assoc in :down? false :released? true :mouse p)
                     MOTION  (assoc in :mouse p)
                     ;; the keysym, not the raw keycode: it is what the user's
                     ;; own layout says the key means.
                     KEY-DOWN (update in :keys conj (x-keysym ev 0))
                     KEY-UP   (update in :keys disj (x-keysym ev 0))
                     CLIENT  (cond-> in
                               (= wm-delete (ffi/read ev :ulong EV-DATA))
                               (assoc :quit? true))
                     in)))))))

(defn run-window
  "Open a window and run `frame-fn` once per frame until it closes.

   frame-fn is (fn [buf input] ...) -- it paints into `buf`; the loop blits.
   :auto-quit-ms closes the window on a timer, for tests."
  [{:keys [width height title auto-quit-ms] :or {width 480 height 320 title "gfx"}}
   frame-fn]
  (let [dpy (x-open ffi/null)]
    (when (ffi/null? dpy)
      (throw (ex-info "no X display -- is DISPLAY set?" {})))
    (let [scr  (x-screen dpy)
          win  (x-create dpy (x-root dpy scr) 0 0 width height 0
                         (x-black dpy scr) (x-black dpy scr))
          gc   (x-gc dpy scr)
          data (ffi/alloc (* width height 4))
          img  (x-image dpy (x-visual dpy scr) (x-depth dpy scr) ZPixmap 0
                        data width height 32 0)
          ev   (ffi/alloc EV-SIZE)
          prot (ffi/alloc 8)
          wm-delete (x-atom dpy "WM_DELETE_WINDOW" 0)
          buf  (r/buf width height)
          deadline (when auto-quit-ms (+ (System/currentTimeMillis) auto-quit-ms))]
      (ffi/write prot :ulong wm-delete 0)
      (x-protocols dpy win prot 1)
      (ffi/with-c-string [t title] (x-store-name dpy win t))
      (x-select dpy win event-mask)
      (x-map dpy win)
      (try
        (x-detectable-repeat dpy 1 ffi/null)
        (loop [input {:mouse [0 0] :down? false :released? false :keys #{}}]
          (let [input (drain! dpy ev input wm-delete)]
            (frame-fn buf input)
            (ffi/write-array data :int (:px buf))
            (x-put dpy win gc img 0 0 0 0 width height)
            (x-flush dpy)
            (Thread/sleep 16)
            (when-not (or (:quit? input)
                          (and deadline (> (System/currentTimeMillis) deadline)))
              (recur (assoc input :released? false)))))
        (finally (ffi/free data) (ffi/free ev) (ffi/free prot) (x-close dpy))))))