Mercurial > hg > indyvon
view src/net/kryshen/indyvon/core.clj @ 110:f3dedece38f3
Merged.
| author | Mikhail Kryshen <mikhail@kryshen.net> |
|---|---|
| date | Mon, 10 Oct 2011 01:58:35 +0300 |
| parents | 520aa5fa9286 491152048c89 |
| children | 441fe457fc2b |
line source
1 ;;
2 ;; Copyright 2010, 2011 Mikhail Kryshen <mikhail@kryshen.net>
3 ;;
4 ;; This file is part of Indyvon.
5 ;;
6 ;; Indyvon is free software: you can redistribute it and/or modify it
7 ;; under the terms of the GNU Lesser General Public License version 3
8 ;; only, as published by the Free Software Foundation.
9 ;;
10 ;; Indyvon is distributed in the hope that it will be useful, but
11 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
12 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
13 ;; Lesser General Public License for more details.
14 ;;
15 ;; You should have received a copy of the GNU Lesser General Public
16 ;; License along with Indyvon. If not, see
17 ;; <http://www.gnu.org/licenses/>.
18 ;;
20 (ns net.kryshen.indyvon.core
21 (:import
22 (java.awt Graphics2D RenderingHints Component Color Font Shape
23 Cursor EventQueue)
24 (java.awt.geom AffineTransform Point2D$Double Rectangle2D$Double Area)
25 (java.awt.event MouseListener MouseMotionListener
26 MouseWheelListener MouseWheelEvent)
27 (java.awt.font FontRenderContext)
28 java.util.concurrent.ConcurrentMap
29 com.google.common.collect.MapMaker))
31 ;;
32 ;; Layer context
33 ;;
35 (def ^{:dynamic true
36 :tag Graphics2D}
37 *graphics*)
39 (def ^{:dynamic true
40 :tag FontRenderContext}
41 *font-context*)
43 (def ^{:dynamic true
44 :doc "Width of the rendering area."}
45 *width*)
47 (def ^{:dynamic true
48 :doc "Height of the rendering area."}
49 *height*)
51 (def ^{:dynamic true
52 :tag Shape}
53 *clip*)
55 (def ^{:dynamic true
56 :doc "Time in nanoseconds when the rendering of the current
57 frame starts."}
58 *time*)
60 (def ^{:dynamic true
61 :doc "Encloses state that should be retained between repaints."}
62 *scene*)
64 (def ^{:dynamic true}
65 *event-dispatcher*)
67 (def ^{:dynamic true
68 :tag AffineTransform
69 :doc "Initial transform associated with the graphics context."}
70 *initial-transform*)
72 (def ^{:dynamic true
73 :tag AffineTransform
74 :doc "Inversion of the initial transform associated with
75 the graphics context."}
76 *inverse-initial-transform*)
78 (defrecord Theme [fore-color back-color alt-back-color border-color
79 shadow-color font])
81 ;; REMIND: use system colors, see java.awt.SystemColor.
82 (defn default-theme []
83 (Theme. Color/BLACK
84 Color/WHITE
85 (Color. 0xC8 0xD2 0xD8)
86 (Color. 0 0 0xC8)
87 (Color. 0x44 0x44 0x44)
88 (Font. "Sans" Font/PLAIN 12)))
90 (def ^{:dynamic true} *theme* (default-theme))
92 ;;
93 ;; Core protocols and types
94 ;;
96 (defprotocol Layer
97 "Basic UI element."
98 (render! [layer]
99 "Draws layer in the current *graphics* context.")
100 (geometry [layer]
101 "Returns the preferred layer Geometry."))
103 (defprotocol Geometry
104 "Describes geometry of a Layer. Prefer using the available
105 implementations (Size, FixedGeometry and NestedGeometry) over
106 extending this protocol directly as it is likely to be changed in
107 the future versions."
108 (width [geom] [geom height])
109 (height [geom] [geom width])
110 (anchor-x [geom h-align width]
111 "Returns the x coordinate of the anchor point for the specified
112 horizontal alignment and width, h-align could be :left, :center
113 or :right.")
114 (anchor-y [geom v-align height]
115 "Returns the y coordinate of the anchor point for the specified
116 vertical alignment and height, v-align could be :top, :center
117 or :bottom."))
119 (defrecord Size [width height]
120 Geometry
121 (width [_] width)
122 (width [_ _] width)
123 (height [_] height)
124 (height [_ _] height)
125 (anchor-x [_ h-align width]
126 (case h-align
127 :left 0
128 :center (/ width 2)
129 :right width))
130 (anchor-y [_ v-align height]
131 (case v-align
132 :top 0
133 :center (/ height 2)
134 :bottom height)))
136 (defrecord FixedGeometry [ax ay width height]
137 Geometry
138 (width [_] width)
139 (width [_ _] width)
140 (height [_] height)
141 (height [_ _] height)
142 (anchor-x [_ _ _] ax)
143 (anchor-y [_ _ _] ay))
145 (defrecord NestedGeometry [geometry top left bottom right]
146 Geometry
147 (width [_]
148 (+ left right (width geometry)))
149 (width [_ h]
150 (+ left right (width geometry (- h top bottom))))
151 (height [_]
152 (+ top bottom (height geometry)))
153 (height [_ w]
154 (+ top bottom (height geometry (- w left right))))
155 (anchor-x [_ h-align w]
156 (+ left (anchor-x geometry h-align (- w left right))))
157 (anchor-y [_ v-align h]
158 (+ top (anchor-y geometry v-align (- h top bottom)))))
160 (defrecord ScaledGeometry [geometry sx sy]
161 Geometry
162 (width [_]
163 (* sx (width geometry)))
164 (width [_ h]
165 (* sx (width geometry (/ h sy))))
166 (height [_]
167 (* sy (height geometry)))
168 (height [_ w]
169 (* sy (height geometry (/ w sx))))
170 (anchor-x [_ h-align w]
171 (* sx (anchor-x geometry h-align (/ w sx))))
172 (anchor-y [_ v-align h]
173 (* sy (anchor-y geometry v-align (/ h sy)))))
175 ;; TODO: modifiers
176 (defrecord MouseEvent [id when x y x-on-screen y-on-screen button
177 wheel-rotation])
179 ;; TODO: KeyEvent
181 (defprotocol EventDispatcher
182 (listen! [this component]
183 "Listen for events on the specified AWT Component.")
184 (create-dispatcher [this handle handlers]
185 "Returns new event dispatcher associated with the specified event
186 handlers (an event-id -> handler-fn map). Handle is used to
187 match the contexts between commits.")
188 (commit [this]
189 "Apply the registered handlers for event processing.")
190 (handle-picked? [this handle]
191 "Returns true if the specified handle received the :mouse-pressed
192 event and have not yet received :moused-released.")
193 (handle-hovered? [this handle]
194 "Returns true if the specified handle received the :mouse-entered
195 event and have not yet received :mouse-exited."))
197 (defn- assoc-cons [m key val]
198 (->> (get m key) (cons val) (assoc m key)))
200 ;;
201 ;; Observers
202 ;; The mechanism used by layers to request repaints
203 ;;
205 (def ^ConcurrentMap observers
206 (-> (MapMaker.) (.weakKeys) (.makeMap)))
208 (defn- cm-replace!
209 "Wrap ConcurrentMap replace method to treat nil value as absent
210 mapping. Use with maps that does not support nil values."
211 [^ConcurrentMap cmap key old new]
212 (if (nil? old)
213 (nil? (.putIfAbsent cmap key new))
214 (.replace cmap key old new)))
216 (defn- cm-swap!
217 "Atomically swaps the value associated with key in ConcurrentMap
218 to be (apply f current-value args). Returns the new value."
219 [^ConcurrentMap cmap key f & args]
220 (loop []
221 (let [old (.get cmap key)
222 new (apply f old args)]
223 (if (cm-replace! cmap key old new)
224 new
225 (recur)))))
227 (defn add-observer
228 "Add observer fn for the target. Watcher identifies the group of
229 observers and could be used to remove the group. Watcher is weakly
230 referenced, all associated observers will be removed when the
231 wathcer is removed by gc. The observer fn will be called with
232 watcher and target arguments and any additional arguments specified
233 in update call."
234 [watcher target f]
235 (cm-swap! observers watcher assoc-cons target f)
236 nil)
238 (defn remove-observers
239 "Remove group of observers associated with the specified watcher."
240 [watcher]
241 (.remove observers watcher)
242 nil)
244 (defn- replace-observers-watcher
245 [old-watcher new-watcher]
246 (if-let [old (.remove observers old-watcher)]
247 (.put observers new-watcher old))
248 nil)
250 (defn update
251 "Notify observers."
252 [target & args]
253 (doseq [entry observers
254 f (get (val entry) target)]
255 (apply f (key entry) target args)))
257 (defn add-context-observer
258 "Observer registered with this function will be automatically
259 removed after the next repaint is complete."
260 [target f]
261 (add-observer *scene* target f))
263 (defn repaint-on-update
264 "Trigger repaint of the current scene when the target updates."
265 [target]
266 (let [scene *scene*]
267 (if-not (identical? scene target)
268 (add-observer scene target (fn [w _] (update w))))))
270 (defn repaint
271 "Repaint the current scene."
272 []
273 (update *scene*))
275 ;;
276 ;; Rendering
277 ;;
279 (defn ^AffineTransform relative-transform
280 "Returns AffineTransform: layer context -> AWT component."
281 []
282 (let [tr (.getTransform *graphics*)]
283 (.preConcatenate tr *inverse-initial-transform*)
284 tr))
286 (defn ^AffineTransform inverse-relative-transform
287 "Returns AffineTransform: AWT component -> layer context."
288 []
289 (let [tr (.getTransform *graphics*)]
290 (.invert tr) ; absolute -> layer
291 (.concatenate tr *initial-transform*) ; component -> absolute
292 tr))
294 (defn transform-point [^AffineTransform tr x y]
295 (let [p (Point2D$Double. x y)]
296 (.transform tr p p)
297 [(.x p) (.y p)]))
299 ;; (defn- clip
300 ;; "Intersect clipping area with the specified shape or bounds.
301 ;; Returns new clip (Shape or nil if empty)."
302 ;; ([x y w h]
303 ;; (clip (Rectangle2D$Double. x y w h)))
304 ;; ([shape]
305 ;; (let [a1 (Area. shape)
306 ;; a2 (if (instance? Area *clip*) *clip* (Area. *clip*))]
307 ;; (.transform a1 (relative-transform))
308 ;; (.intersect a1 a2)
309 ;; (if (.isEmpty a1)
310 ;; nil
311 ;; a1))))
313 ;; Use faster clipping calculation provided by Graphics2D.
314 (defn- clip
315 "Intersect clipping area with the specified bounds in current
316 transform coordinates. Returns new clip in the AWT component
317 coordinates (Shape or nil if empty)."
318 [x y w h]
319 (let [^Graphics2D clip-g (.create *graphics*)]
320 (doto clip-g
321 (.setClip x y w h)
322 (.setTransform *initial-transform*)
323 (.clip *clip*))
324 (try
325 (if (.isEmpty (.getClipBounds clip-g))
326 nil
327 (.getClip clip-g))
328 (finally
329 (.dispose clip-g)))))
331 (defn- ^Graphics2D apply-theme
332 "Set graphics' color and font to match theme.
333 Modifies and returns the first argument."
334 ([]
335 (apply-theme *graphics* *theme*))
336 ([^Graphics2D graphics theme]
337 (doto graphics
338 (.setColor (:fore-color theme))
339 (.setFont (:font theme)))))
341 (defn- ^Graphics2D create-graphics
342 ([]
343 (apply-theme (.create *graphics*) *theme*))
344 ([x y w h]
345 (apply-theme (.create *graphics* x y w h) *theme*)))
347 (defn- with-bounds-noclip*
348 [x y w h f & args]
349 (let [graphics (create-graphics)]
350 (try
351 (.translate graphics (int x) (int y))
352 (binding [*width* w
353 *height* h
354 *graphics* graphics]
355 (apply f args))
356 (finally
357 (.dispose graphics)))))
359 (defn with-bounds*
360 [x y w h f & args]
361 (when-let [clip (clip x y w h)]
362 (let [graphics (create-graphics x y w h)]
363 (try
364 (binding [*width* w
365 *height* h
366 *clip* clip
367 *graphics* graphics]
368 (apply f args))
369 (finally
370 (.dispose graphics))))))
372 (defmacro with-bounds
373 [x y w h & body]
374 `(with-bounds* ~x ~y ~w ~h (fn [] ~@body)))
376 (defmacro with-theme
377 [theme & body]
378 `(binding [*theme* (merge *theme* ~theme)]
379 ~@body))
381 (defmacro with-color
382 [color-or-keyword & body]
383 (let [color-form (if (keyword? color-or-keyword)
384 `(~color-or-keyword *theme*)
385 color-or-keyword)]
386 `(let [color# ~color-form
387 old-color# (.getColor *graphics*)]
388 (try
389 (.setColor *graphics* color#)
390 ~@body
391 (finally
392 (.setColor *graphics* old-color#))))))
394 (defn with-hints*
395 [hints f & args]
396 (if hints
397 (let [g *graphics*
398 old (.getRenderingHints g)]
399 (try
400 (.addRenderingHints g hints)
401 (binding [*font-context* (.getFontRenderContext g)]
402 (apply f args))
403 (finally
404 (.setRenderingHints g old))))
405 (apply f args)))
407 (defmacro with-hints
408 [hints & body]
409 `(with-hints ~hints (fn [] ~@body)))
411 ;; TODO: constructor for AffineTransform.
412 ;; (transform :scale 0.3 0.5
413 ;; :translate 5 10
414 ;; :rotate (/ Math/PI 2))
416 (defmacro with-transform [transform & body]
417 `(let [old-t# (.getTransform *graphics*)]
418 (try
419 (.transform *graphics* ~transform)
420 ~@body
421 (finally
422 (.setTransform *graphics* old-t#)))))
424 (defmacro with-rotate [theta ax ay & body]
425 `(let [transform# (AffineTransform/getRotateInstance ~theta ~ax ~ay)]
426 (with-transform transform# ~@body)))
428 (defmacro with-translate [x y & body]
429 `(let [x# ~x
430 y# ~y]
431 (try
432 (.translate *graphics* x# y#)
433 ~@body
434 (finally
435 (.translate *graphics* (- x#) (- y#))))))
437 (defn draw!
438 "Draws layer."
439 ([layer]
440 (let [graphics (create-graphics)]
441 (try
442 (binding [*graphics* graphics]
443 (render! layer))
444 (finally
445 (.dispose graphics)))))
446 ([layer x y]
447 (draw! layer x y true))
448 ([layer x y clip?]
449 (let [geom (geometry layer)]
450 (draw! layer x y (width geom) (height geom) clip?)))
451 ([layer x y width height]
452 (draw! layer x y width height true))
453 ([layer x y width height clip?]
454 (if clip?
455 (with-bounds* x y width height render! layer)
456 (with-bounds-noclip* x y width height render! layer))))
458 (defn draw-aligned!
459 "Draws layer. Location is relative to the layer's anchor point for
460 the specified alignment."
461 ([layer h-align v-align x y]
462 (let [geom (geometry layer)
463 w (width geom)
464 h (height geom)]
465 (draw! layer
466 (- x (anchor-x geom h-align w))
467 (- y (anchor-y geom v-align h))
468 w h)))
469 ([layer h-align v-align x y w h]
470 (let [geom (geometry layer)]
471 (draw! layer
472 (- x (anchor-x geom h-align w))
473 (- y (anchor-y geom v-align h))
474 w h))))
476 ;;
477 ;; Event handling.
478 ;;
480 (defn with-handlers*
481 [handle handlers f & args]
482 (binding [*event-dispatcher* (create-dispatcher
483 *event-dispatcher* handle handlers)]
484 (apply f args)))
486 (defmacro with-handlers
487 "specs => (:event-id name & handler-body)*
489 Execute form with the specified event handlers."
490 [handle form & specs]
491 `(with-handlers* ~handle
492 ~(reduce (fn [m spec]
493 (assoc m (first spec)
494 `(fn [~(second spec)]
495 ~@(nnext spec)))) {}
496 specs)
497 (fn [] ~form)))
499 (defn picked? [handle]
500 (handle-picked? *event-dispatcher* handle))
502 (defn hovered? [handle]
503 (handle-hovered? *event-dispatcher* handle))
505 ;;
506 ;; EventDispatcher implementation
507 ;;
509 (def awt-events
510 {java.awt.event.MouseEvent/MOUSE_CLICKED :mouse-clicked
511 java.awt.event.MouseEvent/MOUSE_DRAGGED :mouse-dragged
512 java.awt.event.MouseEvent/MOUSE_ENTERED :mouse-entered
513 java.awt.event.MouseEvent/MOUSE_EXITED :mouse-exited
514 java.awt.event.MouseEvent/MOUSE_MOVED :mouse-moved
515 java.awt.event.MouseEvent/MOUSE_PRESSED :mouse-pressed
516 java.awt.event.MouseEvent/MOUSE_RELEASED :mouse-released
517 java.awt.event.MouseEvent/MOUSE_WHEEL :mouse-wheel})
519 (def dummy-event-dispatcher
520 (reify EventDispatcher
521 (listen! [_ _])
522 (create-dispatcher [this _ _] this)
523 (commit [_])
524 (handle-picked? [_ _])
525 (handle-hovered? [_ _])))
527 (defrecord DispatcherNode [handle handlers parent
528 ^Shape clip ^AffineTransform transform
529 bindings]
530 EventDispatcher
531 (listen! [this component]
532 (listen! parent component))
533 (create-dispatcher [this handle handlers]
534 (create-dispatcher parent handle handlers))
535 (commit [this]
536 (commit parent))
537 (handle-picked? [this handle]
538 (handle-picked? parent handle))
539 (handle-hovered? [this handle]
540 (handle-hovered? parent handle)))
542 (defn- make-node [handle handlers]
543 (DispatcherNode. handle handlers *event-dispatcher* *clip*
544 (inverse-relative-transform)
545 (get-thread-bindings)))
547 (defn- add-node [tree node]
548 (assoc-cons tree (:parent node) node))
550 (defn- nodes [tree]
551 (apply concat (vals tree)))
553 (defn- under-cursor
554 "Returns a vector of child nodes under cursor."
555 [x y tree node]
556 (some #(if (.contains ^Shape (:clip %) x y)
557 (conj (vec (under-cursor x y tree %)) %))
558 (get tree node)))
560 (defn- remove-all [coll1 coll2 pred]
561 (filter #(not (some (partial pred %) coll2)) coll1))
563 (defn- translate-mouse-event [^java.awt.event.MouseEvent event
564 ^AffineTransform tr id]
565 (let [[x y] (transform-point tr (.getX event) (.getY event))
566 rotation (if (instance? MouseWheelEvent event)
567 (.getWheelRotation ^MouseWheelEvent event)
568 nil)]
569 (MouseEvent. id (.getWhen event) x y
570 (.getXOnScreen event) (.getYOnScreen event)
571 (.getButton event)
572 rotation)))
574 (defn- translate-and-dispatch
575 ([nodes first-only ^java.awt.event.MouseEvent event]
576 (translate-and-dispatch nodes first-only
577 event (awt-events (.getID event))))
578 ([nodes first-only event id]
579 (if-let [node (first nodes)]
580 (if-let [handler (get (:handlers node) id)]
581 (do
582 (let [translated (translate-mouse-event event (:transform node) id)]
583 (with-bindings* (:bindings node)
584 handler translated))
585 (if-not first-only
586 (recur (rest nodes) false event id)))
587 (recur (rest nodes) first-only event id)))))
589 (defn- dispatch-mouse-motion
590 "Dispatches mouse motion events."
591 [hovered-ref tree root ^java.awt.event.MouseEvent event]
592 (let [x (.getX event)
593 y (.getY event)
594 [hovered hovered2] (dosync
595 [@hovered-ref
596 (ref-set hovered-ref
597 (under-cursor x y tree root))])
598 pred #(= (:handle %1) (:handle %2))
599 exited (remove-all hovered hovered2 pred)
600 entered (remove-all hovered2 hovered pred)
601 moved (remove-all hovered2 entered pred)]
602 (translate-and-dispatch exited false event :mouse-exited)
603 (translate-and-dispatch entered false event :mouse-entered)
604 (translate-and-dispatch moved true event :mouse-moved)))
606 (defn- dispatch-mouse-button
607 [picked-ref hovered-ref ^java.awt.event.MouseEvent event]
608 (let [id (awt-events (.getID event))
609 nodes (case id
610 :mouse-pressed
611 (dosync
612 (ref-set picked-ref @hovered-ref))
613 :mouse-released
614 (dosync
615 (let [picked @picked-ref]
616 (ref-set picked-ref nil)
617 picked))
618 @hovered-ref)]
619 (translate-and-dispatch nodes true event id)))
621 (defn root-event-dispatcher []
622 (let [tree-r (ref {}) ; register
623 tree (ref {}) ; dispatch
624 hovered (ref '())
625 picked (ref '())]
626 (reify
627 EventDispatcher
628 (listen! [this component]
629 (doto ^Component component
630 (.addMouseListener this)
631 (.addMouseWheelListener this)
632 (.addMouseMotionListener this)))
633 (create-dispatcher [this handle handlers]
634 (let [node (make-node handle handlers)]
635 (dosync (alter tree-r add-node node))
636 node))
637 (commit [this]
638 ;; TODO: retain contexts that do not intersect graphics
639 ;; clipping area in tree.
640 (dosync (ref-set tree @tree-r)
641 (ref-set tree-r {})))
642 (handle-picked? [this handle]
643 (some #(= handle (:handle %)) @picked))
644 (handle-hovered? [this handle]
645 (some #(= handle (:handle %)) @hovered))
646 MouseListener
647 (mouseEntered [this event]
648 (dispatch-mouse-motion hovered @tree this event))
649 (mouseExited [this event]
650 (dispatch-mouse-motion hovered @tree this event))
651 (mouseClicked [this event]
652 (dispatch-mouse-button picked hovered event))
653 (mousePressed [this event]
654 (dispatch-mouse-button picked hovered event))
655 (mouseReleased [this event]
656 (dispatch-mouse-button picked hovered event))
657 MouseWheelListener
658 (mouseWheelMoved [this event]
659 (dispatch-mouse-button picked hovered event))
660 MouseMotionListener
661 (mouseDragged [this event]
662 (translate-and-dispatch @picked true event))
663 (mouseMoved [this event]
664 (dispatch-mouse-motion hovered @tree this event)))))
666 ;;
667 ;; Scene
668 ;;
670 (defrecord Scene [layer event-dispatcher component])
672 (defn make-scene
673 ([layer]
674 (make-scene layer dummy-event-dispatcher nil))
675 ([layer event-dispatcher]
676 (make-scene layer event-dispatcher nil))
677 ([layer event-dispatcher component]
678 (->Scene layer event-dispatcher component)))
680 (defn draw-scene!
681 [scene ^Graphics2D graphics width height]
682 ;; (.setRenderingHint graphics
683 ;; RenderingHints/KEY_INTERPOLATION
684 ;; RenderingHints/VALUE_INTERPOLATION_BILINEAR)
685 ;; (.setRenderingHint graphics
686 ;; RenderingHints/KEY_ALPHA_INTERPOLATION
687 ;; RenderingHints/VALUE_ALPHA_INTERPOLATION_QUALITY)
688 ;; (.setRenderingHint graphics
689 ;; RenderingHints/KEY_ANTIALIASING
690 ;; RenderingHints/VALUE_ANTIALIAS_ON)
691 ;; (.setRenderingHint graphics
692 ;; RenderingHints/KEY_TEXT_ANTIALIASING
693 ;; RenderingHints/VALUE_TEXT_ANTIALIAS_ON)
694 (binding [*scene* scene
695 *graphics* graphics
696 *font-context* (.getFontRenderContext graphics)
697 *initial-transform* (.getTransform graphics)
698 *inverse-initial-transform* (-> graphics
699 .getTransform
700 .createInverse)
701 *event-dispatcher* (:event-dispatcher scene)
702 *width* width
703 *height* height
704 *clip* (Rectangle2D$Double. 0 0 width height)
705 *time* (System/nanoTime)]
706 (apply-theme)
707 (let [tmp-watcher (Object.)]
708 ;; Keep current context observers until the rendering is
709 ;; complete. Some observers may be invoked twice if they
710 ;; appear in both groups until tmp-watcher is removed.
711 (replace-observers-watcher scene tmp-watcher)
712 (try
713 (render! (:layer scene))
714 (finally
715 (remove-observers tmp-watcher)
716 (commit (:event-dispatcher scene)))))))
718 (defn scene-geometry [scene font-context]
719 (binding [*scene* scene
720 *font-context* font-context]
721 (geometry (:layer scene))))
723 (defn set-cursor! [^Cursor cursor]
724 (when-let [^Component component (:component *scene*)]
725 (EventQueue/invokeLater #(.setCursor component cursor))))