nandi/jolt-native · core.clj

⑂ 7703c757d45b22224a0423d7b0dc4699a8ca2f9e

core.clj · 288 lines · 9.5 KBClojure    Blame HistoryRaw
glimmer-cosmic: a libcosmic backend for glimmer (spike)   1(ns glimmer-cosmic.core
"The libcosmic backend for glimmer. Requiring this namespace installs it:
  (ns myapp
    (:require [glimmer.core :as ui]
              [glimmer-cosmic.core]))       ; installs this backend
  (defn -main [& _] (ui/run my-app :title \"myapp\"))
The tree half is glimmer-vidya's: node handles in a Rust arena, props written
across, handlers kept here and found by node id when an event comes back.
The loop half is inverted. libcosmic will not be driven a frame at a time —
it takes the main thread and keeps it until the window closes — so `run`
blocks the main thread there and the reconciler lives on a worker. The worker
is \"the UI thread\" as far as glimmer is concerned: `schedule` queues onto it,
handlers run on it, and at the end of each pass it commits, which is the only
moment libcosmic sees what changed."
(:require [glimmer.backend :as b]
          [glimmer-cosmic.ffi :as ffi]))
22;; Node id -> the :on-* props that node was last rendered with.
23(defonce ^:private handlers (atom {}))
25;; Work posted from other threads, run on the worker at the top of a pass.
26(defonce ^:private pending (atom []))
28(defonce ^:private quit-requested (atom false))
30;; --- props -------------------------------------------------------------------
31(def ^:private tag-orientation {:hbox "horizontal" :vbox "vertical"})
33(defn- handler-key? [k]
(let [s (name k)]
  (and (> (count s) 3) (= "on-" (subs s 0 3)))))
37(defn- set-prop! [node k v]
(let [key (name k)]
39
    (nil? v)     nil
    (true? v)    (ffi/node-set-bool! node key true)
    (false? v)   (ffi/node-set-bool! node key false)
    (number? v)  (ffi/node-set-num! node key (double v))
    (string? v)  (ffi/node-set-str! node key v)
    (keyword? v) (ffi/node-set-str! node key (name v))
    :else        (ffi/node-set-str! node key (str v)))))
48(defn- write-props!
"Replace a node's props with `props`, cleared first so a prop a re-render
stops setting is gone — and so the value libcosmic wrote back when someone
typed is overwritten by the component's own state."
[node tag props]
(ffi/node-clear-props! node)
(when-let [orientation (tag-orientation tag)]
  (when-not (contains? props :orientation)
    (ffi/node-set-str! node "orientation" orientation)))
(doseq [[k v] props]
  (when-not (handler-key? k)
    (set-prop! node k v)))
(swap! handlers assoc node
       (reduce (fn [acc [k v]]
                 (if (and (handler-key? k) (fn? v)) (assoc acc k v) acc))
               props))
67(defn- forget-dead-handlers! []
(swap! handlers
       (fn [m]
         (reduce (fn [acc [id hs]]
                   (if (ffi/node-exists? id) (assoc acc id hs) acc))
76;; --- the backend operations --------------------------------------------------
77(defn- create! [tag props]
(let [node (ffi/node-new (name tag))]
  (when (zero? node)
    (throw (ex-info "jolt-cosmic could not allocate a node" {:tag tag})))
  (write-props! node tag props)
82
84(defn- apply-props! [tag node props] (write-props! node tag props))
86(defn- append-child! [_parent-tag parent child]
(ffi/node-append! parent child)
90(defn- remove-child! [_parent-tag parent child]
(ffi/node-remove! parent child)
(forget-dead-handlers!)
95(defn- replace-child! [_parent-tag parent old-child new-child]
(ffi/node-replace! parent old-child new-child)
(forget-dead-handlers!)
100(defn- reorder-child! [_parent-tag parent child sibling]
(ffi/node-insert-after! parent child (or sibling 0))
104;; --- the worker --------------------------------------------------------------
105(defn- schedule
"glimmer.backend's :schedule. Queues `work` for the worker and wakes it, so a
`swap!` from anywhere re-renders on the next pass rather than the next
timeout."
109
(swap! pending conj work)
(ffi/wake!)
114(defn- drain! []
115
  (let [q @pending]
    (when (seq q)
      (if (compare-and-set! pending q [])
        (doseq [f q] (f))
        (recur))))))
122;; --- timers ------------------------------------------------------------------
123(defonce ^:private timers (atom {:next-id 0 :entries {}}))
125(defn- now-ms [] (System/currentTimeMillis))
127(defn- add-timer! [ms every? f]
(let [id (:next-id (swap! timers update :next-id inc))]
  (swap! timers assoc-in [:entries id]
         {:due (+ (now-ms) ms) :every (when every? ms) :f f})
  (ffi/wake!)
132
134(defn after!
"Run `f` on the worker in about `ms` milliseconds. Returns an id for
`cancel!`."
[ms f] (add-timer! ms false f))
139(defn every!
"Run `f` on the worker about every `ms` milliseconds until cancelled."
[ms f] (add-timer! ms true f))
143(defn cancel! [id] (swap! timers update :entries dissoc id) nil)
145(defn cancel-all! [] (swap! timers assoc :entries {}) nil)
147(defn- pump-timers! []
(let [t (now-ms)
      due (reduce (fn [acc [id e]] (if (<= (:due e) t) (conj acc [id e]) acc))
                  (:entries @timers))]
  (doseq [[id e] due]
    (if-let [period (:every e)]
      (swap! timers assoc-in [:entries id :due] (+ t period))
      (swap! timers update :entries dissoc id))
    ((:f e)))
157
159(defn- next-timeout
"How long the worker may sleep: until the nearest timer, capped so a quit or
an auto-quit deadline is noticed within a quarter second."
(let [dues (map :due (vals (:entries @timers)))]
  (if (seq dues)
    (max 0 (min 250 (- (apply min dues) (now-ms))))
168;; --- events ------------------------------------------------------------------
169(defn- dispatch-events! []
170
  (when (ffi/poll-event!)
    (let [node (ffi/event-node)
          kind (ffi/event-name)
          hs (get @handlers node)]
      (case kind
        "click"    (when-let [f (:on-click hs)] (f))
        "toggled"  (when-let [f (:on-toggled hs)] (f))
        "change"   (when-let [f (:on-change hs)] (f (ffi/event-text)))
        "activate" (when-let [f (:on-activate hs)] (f))
Paint the rest of frq's tags in glimmer-cosmic   180          ;; The two edges of a hover, as glimmer-vidya sends them: once when
        ;; the pointer comes onto the widget and once when it leaves.
        "hover"    (when-let [f (:on-hover hs)] (f))
        "unhover"  (when-let [f (:on-unhover hs)] (f))
glimmer-cosmic: a libcosmic backend for glimmer (spike)   184          nil))
    (recur))))
187;; --- running -----------------------------------------------------------------
188(defn- clear-children! [node]
189
  (when (pos? (ffi/node-child-count node))
    (ffi/node-remove! node (ffi/node-child-at node 0))
    (recur)))
(forget-dead-handlers!)
196(defn quit!
"Close the window; `run` returns once libcosmic has."
(reset! quit-requested true)
(ffi/quit!)
203(defn- work-loop
"The worker: sleep until something happens, then run queued work, handlers
and timers, and publish whatever they changed in one commit."
[started auto-quit-ms]
  (loop []
    (ffi/wait! (next-timeout))
    (drain!)
    (dispatch-events!)
    (pump-timers!)
    (ffi/commit!)
    (when (and auto-quit-ms (>= (- (now-ms) started) auto-quit-ms))
      (quit!))
    (when-not (ffi/should-close?)
      (recur)))
  (finally
    ;; A handler that throws takes the window with it, rather than leaving
    ;; one on screen that nothing is listening to.
    (ffi/quit!))))
223(defn- run!
"glimmer.backend's :run. Mounts the root component, starts the worker, and
blocks the calling thread — which must be the main thread — in libcosmic
until the window closes or `quit!` is called.
Options (on top of glimmer's own :title :width :height :auto-quit-ms):
  :mode   :system (default), :dark or :light"
[opts mount-root!]
(let [{:keys [title width height mode auto-quit-ms]
       :or {title "glimmer" width 900 height 640}} opts
      root (ffi/tree-root)
      started (now-ms)]
  (reset! quit-requested false)
  ;; Mounted here, before the loop, so it reconciles inline; the first commit
  ;; is what libcosmic opens with.
  (clear-children! root)
  (mount-root! root :window)
  (ffi/commit!)
  (reset! b/loop-running? true)
  (let [worker (future (work-loop started auto-quit-ms))
        status (ffi/run! width height title
                         (case mode
                           :dark ffi/dark-mode
                           :light ffi/light-mode
                           ffi/system-mode))]
248
      ;; Rethrows whatever ended the worker, on the thread that called run.
      @worker
      (finally
        (reset! b/loop-running? false)
        (cancel-all!)
        (reset! handlers {})))
    (when-not (zero? status)
      (throw (ex-info "jolt-cosmic's window did not run cleanly"
                      {:status status}))))))
259;; --- looking at what was rendered --------------------------------------------
260(defn dump-str
"The tree as it is in the arena — after the reconciler, before any commit —
as hiccup text."
([] (dump-str 0))
([node] (ffi/tree-dump node)))
266
([] (dump 0))
([node] (read-string (dump-str node))))
270(defn dump!
([] (dump! 0))
([node] (println (dump-str node)) nil))
274;; --- the backend -------------------------------------------------------------
275(def backend
{:name           :cosmic
 :create!        create!
 :apply-props!   apply-props!
 :append-child!  append-child!
 :remove-child!  remove-child!
 :replace-child! replace-child!
 :reorder-child! reorder-child!
 :schedule       schedule
 :run            run!})
286(defn install! [] (b/register! backend) nil)
288(defonce ^:private installed (do (install!) true))

glimmer-cosmic: a libcosmic backend for glimmer (spike) 6a3304d nandi 8d ago	1	(ns glimmer-cosmic.core
	2	"The libcosmic backend for glimmer. Requiring this namespace installs it:
	3
	4	(ns myapp
	5	(:require [glimmer.core :as ui]
	6	[glimmer-cosmic.core])) ; installs this backend
	7
	8	(defn -main [& _] (ui/run my-app :title \"myapp\"))
	9
	10	The tree half is glimmer-vidya's: node handles in a Rust arena, props written
	11	across, handlers kept here and found by node id when an event comes back.
	12
	13	The loop half is inverted. libcosmic will not be driven a frame at a time —
	14	it takes the main thread and keeps it until the window closes — so `run`
	15	blocks the main thread there and the reconciler lives on a worker. The worker
	16	is \"the UI thread\" as far as glimmer is concerned: `schedule` queues onto it,
	17	handlers run on it, and at the end of each pass it commits, which is the only
	18	moment libcosmic sees what changed."
	19	(:require [glimmer.backend :as b]
	20	[glimmer-cosmic.ffi :as ffi]))
	21
	22	;; Node id -> the :on-* props that node was last rendered with.
	23	(defonce ^:private handlers (atom {}))
	24
	25	;; Work posted from other threads, run on the worker at the top of a pass.
	26	(defonce ^:private pending (atom []))
	27
	28	(defonce ^:private quit-requested (atom false))
	29
	30	;; --- props -------------------------------------------------------------------
	31	(def ^:private tag-orientation {:hbox "horizontal" :vbox "vertical"})
	32
	33	(defn- handler-key? [k]
	34	(let [s (name k)]
	35	(and (> (count s) 3) (= "on-" (subs s 0 3)))))
	36
	37	(defn- set-prop! [node k v]
	38	(let [key (name k)]
	39	(cond
	40	(nil? v) nil
	41	(true? v) (ffi/node-set-bool! node key true)
	42	(false? v) (ffi/node-set-bool! node key false)
	43	(number? v) (ffi/node-set-num! node key (double v))
	44	(string? v) (ffi/node-set-str! node key v)
	45	(keyword? v) (ffi/node-set-str! node key (name v))
	46	:else (ffi/node-set-str! node key (str v)))))
	47
	48	(defn- write-props!
	49	"Replace a node's props with `props`, cleared first so a prop a re-render
	50	stops setting is gone — and so the value libcosmic wrote back when someone
	51	typed is overwritten by the component's own state."
	52	[node tag props]
	53	(ffi/node-clear-props! node)
	54	(when-let [orientation (tag-orientation tag)]
	55	(when-not (contains? props :orientation)
	56	(ffi/node-set-str! node "orientation" orientation)))
	57	(doseq [[k v] props]
	58	(when-not (handler-key? k)
	59	(set-prop! node k v)))
	60	(swap! handlers assoc node
	61	(reduce (fn [acc [k v]]
	62	(if (and (handler-key? k) (fn? v)) (assoc acc k v) acc))
	63	{}
	64	props))
65	nil)
66
67	(defn- forget-dead-handlers! []
68	(swap! handlers
69	(fn [m]
70	(reduce (fn [acc [id hs]]
71	(if (ffi/node-exists? id) (assoc acc id hs) acc))
72	{}
73	m)))
74	nil)
75
76	;; --- the backend operations --------------------------------------------------
77	(defn- create! [tag props]
78	(let [node (ffi/node-new (name tag))]
79	(when (zero? node)
80	(throw (ex-info "jolt-cosmic could not allocate a node" {:tag tag})))
81	(write-props! node tag props)
82	node))
83
84	(defn- apply-props! [tag node props] (write-props! node tag props))
85
86	(defn- append-child! [_parent-tag parent child]
87	(ffi/node-append! parent child)
88	nil)
89
90	(defn- remove-child! [_parent-tag parent child]
91	(ffi/node-remove! parent child)
92	(forget-dead-handlers!)
93	nil)
94
95	(defn- replace-child! [_parent-tag parent old-child new-child]
96	(ffi/node-replace! parent old-child new-child)
97	(forget-dead-handlers!)
98	nil)
99
100	(defn- reorder-child! [_parent-tag parent child sibling]
101	(ffi/node-insert-after! parent child (or sibling 0))
102	nil)
103
104	;; --- the worker --------------------------------------------------------------
105	(defn- schedule
106	"glimmer.backend's :schedule. Queues `work` for the worker and wakes it, so a
107	`swap!` from anywhere re-renders on the next pass rather than the next
108	timeout."
109	[work]
110	(swap! pending conj work)
111	(ffi/wake!)
112	nil)
113
114	(defn- drain! []
115	(loop []
116	(let [q @pending]
117	(when (seq q)
118	(if (compare-and-set! pending q [])
119	(doseq [f q] (f))
120	(recur))))))
121
122	;; --- timers ------------------------------------------------------------------
123	(defonce ^:private timers (atom {:next-id 0 :entries {}}))
124
125	(defn- now-ms [] (System/currentTimeMillis))
126
127	(defn- add-timer! [ms every? f]
128	(let [id (:next-id (swap! timers update :next-id inc))]
129	(swap! timers assoc-in [:entries id]
130	{:due (+ (now-ms) ms) :every (when every? ms) :f f})
131	(ffi/wake!)
132	id))
133
134	(defn after!
135	"Run `f` on the worker in about `ms` milliseconds. Returns an id for
136	`cancel!`."
137	[ms f] (add-timer! ms false f))
138
139	(defn every!
140	"Run `f` on the worker about every `ms` milliseconds until cancelled."
141	[ms f] (add-timer! ms true f))
142
143	(defn cancel! [id] (swap! timers update :entries dissoc id) nil)
144
145	(defn cancel-all! [] (swap! timers assoc :entries {}) nil)
146
147	(defn- pump-timers! []
148	(let [t (now-ms)
149	due (reduce (fn [acc [id e]] (if (<= (:due e) t) (conj acc [id e]) acc))
150	[]
151	(:entries @timers))]
152	(doseq [[id e] due]
153	(if-let [period (:every e)]
154	(swap! timers assoc-in [:entries id :due] (+ t period))
155	(swap! timers update :entries dissoc id))
156	((:f e)))
157	nil))
158
159	(defn- next-timeout
160	"How long the worker may sleep: until the nearest timer, capped so a quit or
161	an auto-quit deadline is noticed within a quarter second."
162	[]
163	(let [dues (map :due (vals (:entries @timers)))]
164	(if (seq dues)
165	(max 0 (min 250 (- (apply min dues) (now-ms))))
166	250)))
167
168	;; --- events ------------------------------------------------------------------
169	(defn- dispatch-events! []
170	(loop []
171	(when (ffi/poll-event!)
172	(let [node (ffi/event-node)
173	kind (ffi/event-name)
174	hs (get @handlers node)]
175	(case kind
176	"click" (when-let [f (:on-click hs)] (f))
177	"toggled" (when-let [f (:on-toggled hs)] (f))
178	"change" (when-let [f (:on-change hs)] (f (ffi/event-text)))
179	"activate" (when-let [f (:on-activate hs)] (f))
Paint the rest of frq's tags in glimmer-cosmic 7703c75 nandi 8d ago	180	;; The two edges of a hover, as glimmer-vidya sends them: once when
	181	;; the pointer comes onto the widget and once when it leaves.
	182	"hover" (when-let [f (:on-hover hs)] (f))
	183	"unhover" (when-let [f (:on-unhover hs)] (f))
glimmer-cosmic: a libcosmic backend for glimmer (spike) 6a3304d nandi 8d ago	184	nil))
	185	(recur))))
	186
	187	;; --- running -----------------------------------------------------------------
	188	(defn- clear-children! [node]
	189	(loop []
	190	(when (pos? (ffi/node-child-count node))
	191	(ffi/node-remove! node (ffi/node-child-at node 0))
	192	(recur)))
	193	(forget-dead-handlers!)
	194	nil)
	195
	196	(defn quit!
	197	"Close the window; `run` returns once libcosmic has."
	198	[]
	199	(reset! quit-requested true)
	200	(ffi/quit!)
	201	nil)
	202
	203	(defn- work-loop
	204	"The worker: sleep until something happens, then run queued work, handlers
	205	and timers, and publish whatever they changed in one commit."
	206	[started auto-quit-ms]
	207	(try
	208	(loop []
	209	(ffi/wait! (next-timeout))
	210	(drain!)
	211	(dispatch-events!)
	212	(pump-timers!)
	213	(ffi/commit!)
	214	(when (and auto-quit-ms (>= (- (now-ms) started) auto-quit-ms))
	215	(quit!))
	216	(when-not (ffi/should-close?)
	217	(recur)))
	218	(finally
	219	;; A handler that throws takes the window with it, rather than leaving
	220	;; one on screen that nothing is listening to.
	221	(ffi/quit!))))
	222
	223	(defn- run!
	224	"glimmer.backend's :run. Mounts the root component, starts the worker, and
	225	blocks the calling thread — which must be the main thread — in libcosmic
	226	until the window closes or `quit!` is called.
	227
	228	Options (on top of glimmer's own :title :width :height :auto-quit-ms):
	229	:mode :system (default), :dark or :light"
	230	[opts mount-root!]
	231	(let [{:keys [title width height mode auto-quit-ms]
	232	:or {title "glimmer" width 900 height 640}} opts
	233	root (ffi/tree-root)
	234	started (now-ms)]
	235	(reset! quit-requested false)
	236	;; Mounted here, before the loop, so it reconciles inline; the first commit
	237	;; is what libcosmic opens with.
	238	(clear-children! root)
	239	(mount-root! root :window)
	240	(ffi/commit!)
	241	(reset! b/loop-running? true)
	242	(let [worker (future (work-loop started auto-quit-ms))
	243	status (ffi/run! width height title
	244	(case mode
	245	:dark ffi/dark-mode
	246	:light ffi/light-mode
	247	ffi/system-mode))]
248	(try
249	;; Rethrows whatever ended the worker, on the thread that called run.
250	@worker
251	(finally
252	(reset! b/loop-running? false)
253	(cancel-all!)
254	(reset! handlers {})))
255	(when-not (zero? status)
256	(throw (ex-info "jolt-cosmic's window did not run cleanly"
257	{:status status}))))))
258
259	;; --- looking at what was rendered --------------------------------------------
260	(defn dump-str
261	"The tree as it is in the arena — after the reconciler, before any commit —
262	as hiccup text."
263	([] (dump-str 0))
264	([node] (ffi/tree-dump node)))
265
266	(defn dump
267	([] (dump 0))
268	([node] (read-string (dump-str node))))
269
270	(defn dump!
271	([] (dump! 0))
272	([node] (println (dump-str node)) nil))
273
274	;; --- the backend -------------------------------------------------------------
275	(def backend
276	{:name :cosmic
277	:create! create!
278	:apply-props! apply-props!
279	:append-child! append-child!
280	:remove-child! remove-child!
281	:replace-child! replace-child!
282	:reorder-child! reorder-child!
283	:schedule schedule
284	:run run!})
285
286	(defn install! [] (b/register! backend) nil)
287
288	(defonce ^:private installed (do (install!) true))