view src/net/kryshen/indyvon/core.clj @ 119:91c341698f7e

Use FontRenderContext based on rendering hints when Graphics is not available. Obtain text rendering hints from desktop properties.
author Mikhail Kryshen <mikhail@kryshen.net>
date Tue, 03 Apr 2012 18:28:12 +0400
parents b76c0d00898b
children b5ac04d5fc8a
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 ^Graphics2D *graphics*)
37 (def ^:dynamic *width*
38 "Width of the rendering area.")
40 (def ^:dynamic *height*
41 "Height of the rendering area.")
43 (def ^:dynamic ^Shape *clip*)
45 (def ^:dynamic *time*
46 "Timestamp of the current frame (in nanoseconds).")
48 (def ^:dynamic *scene*
49 "Encloses state that should be retained between repaints.")
51 (def ^:dynamic *states*
52 "Transient scene states, a map.")
54 (def ^:dynamic *event-dispatcher*)
56 (def ^:dynamic ^AffineTransform *initial-transform*
57 "Initial transform associated with the graphics context.")
59 (def ^:dynamic ^AffineTransform *inverse-initial-transform*
60 "Inversion of the initial transform associated with the graphics
61 context.")
63 (defrecord Theme [fore-color back-color alt-back-color border-color
64 shadow-color font])
66 ;; REMIND: use system colors, see java.awt.SystemColor.
67 (defn default-theme []
68 (Theme. Color/BLACK
69 Color/WHITE
70 (Color. 0xC8 0xD2 0xD8)
71 (Color. 0 0 0xC8)
72 (Color. 0x44 0x44 0x44)
73 (Font. "Sans" Font/PLAIN 12)))
75 (def ^:dynamic *theme* (default-theme))
77 ;;
78 ;; Core protocols and types
79 ;;
81 (defprotocol Layer
82 "Basic UI element."
83 (render! [layer]
84 "Draws layer in the current *graphics* context.")
85 (geometry [layer]
86 "Returns the preferred layer Geometry."))
88 (defprotocol Geometry
89 "Describes geometry of a Layer. Prefer using the available
90 implementations (Size, FixedGeometry and NestedGeometry) over
91 extending this protocol directly as it is likely to be changed in
92 the future versions."
93 (width [geom] [geom height])
94 (height [geom] [geom width])
95 (anchor-x [geom h-align width]
96 "Returns the x coordinate of the anchor point for the specified
97 horizontal alignment and width, h-align could be :left, :center
98 or :right.")
99 (anchor-y [geom v-align height]
100 "Returns the y coordinate of the anchor point for the specified
101 vertical alignment and height, v-align could be :top, :center
102 or :bottom."))
104 (defrecord Size [width height]
105 Geometry
106 (width [_] width)
107 (width [_ _] width)
108 (height [_] height)
109 (height [_ _] height)
110 (anchor-x [_ h-align width]
111 (case h-align
112 :left 0
113 :center (/ width 2)
114 :right width))
115 (anchor-y [_ v-align height]
116 (case v-align
117 :top 0
118 :center (/ height 2)
119 :bottom height)))
121 (defrecord FixedGeometry [ax ay width height]
122 Geometry
123 (width [_] width)
124 (width [_ _] width)
125 (height [_] height)
126 (height [_ _] height)
127 (anchor-x [_ _ _] ax)
128 (anchor-y [_ _ _] ay))
130 (defrecord NestedGeometry [geometry top left bottom right]
131 Geometry
132 (width [_]
133 (+ left right (width geometry)))
134 (width [_ h]
135 (+ left right (width geometry (- h top bottom))))
136 (height [_]
137 (+ top bottom (height geometry)))
138 (height [_ w]
139 (+ top bottom (height geometry (- w left right))))
140 (anchor-x [_ h-align w]
141 (+ left (anchor-x geometry h-align (- w left right))))
142 (anchor-y [_ v-align h]
143 (+ top (anchor-y geometry v-align (- h top bottom)))))
145 (defrecord ScaledGeometry [geometry sx sy]
146 Geometry
147 (width [_]
148 (* sx (width geometry)))
149 (width [_ h]
150 (* sx (width geometry (/ h sy))))
151 (height [_]
152 (* sy (height geometry)))
153 (height [_ w]
154 (* sy (height geometry (/ w sx))))
155 (anchor-x [_ h-align w]
156 (* sx (anchor-x geometry h-align (/ w sx))))
157 (anchor-y [_ v-align h]
158 (* sy (anchor-y geometry v-align (/ h sy)))))
160 ;; TODO: modifiers
161 (defrecord MouseEvent [id when x y x-on-screen y-on-screen button
162 wheel-rotation])
164 ;; TODO: KeyEvent
166 (defprotocol EventDispatcher
167 (listen! [this component]
168 "Listen for events on the specified AWT Component.")
169 (create-dispatcher [this handle handlers]
170 "Returns new event dispatcher associated with the specified event
171 handlers (an event-id -> handler-fn map). Handle is used to
172 match the contexts between commits.")
173 (commit [this]
174 "Apply the registered handlers for event processing.")
175 (handle-picked? [this handle]
176 "Returns true if the specified handle received the :mouse-pressed
177 event and have not yet received :moused-released.")
178 (handle-hovered? [this handle]
179 "Returns true if the specified handle received the :mouse-entered
180 event and have not yet received :mouse-exited."))
182 (defn- assoc-cons [m key val]
183 (->> (get m key) (cons val) (assoc m key)))
185 ;;
186 ;; Observers
187 ;; The mechanism used by layers to request repaints
188 ;;
190 (def ^ConcurrentMap observers
191 (-> (MapMaker.) (.weakKeys) (.makeMap)))
193 (defn- cm-replace!
194 "Wrap ConcurrentMap replace method to treat nil value as absent
195 mapping. Use with maps that does not support nil values."
196 [^ConcurrentMap cmap key old new]
197 (if (nil? old)
198 (nil? (.putIfAbsent cmap key new))
199 (.replace cmap key old new)))
201 (defn- cm-swap!
202 "Atomically swaps the value associated with key in ConcurrentMap
203 to be (apply f current-value args). Returns the new value."
204 [^ConcurrentMap cmap key f & args]
205 (loop []
206 (let [old (.get cmap key)
207 new (apply f old args)]
208 (if (cm-replace! cmap key old new)
209 new
210 (recur)))))
212 (defn add-observer
213 "Add observer fn for the target. Watcher identifies the group of
214 observers and could be used to remove the group. Watcher is weakly
215 referenced, all associated observers will be removed when the
216 wathcer is removed by gc. The observer fn will be called with
217 watcher and target arguments and any additional arguments specified
218 in update call."
219 [watcher target f]
220 (cm-swap! observers watcher assoc-cons target f)
221 nil)
223 (defn remove-observers
224 "Remove group of observers associated with the specified watcher."
225 [watcher]
226 (.remove observers watcher)
227 nil)
229 (defn- replace-observers-watcher
230 [old-watcher new-watcher]
231 (if-let [old (.remove observers old-watcher)]
232 (.put observers new-watcher old))
233 nil)
235 (defn update
236 "Notify observers."
237 [target & args]
238 (doseq [entry observers
239 f (get (val entry) target)]
240 (apply f (key entry) target args)))
242 (defn add-context-observer
243 "Observer registered with this function will be automatically
244 removed after the next repaint is complete."
245 [target f]
246 (add-observer *scene* target f))
248 (defn repaint-on-update
249 "Trigger repaint of the current scene when the target updates."
250 [target]
251 (let [scene *scene*]
252 (if-not (identical? scene target)
253 (add-observer scene target (fn [w _] (update w))))))
255 (defn repaint
256 "Requests repaint of the current scene. If handle and state are
257 specified, the handle will be associated with the state in the
258 *states* map for the next paint iteration."
259 ([]
260 (update *scene*))
261 ([handle state]
262 (let [scene *scene*]
263 (swap! (:next-state scene) assoc handle state)
264 (update scene))))
266 ;;
267 ;; Rendering
268 ;;
270 (defn ^FontRenderContext font-context
271 "Returns FontRenderContext for the current Layer context."
272 []
273 (if (bound? (var *graphics*))
274 (.getFontRenderContext *graphics*)
275 (let [scene *scene*]
276 (if-let [^Component c (:component scene)]
277 (.getFontRenderContext (.getFontMetrics c (.getFont c)))
278 (:font-context scene)))))
280 (defn ^AffineTransform relative-transform
281 "Returns AffineTransform: layer context -> AWT component."
282 []
283 (let [tr (.getTransform *graphics*)]
284 (.preConcatenate tr *inverse-initial-transform*)
285 tr))
287 (defn ^AffineTransform inverse-relative-transform
288 "Returns AffineTransform: AWT component -> layer context."
289 []
290 (let [tr (.getTransform *graphics*)]
291 (.invert tr) ; absolute -> layer
292 (.concatenate tr *initial-transform*) ; component -> absolute
293 tr))
295 (defn transform-point [^AffineTransform tr x y]
296 (let [p (Point2D$Double. x y)]
297 (.transform tr p p)
298 [(.x p) (.y p)]))
300 ;; (defn- clip
301 ;; "Intersect clipping area with the specified shape or bounds.
302 ;; Returns new clip (Shape or nil if empty)."
303 ;; ([x y w h]
304 ;; (clip (Rectangle2D$Double. x y w h)))
305 ;; ([shape]
306 ;; (let [a1 (Area. shape)
307 ;; a2 (if (instance? Area *clip*) *clip* (Area. *clip*))]
308 ;; (.transform a1 (relative-transform))
309 ;; (.intersect a1 a2)
310 ;; (if (.isEmpty a1)
311 ;; nil
312 ;; a1))))
314 ;; Use faster clipping calculation provided by Graphics2D.
315 (defn- clip
316 "Intersect clipping area with the specified bounds in current
317 transform coordinates. Returns new clip in the AWT component
318 coordinates (Shape or nil if empty)."
319 [x y w h]
320 (let [^Graphics2D clip-g (.create *graphics*)]
321 (doto clip-g
322 (.setClip x y w h)
323 (.setTransform *initial-transform*)
324 (.clip *clip*))
325 (try
326 (if (.isEmpty (.getClipBounds clip-g))
327 nil
328 (.getClip clip-g))
329 (finally
330 (.dispose clip-g)))))
332 (defn- ^Graphics2D apply-theme
333 "Set graphics' color and font to match theme.
334 Modifies and returns the first argument."
335 ([]
336 (apply-theme *graphics* *theme*))
337 ([^Graphics2D graphics theme]
338 (doto graphics
339 (.setColor (:fore-color theme))
340 (.setFont (:font theme)))))
342 (defn- ^Graphics2D create-graphics
343 ([]
344 (apply-theme (.create *graphics*) *theme*))
345 ([x y w h]
346 (apply-theme (.create *graphics* x y w h) *theme*)))
348 (defn- with-bounds-noclip*
349 [x y w h f & args]
350 (let [graphics (create-graphics)]
351 (try
352 (.translate graphics (int x) (int y))
353 (binding [*width* w
354 *height* h
355 *graphics* graphics]
356 (apply f args))
357 (finally
358 (.dispose graphics)))))
360 (defn with-bounds*
361 [x y w h f & args]
362 (when-let [clip (clip x y w h)]
363 (let [graphics (create-graphics x y w h)]
364 (try
365 (binding [*width* w
366 *height* h
367 *clip* clip
368 *graphics* graphics]
369 (apply f args))
370 (finally
371 (.dispose graphics))))))
373 (defmacro with-bounds
374 [x y w h & body]
375 `(with-bounds* ~x ~y ~w ~h (fn [] ~@body)))
377 (defmacro with-theme
378 [theme & body]
379 `(binding [*theme* (merge *theme* ~theme)]
380 ~@body))
382 (defmacro with-color
383 [color-or-keyword & body]
384 (let [color-form (if (keyword? color-or-keyword)
385 `(~color-or-keyword *theme*)
386 color-or-keyword)]
387 `(let [color# ~color-form
388 g# *graphics*
389 old-color# (.getColor g#)]
390 (try
391 (.setColor g# color#)
392 ~@body
393 (finally
394 (.setColor g# old-color#))))))
396 (defn with-hints*
397 [hints f & args]
398 (if hints
399 (let [g *graphics*
400 old (.getRenderingHints g)]
401 (try
402 (.addRenderingHints g hints)
403 (apply f args)
404 (finally
405 (.setRenderingHints g old))))
406 (apply f args)))
408 (defmacro with-hints
409 [hints & body]
410 `(with-hints ~hints (fn [] ~@body)))
412 ;; TODO: constructor for AffineTransform.
413 ;; (transform :scale 0.3 0.5
414 ;; :translate 5 10
415 ;; :rotate (/ Math/PI 2))
417 (defmacro with-transform [transform & body]
418 `(let [g# *graphics*
419 old-t# (.getTransform g#)]
420 (try
421 (.transform g# ~transform)
422 ~@body
423 (finally
424 (.setTransform g# old-t#)))))
426 (defmacro with-rotate [theta ax ay & body]
427 `(let [transform# (AffineTransform/getRotateInstance ~theta ~ax ~ay)]
428 (with-transform transform# ~@body)))
430 (defmacro with-translate [x y & body]
431 `(let [x# ~x
432 y# ~y
433 g# *graphics*]
434 (try
435 (.translate g# x# y#)
436 ~@body
437 (finally
438 (.translate g# (- x#) (- y#))))))
440 (defn draw!
441 "Draws layer."
442 ([layer]
443 (let [graphics (create-graphics)]
444 (try
445 (binding [*graphics* graphics]
446 (render! layer))
447 (finally
448 (.dispose graphics)))))
449 ([layer x y]
450 (draw! layer x y true))
451 ([layer x y clip?]
452 (let [geom (geometry layer)]
453 (draw! layer x y (width geom) (height geom) clip?)))
454 ([layer x y width height]
455 (draw! layer x y width height true))
456 ([layer x y width height clip?]
457 (if clip?
458 (with-bounds* x y width height render! layer)
459 (with-bounds-noclip* x y width height render! layer))))
461 (defn draw-aligned!
462 "Draws layer. Location is relative to the layer's anchor point for
463 the specified alignment."
464 ([layer h-align v-align x y]
465 (let [geom (geometry layer)
466 w (width geom)
467 h (height geom)]
468 (draw! layer
469 (- x (anchor-x geom h-align w))
470 (- y (anchor-y geom v-align h))
471 w h)))
472 ([layer h-align v-align x y w h]
473 (let [geom (geometry layer)]
474 (draw! layer
475 (- x (anchor-x geom h-align w))
476 (- y (anchor-y geom v-align h))
477 w h))))
479 ;;
480 ;; Event handling.
481 ;;
483 (defn with-handlers*
484 [handle handlers f & args]
485 (binding [*event-dispatcher* (create-dispatcher
486 *event-dispatcher* handle handlers)]
487 (apply f args)))
489 (defmacro with-handlers
490 "specs => (:event-id name & handler-body)*
492 Execute form with the specified event handlers."
493 [handle form & specs]
494 `(with-handlers* ~handle
495 ~(reduce (fn [m spec]
496 (assoc m (first spec)
497 `(fn [~(second spec)]
498 ~@(nnext spec)))) {}
499 specs)
500 (fn [] ~form)))
502 (defn picked? [handle]
503 (handle-picked? *event-dispatcher* handle))
505 (defn hovered? [handle]
506 (handle-hovered? *event-dispatcher* handle))
508 ;;
509 ;; EventDispatcher implementation
510 ;;
512 (def awt-events
513 {java.awt.event.MouseEvent/MOUSE_CLICKED :mouse-clicked
514 java.awt.event.MouseEvent/MOUSE_DRAGGED :mouse-dragged
515 java.awt.event.MouseEvent/MOUSE_ENTERED :mouse-entered
516 java.awt.event.MouseEvent/MOUSE_EXITED :mouse-exited
517 java.awt.event.MouseEvent/MOUSE_MOVED :mouse-moved
518 java.awt.event.MouseEvent/MOUSE_PRESSED :mouse-pressed
519 java.awt.event.MouseEvent/MOUSE_RELEASED :mouse-released
520 java.awt.event.MouseEvent/MOUSE_WHEEL :mouse-wheel})
522 (def dummy-event-dispatcher
523 (reify EventDispatcher
524 (listen! [_ _])
525 (create-dispatcher [this _ _] this)
526 (commit [_])
527 (handle-picked? [_ _])
528 (handle-hovered? [_ _])))
530 (defrecord DispatcherNode [handle handlers parent
531 ^Shape clip ^AffineTransform transform
532 bindings]
533 EventDispatcher
534 (listen! [this component]
535 (listen! parent component))
536 (create-dispatcher [this handle handlers]
537 (create-dispatcher parent handle handlers))
538 (commit [this]
539 (commit parent))
540 (handle-picked? [this handle]
541 (handle-picked? parent handle))
542 (handle-hovered? [this handle]
543 (handle-hovered? parent handle)))
545 (defn- make-node [handle handlers]
546 (DispatcherNode. handle handlers *event-dispatcher* *clip*
547 (inverse-relative-transform)
548 (get-thread-bindings)))
550 (defn- add-node [tree node]
551 (assoc-cons tree (:parent node) node))
553 (defn- nodes [tree]
554 (apply concat (vals tree)))
556 (defn- under-cursor
557 "Returns a vector of child nodes under cursor."
558 [x y tree node]
559 (some #(if (.contains ^Shape (:clip %) x y)
560 (conj (vec (under-cursor x y tree %)) %))
561 (get tree node)))
563 (defn- remove-all [coll1 coll2 pred]
564 (filter #(not (some (partial pred %) coll2)) coll1))
566 (defn- translate-mouse-event [^java.awt.event.MouseEvent event
567 ^AffineTransform tr id]
568 (let [[x y] (transform-point tr (.getX event) (.getY event))
569 rotation (if (instance? MouseWheelEvent event)
570 (.getWheelRotation ^MouseWheelEvent event)
571 nil)]
572 (MouseEvent. id (.getWhen event) x y
573 (.getXOnScreen event) (.getYOnScreen event)
574 (.getButton event)
575 rotation)))
577 (defn- translate-and-dispatch
578 ([nodes first-only ^java.awt.event.MouseEvent event]
579 (translate-and-dispatch nodes first-only
580 event (awt-events (.getID event))))
581 ([nodes first-only event id]
582 (if-let [node (first nodes)]
583 (if-let [handler (get (:handlers node) id)]
584 (do
585 (let [translated (translate-mouse-event event (:transform node) id)]
586 (with-bindings* (:bindings node)
587 handler translated))
588 (if-not first-only
589 (recur (rest nodes) false event id)))
590 (recur (rest nodes) first-only event id)))))
592 (defn- dispatch-mouse-motion
593 "Dispatches mouse motion events."
594 [hovered-ref tree root ^java.awt.event.MouseEvent event]
595 (let [x (.getX event)
596 y (.getY event)
597 [hovered hovered2] (dosync
598 [@hovered-ref
599 (ref-set hovered-ref
600 (under-cursor x y tree root))])
601 pred #(= (:handle %1) (:handle %2))
602 exited (remove-all hovered hovered2 pred)
603 entered (remove-all hovered2 hovered pred)
604 moved (remove-all hovered2 entered pred)]
605 (translate-and-dispatch exited false event :mouse-exited)
606 (translate-and-dispatch entered false event :mouse-entered)
607 (translate-and-dispatch moved true event :mouse-moved)))
609 (defn- dispatch-mouse-button
610 [picked-ref hovered-ref ^java.awt.event.MouseEvent event]
611 (let [id (awt-events (.getID event))
612 nodes (case id
613 :mouse-pressed
614 (dosync
615 (ref-set picked-ref @hovered-ref))
616 :mouse-released
617 (dosync
618 (let [picked @picked-ref]
619 (ref-set picked-ref nil)
620 picked))
621 @hovered-ref)]
622 (translate-and-dispatch nodes true event id)))
624 (defn root-event-dispatcher []
625 (let [tree-r (ref {}) ; register
626 tree (ref {}) ; dispatch
627 hovered (ref '())
628 picked (ref '())]
629 (reify
630 EventDispatcher
631 (listen! [this component]
632 (doto ^Component component
633 (.addMouseListener this)
634 (.addMouseWheelListener this)
635 (.addMouseMotionListener this)))
636 (create-dispatcher [this handle handlers]
637 (let [node (make-node handle handlers)]
638 (dosync (alter tree-r add-node node))
639 node))
640 (commit [this]
641 ;; TODO: retain contexts that do not intersect graphics
642 ;; clipping area in tree.
643 (dosync (ref-set tree @tree-r)
644 (ref-set tree-r {})))
645 (handle-picked? [this handle]
646 (some #(= handle (:handle %)) @picked))
647 (handle-hovered? [this handle]
648 (some #(= handle (:handle %)) @hovered))
649 MouseListener
650 (mouseEntered [this event]
651 (dispatch-mouse-motion hovered @tree this event))
652 (mouseExited [this event]
653 (dispatch-mouse-motion hovered @tree this event))
654 (mouseClicked [this event]
655 (dispatch-mouse-button picked hovered event))
656 (mousePressed [this event]
657 (dispatch-mouse-button picked hovered event))
658 (mouseReleased [this event]
659 (dispatch-mouse-button picked hovered event))
660 MouseWheelListener
661 (mouseWheelMoved [this event]
662 (dispatch-mouse-button picked hovered event))
663 MouseMotionListener
664 (mouseDragged [this event]
665 (translate-and-dispatch @picked true event))
666 (mouseMoved [this event]
667 (dispatch-mouse-motion hovered @tree this event)))))
669 ;;
670 ;; Scene
671 ;;
673 (defrecord Scene [layer
674 event-dispatcher
675 component
676 rendering-hints
677 font-context
678 next-state])
680 ;; Define rendering hints that affect font metrics to make sure that
681 ;; Graphics and Scene FontRenderContexts are consistent.
682 (def ^:private default-rendering-hints
683 {RenderingHints/KEY_TEXT_ANTIALIASING
684 RenderingHints/VALUE_TEXT_ANTIALIAS_DEFAULT,
685 RenderingHints/KEY_FRACTIONALMETRICS
686 RenderingHints/VALUE_FRACTIONALMETRICS_DEFAULT})
688 (defn make-scene
689 ([layer]
690 (make-scene layer dummy-event-dispatcher nil))
691 ([layer event-dispatcher]
692 (make-scene layer event-dispatcher nil))
693 ([layer event-dispatcher ^Component component]
694 (make-scene layer event-dispatcher component nil))
695 ([layer event-dispatcher ^Component component hints]
696 (let [hints (merge default-rendering-hints hints)]
697 (->Scene layer
698 event-dispatcher
699 component
700 hints
701 (FontRenderContext.
702 nil
703 (get hints RenderingHints/KEY_TEXT_ANTIALIASING)
704 (get hints RenderingHints/KEY_FRACTIONALMETRICS))
705 (atom nil)))))
707 (defn- get-and-set!
708 "Atomically sets the value of atom to newval and returns the old
709 value."
710 [atom newval]
711 (loop [v @atom]
712 (if (compare-and-set! atom v newval)
713 v
714 (recur @atom))))
716 (defn draw-scene!
717 [scene ^Graphics2D graphics width height]
718 (.addRenderingHints graphics (:rendering-hints scene))
719 (binding [*states* (get-and-set! (:next-state scene) nil)
720 *scene* scene
721 *graphics* graphics
722 *initial-transform* (.getTransform graphics)
723 *inverse-initial-transform* (-> graphics
724 .getTransform
725 .createInverse)
726 *event-dispatcher* (:event-dispatcher scene)
727 *width* width
728 *height* height
729 *clip* (Rectangle2D$Double. 0 0 width height)
730 *time* (System/nanoTime)]
731 (apply-theme)
732 (let [tmp-watcher (Object.)]
733 ;; Keep current context observers until the rendering is
734 ;; complete. Some observers may be invoked twice if they
735 ;; appear in both groups until tmp-watcher is removed.
736 (replace-observers-watcher scene tmp-watcher)
737 (try
738 (render! (:layer scene))
739 (finally
740 (remove-observers tmp-watcher)
741 (commit (:event-dispatcher scene)))))))
743 (defn scene-geometry [scene]
744 (binding [*scene* scene]
745 (geometry (:layer scene))))
747 (defn set-cursor! [^Cursor cursor]
748 (when-let [^Component component (:component *scene*)]
749 (EventQueue/invokeLater #(.setCursor component cursor))))