rickub
nandi/jolt-nativepublic⑂ Fork 0
⑂ 6a3304ddddcc7d3e9486b470fea5933a1f81f8e8
Branches
main View all branches → View all tags →
Commits
⬇ Clone ▾
git clone https://git.rickub.com/nandi/jolt-native.git
git clone ssh://git@rickub.com/nandi/jolt-native.git

Host key fingerprint (ed25519): SHA256:iycHnxEyq0Q7uyVpB7JlznP0G7JrTPXLYRcAU5CSLhc — verify it before your first connect.

x11.clj · 114 lines · 5.6 KBClojure Blame HistoryRaw
Paint glimmer with nothing under it f554a01 nandi 12d ago1(ns glimmer-gfx.x11
2 "The port layer: Xlib through jolt.ffi, with no toolkit under it. Opens a
3 surface, blits an int-array, reports the mouse; it draws nothing itself.
4
5 `run-window` is the loop glimmer-gfx.core drives; nothing else in this
6 project talks to X."
7 (:require [glimmer-gfx.raster :as r] [jolt.ffi :as ffi]))
8
9(ffi/defcfn x-open "XOpenDisplay" [:pointer] :pointer)
10(ffi/defcfn x-screen "XDefaultScreen" [:pointer] :int)
11(ffi/defcfn x-root "XRootWindow" [:pointer :int] :ulong)
12(ffi/defcfn x-visual "XDefaultVisual" [:pointer :int] :pointer)
13(ffi/defcfn x-gc "XDefaultGC" [:pointer :int] :pointer)
14(ffi/defcfn x-depth "XDefaultDepth" [:pointer :int] :int)
15(ffi/defcfn x-black "XBlackPixel" [:pointer :int] :ulong)
16(ffi/defcfn x-create "XCreateSimpleWindow"
17 [:pointer :ulong :int :int :uint :uint :uint :ulong :ulong] :ulong)
18(ffi/defcfn x-select "XSelectInput" [:pointer :ulong :long] :int)
19(ffi/defcfn x-map "XMapWindow" [:pointer :ulong] :int)
20(ffi/defcfn x-store-name "XStoreName" [:pointer :ulong :pointer] :int)
21(ffi/defcfn x-atom "XInternAtom" [:pointer :string :int] :ulong)
22(ffi/defcfn x-protocols "XSetWMProtocols" [:pointer :ulong :pointer :int] :int)
23(ffi/defcfn x-image "XCreateImage"
24 [:pointer :pointer :uint :int :int :pointer :uint :uint :int :int] :pointer)
25(ffi/defcfn x-put "XPutImage"
26 [:pointer :ulong :pointer :pointer :int :int :int :int :uint :uint] :int)
27(ffi/defcfn x-flush "XFlush" [:pointer] :int)
28(ffi/defcfn x-pending "XPending" [:pointer] :int)
29(ffi/defcfn x-next "XNextEvent" [:pointer :pointer] :int)
30(ffi/defcfn x-close "XCloseDisplay" [:pointer] :int)
Play three games on the gfx backend e98a184 nandi 11d ago31(ffi/defcfn x-keysym "XLookupKeysym" [:pointer :int] :ulong)
32;; Without this a held key repeats as release/press pairs, and a frame can catch
33;; the key up. Detectable repeat suppresses the synthetic releases.
34(ffi/defcfn x-detectable-repeat "XkbSetDetectableAutoRepeat"
35 [:pointer :int :pointer] :int)
Paint glimmer with nothing under it f554a01 nandi 12d ago36
37(def ^:private ZPixmap 2)
Play three games on the gfx backend e98a184 nandi 11d ago38(def ^:private event-mask (bit-or 32768 4 8 64 131072 1 2)) ; expose|btn|motion|structure|key
Paint glimmer with nothing under it f554a01 nandi 12d ago39
40;; XEvent is a 192-byte union. Offsets verified against X11/Xlib.h with
41;; offsetof on x86-64 -- do not infer one struct's layout from another's:
42;; XButtonEvent x=64 y=68
43;; XClientMessageEvent message_type=40 format=48 data=56
44;; XClientMessageEvent has no root/subwindow/time, so its data sits 16 bytes
45;; earlier than a pointer event's coordinates would suggest. Reading it at 72
46;; is why the window close button did nothing: the atom never compared equal.
47(def ^:private EV-SIZE 192)
48(def ^:private EV-X 64) (def ^:private EV-Y 68) (def ^:private EV-DATA 56)
49(def ^:private PRESS 4) (def ^:private RELEASE 5)
50(def ^:private MOTION 6) (def ^:private CLIENT 33)
Play three games on the gfx backend e98a184 nandi 11d ago51(def ^:private KEY-DOWN 2) (def ^:private KEY-UP 3)
Paint glimmer with nothing under it f554a01 nandi 12d ago52
53(defn- drain!
54 "Fold every queued X event into the input map. :quit? on window close."
55 [dpy ev input wm-delete]
56 (loop [in input]
57 (if (zero? (x-pending dpy))
58 in
59 (do (x-next dpy ev)
60 (let [t (ffi/read ev :int 0)
61 p [(ffi/read ev :int EV-X) (ffi/read ev :int EV-Y)]]
62 (recur (condp = t
63 PRESS (assoc in :down? true :mouse p)
64 RELEASE (assoc in :down? false :released? true :mouse p)
65 MOTION (assoc in :mouse p)
Play three games on the gfx backend e98a184 nandi 11d ago66 ;; the keysym, not the raw keycode: it is what the user's
67 ;; own layout says the key means.
68 KEY-DOWN (update in :keys conj (x-keysym ev 0))
69 KEY-UP (update in :keys disj (x-keysym ev 0))
Paint glimmer with nothing under it f554a01 nandi 12d ago70 CLIENT (cond-> in
71 (= wm-delete (ffi/read ev :ulong EV-DATA))
72 (assoc :quit? true))
73 in)))))))
74
75(defn run-window
76 "Open a window and run `frame-fn` once per frame until it closes.
77
78 frame-fn is (fn [buf input] ...) -- it paints into `buf`; the loop blits.
79 :auto-quit-ms closes the window on a timer, for tests."
80 [{:keys [width height title auto-quit-ms] :or {width 480 height 320 title "gfx"}}
81 frame-fn]
82 (let [dpy (x-open ffi/null)]
83 (when (ffi/null? dpy)
84 (throw (ex-info "no X display -- is DISPLAY set?" {})))
85 (let [scr (x-screen dpy)
86 win (x-create dpy (x-root dpy scr) 0 0 width height 0
87 (x-black dpy scr) (x-black dpy scr))
88 gc (x-gc dpy scr)
89 data (ffi/alloc (* width height 4))
90 img (x-image dpy (x-visual dpy scr) (x-depth dpy scr) ZPixmap 0
91 data width height 32 0)
92 ev (ffi/alloc EV-SIZE)
93 prot (ffi/alloc 8)
94 wm-delete (x-atom dpy "WM_DELETE_WINDOW" 0)
95 buf (r/buf width height)
96 deadline (when auto-quit-ms (+ (System/currentTimeMillis) auto-quit-ms))]
97 (ffi/write prot :ulong wm-delete 0)
98 (x-protocols dpy win prot 1)
99 (ffi/with-c-string [t title] (x-store-name dpy win t))
100 (x-select dpy win event-mask)
101 (x-map dpy win)
102 (try
Play three games on the gfx backend e98a184 nandi 11d ago103 (x-detectable-repeat dpy 1 ffi/null)
104 (loop [input {:mouse [0 0] :down? false :released? false :keys #{}}]
Paint glimmer with nothing under it f554a01 nandi 12d ago105 (let [input (drain! dpy ev input wm-delete)]
106 (frame-fn buf input)
107 (ffi/write-array data :int (:px buf))
108 (x-put dpy win gc img 0 0 0 0 width height)
109 (x-flush dpy)
110 (Thread/sleep 16)
111 (when-not (or (:quit? input)
112 (and deadline (> (System/currentTimeMillis) deadline)))
113 (recur (assoc input :released? false)))))
114 (finally (ffi/free data) (ffi/free ev) (ffi/free prot) (x-close dpy))))))