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