Mercurial > hg > indyvon

changeset 104:491152048c89

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Added Scene record to enclose state retained between repaints.
author Mikhail Kryshen <mikhail@kryshen.net>
date Thu, 19 May 2011 20:10:45 +0400
parents 9b81174f0511
children f3dedece38f3
files src/net/kryshen/indyvon/async.clj src/net/kryshen/indyvon/component.clj src/net/kryshen/indyvon/core.clj src/net/kryshen/indyvon/layers.clj
diffstat 4 files changed, 102 insertions(+), 87 deletions(-) [+]
line wrap: on
line diff
--- a/src/net/kryshen/indyvon/async.clj	Thu May 19 17:01:46 2011 +0400
+++ b/src/net/kryshen/indyvon/async.clj	Thu May 19 20:10:45 2011 +0400
@@ -119,23 +119,21 @@
       (.setComposite g AlphaComposite/Clear)
       (.fillRect g 0 0 (:width async-layer) (:height async-layer))
       (.setComposite g AlphaComposite/Src)
-      (draw-root! (:content async-layer)
-                  g
-                  (:width async-layer)
-                  (:height async-layer)
-                  ;; TODO: use operational event dispatcher.
-                  dummy-event-dispatcher))
+      (draw-scene! (:scene async-layer)
+                   g
+                   (:width async-layer)
+                   (:height async-layer)))
     (update async-layer)))
 
 (defn- draw-offscreen-async [async-layer]
   (.execute ^ThreadPoolExecutor (:executor async-layer)
             #(draw-offscreen async-layer)))
 
-(defrecord AsyncLayer [content width height executor buffers]
+(defrecord AsyncLayer [scene width height executor buffers]
   Layer
   (render! [layer]
     (repaint-on-update layer)
-    (add-context-observer content (fn [_ _] (draw-offscreen-async layer)))
+    (add-context-observer scene (fn [_ _] (draw-offscreen-async layer)))
     (when-not @buffers
       ;; TODO: dynamic size, recreate buffers when size increases.
       (let [device-conf (.getDeviceConfiguration *graphics*)
@@ -173,6 +171,9 @@
   ([content width height]
      (async-layer content width height nil))
   ([content width height priority]
-     (AsyncLayer. content width height
+     ;; TODO: use operational event dispatcher.
+     (AsyncLayer. (make-scene content)
+                  width
+                  height
                   (create-executor priority)
                   (ref nil))))
--- a/src/net/kryshen/indyvon/component.clj	Thu May 19 17:01:46 2011 +0400
+++ b/src/net/kryshen/indyvon/component.clj	Thu May 19 20:10:45 2011 +0400
@@ -36,23 +36,28 @@
                *font-context* (font-context c#)]
        ~@body)))
 
+(defn- paint-component [^Component c ^Graphics g scene]
+  (let [size (.getSize c)]
+    (.setColor g (:back-color *theme*))
+    (.fillRect g 0 0 (.width size) (.height size))
+    (draw-scene! scene g (.width size) (.height size))))
+
+(defn- preferred-size [^Component c scene]
+  (let [s (scene-size scene (font-context c))]
+    (Dimension. (:width s) (:height s))))
+
 (defn ^JPanel make-jpanel
   ([layer]
      (make-jpanel layer (root-event-dispatcher)))
   ([layer event-dispatcher]
-     (let [panel
-           (proxy [JPanel] []
-             (paintComponent [^Graphics g]
-               (let [size (.getSize ^Component this)]
-                 (.setColor g (:back-color *theme*))
-                 (.fillRect g 0 0 (.width size) (.height size))
-                 (draw-root! layer g (.width size) (.height size)
-                             event-dispatcher this)))
-             (getPreferredSize []
-               (let [s (root-size layer (font-context this) this)]
-                 (Dimension. (:width s) (:height s)))))]
+     (let [panel (proxy [JPanel] [])
+           scene (make-scene layer event-dispatcher panel)]
+       (update-proxy
+        panel
+        {"paintComponent" #(paint-component %1 %2 scene)
+         "getPreferredSize" #(preferred-size % scene)})
        (.setBackground panel (:back-color *theme*))
-       (add-observer panel layer (fn [w _]
+       (add-observer panel scene (fn [w _]
                                    ;; Use the first observer argument
                                    ;; instead of closing over panel to
                                    ;; allow the panel and associated
--- a/src/net/kryshen/indyvon/core.clj	Thu May 19 17:01:46 2011 +0400
+++ b/src/net/kryshen/indyvon/core.clj	Thu May 19 20:10:45 2011 +0400
@@ -19,7 +19,8 @@
 
 (ns net.kryshen.indyvon.core
   (:import
-   (java.awt Graphics2D RenderingHints Component Color Font Shape)
+   (java.awt Graphics2D RenderingHints Component Color Font Shape
+             Cursor EventQueue)
    (java.awt.geom AffineTransform Point2D$Double Rectangle2D$Double Area)
    (java.awt.event MouseListener MouseMotionListener
                    MouseWheelListener MouseWheelEvent)
@@ -57,14 +58,14 @@
   *clip*)
 
 (def ^{:dynamic true
-       :doc "The root (background) layer of the scene."}
-  *root*)
-
-(def ^{:dynamic true
        :doc "Time in nanoseconds when the rendering of the current
              frame starts."}
   *time*)
 
+(def ^{:dynamic true
+       :doc "Encloses state that should be retained between repaints."}
+  *scene*)
+
 (def ^{:dynamic true}
   *event-dispatcher*)
 
@@ -217,22 +218,21 @@
 
 (defn add-context-observer
   "Observer registered with this function will be automatically
-  removed after the next frame rendering is complete."
+  removed after the next repaint is complete."
   [target f]
-  (let [root *root*]
-    (add-observer root target f)))
+  (add-observer *scene* target f))
 
 (defn repaint-on-update
   "Trigger repaint of the current scene when the target updates."
   [target]
-  (let [root *root*]
-    (if (not= root target)
-      (add-observer root target (fn [w _] (update w))))))
+  (let [scene *scene*]
+    (if-not (identical? scene target)
+      (add-observer scene target (fn [w _] (update w))))))
 
 (defn repaint
   "Repaint the current scene."
   []
-  (update *root*))
+  (update *scene*))
 
 ;;
 ;; Rendering
@@ -427,56 +427,6 @@
      (let [anchor (anchor layer h-align v-align)]
        (draw! layer (- x (:x anchor)) (- y (:y anchor)) w h))))
 
-(defn draw-root!
-  "Draws the root layer."
-  ([layer graphics width height event-dispatcher]
-     (draw-root! layer graphics width height event-dispatcher nil))
-  ([layer ^Graphics2D graphics width height event-dispatcher target]
-     ;; (.setRenderingHint graphics
-     ;;                    RenderingHints/KEY_INTERPOLATION
-     ;;                    RenderingHints/VALUE_INTERPOLATION_BILINEAR)
-     ;; (.setRenderingHint graphics
-     ;;                    RenderingHints/KEY_ALPHA_INTERPOLATION
-     ;;                    RenderingHints/VALUE_ALPHA_INTERPOLATION_QUALITY)
-     ;; (.setRenderingHint graphics
-     ;;                    RenderingHints/KEY_ANTIALIASING
-     ;;                    RenderingHints/VALUE_ANTIALIAS_ON)
-     ;; (.setRenderingHint graphics
-     ;;                    RenderingHints/KEY_TEXT_ANTIALIASING
-     ;;                    RenderingHints/VALUE_TEXT_ANTIALIAS_ON)
-     (binding [*root* layer
-               *target* target
-               *graphics* graphics
-               *font-context* (.getFontRenderContext graphics)
-               *initial-transform* (.getTransform graphics)
-               *inverse-initial-transform*
-                 (-> graphics .getTransform .createInverse)
-               *event-dispatcher* event-dispatcher
-               *width* width
-               *height* height
-               *clip* (Rectangle2D$Double. 0 0 width height)
-               *time* (System/nanoTime)]
-       (apply-theme)
-       (let [tmp-watcher (Object.)]
-         ;; Keep current context observers until the rendering is
-         ;; complete. Some observers may be invoked twice if they
-         ;; appear in both groups until tmp-watcher is removed.
-         (replace-observers-watcher layer tmp-watcher)
-         (try
-           (render! layer)
-           (finally
-            (remove-observers tmp-watcher)
-            (commit event-dispatcher)))))))
-
-(defn root-size
-  ([layer font-context]
-     (root-size layer font-context nil))
-  ([layer font-context target]
-     (binding [*root* layer
-               *target* target
-               *font-context* font-context]
-       (layer-size layer))))
-
 ;;
 ;; Event handling.
 ;;
@@ -667,3 +617,64 @@
        (translate-and-dispatch @picked true event))
      (mouseMoved [this event]
        (dispatch-mouse-motion hovered @tree this event)))))
+
+;;
+;; Scene
+;;
+
+(defrecord Scene [layer event-dispatcher component])
+
+(defn make-scene
+  ([layer]
+     (make-scene layer dummy-event-dispatcher nil))
+  ([layer event-dispatcher]
+     (make-scene layer event-dispatcher nil))
+  ([layer event-dispatcher component]
+     (Scene. layer event-dispatcher component)))
+
+(defn draw-scene!
+  [scene ^Graphics2D graphics width height]
+  ;; (.setRenderingHint graphics
+  ;;                    RenderingHints/KEY_INTERPOLATION
+  ;;                    RenderingHints/VALUE_INTERPOLATION_BILINEAR)
+  ;; (.setRenderingHint graphics
+  ;;                    RenderingHints/KEY_ALPHA_INTERPOLATION
+  ;;                    RenderingHints/VALUE_ALPHA_INTERPOLATION_QUALITY)
+  ;; (.setRenderingHint graphics
+  ;;                    RenderingHints/KEY_ANTIALIASING
+  ;;                    RenderingHints/VALUE_ANTIALIAS_ON)
+  ;; (.setRenderingHint graphics
+  ;;                    RenderingHints/KEY_TEXT_ANTIALIASING
+  ;;                    RenderingHints/VALUE_TEXT_ANTIALIAS_ON)
+  (binding [*scene* scene
+            *graphics* graphics
+            *font-context* (.getFontRenderContext graphics)
+            *initial-transform* (.getTransform graphics)
+            *inverse-initial-transform* (-> graphics
+                                            .getTransform
+                                            .createInverse)
+            *event-dispatcher* (:event-dispatcher scene)
+            *width* width
+            *height* height
+            *clip* (Rectangle2D$Double. 0 0 width height)
+            *time* (System/nanoTime)]
+    (apply-theme)
+    (let [tmp-watcher (Object.)]
+      ;; Keep current context observers until the rendering is
+      ;; complete. Some observers may be invoked twice if they
+      ;; appear in both groups until tmp-watcher is removed.
+      (replace-observers-watcher scene tmp-watcher)
+      (try
+        (render! (:layer scene))
+        (finally
+         (remove-observers tmp-watcher)
+         (commit (:event-dispatcher scene)))))))
+  
+(defn scene-size [scene font-context]
+  (binding [*scene* scene
+            *font-context* font-context]
+    (layer-size (:layer scene))))
+
+(defn set-cursor! [^Cursor cursor]
+  (when-let [^Component component (:component *scene*)]
+    (EventQueue/invokeLater #(.setCursor component cursor))))
--- a/src/net/kryshen/indyvon/layers.clj	Thu May 19 17:01:46 2011 +0400
+++ b/src/net/kryshen/indyvon/layers.clj	Thu May 19 20:10:45 2011 +0400
@@ -333,11 +333,9 @@
        (dosync
         (ref-set fix-x (:x-on-screen e))
         (ref-set fix-y (:y-on-screen e)))
-       (when *target*
-         (->> Cursor/MOVE_CURSOR Cursor. (.setCursor *target*))))
+       (set-cursor! (Cursor. Cursor/MOVE_CURSOR)))
       (:mouse-released e
-       (when *target*
-         (->> Cursor/DEFAULT_CURSOR Cursor. (.setCursor *target*))))
+       (set-cursor! (Cursor. Cursor/DEFAULT_CURSOR)))
       (:mouse-dragged e
        (dosync
         (alter transform pre-translate