changeset 110:f3dedece38f3

Merged.
author Mikhail Kryshen <mikhail@kryshen.net>
date Mon, 10 Oct 2011 01:58:35 +0300
parents 5bb50e6661af (current diff) 491152048c89 (diff)
children 441fe457fc2b
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, 110 insertions(+), 107 deletions(-) [+]
line wrap: on
line diff
--- a/src/net/kryshen/indyvon/async.clj	Sat Oct 08 23:35:46 2011 +0300
+++ b/src/net/kryshen/indyvon/async.clj	Mon Oct 10 01:58:35 2011 +0300
@@ -118,23 +118,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*)
@@ -172,6 +170,9 @@
   ([content width height]
      (async-layer content width height nil))
   ([content width height priority]
-     (AsyncLayer. content width height
-                  (create-executor priority)
-                  (ref nil))))
+     ;; TODO: use operational event dispatcher.
+     (->AsyncLayer (make-scene content)
+                   width
+                   height
+                   (create-executor priority)
+                   (ref nil))))
--- a/src/net/kryshen/indyvon/component.clj	Sat Oct 08 23:35:46 2011 +0300
+++ b/src/net/kryshen/indyvon/component.clj	Mon Oct 10 01:58:35 2011 +0300
@@ -29,29 +29,28 @@
 (defn font-context [^Component component]
   (.getFontRenderContext (.getFontMetrics component (.getFont component))))
 
-(defmacro with-component [component & body]
-  `(let [c# ~component]
-     (binding [*target* c#
-               *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 [geom (scene-geometry scene (font-context c))]
+    (Dimension. (width geom) (height geom))))
 
 (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 [geom (root-geometry layer (font-context this) this)]
-                 (Dimension. (width geom) (height geom)))))]
+     (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
@@ -66,4 +65,4 @@
     (.pack)))
 
 (defn message [m]
-  (JOptionPane/showMessageDialog *target* m))
+  (JOptionPane/showMessageDialog (:component *scene*) m))
--- a/src/net/kryshen/indyvon/core.clj	Sat Oct 08 23:35:46 2011 +0300
+++ b/src/net/kryshen/indyvon/core.clj	Mon Oct 10 01:58:35 2011 +0300
@@ -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)
@@ -40,11 +41,6 @@
   *font-context*)
 
 (def ^{:dynamic true
-       :tag Component
-       :doc "Target AWT component, may be nil if drawing off-screen."}
-  *target*)
-
-(def ^{:dynamic true
        :doc "Width of the rendering area."}
   *width*)
 
@@ -57,14 +53,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*)
 
@@ -260,22 +256,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
@@ -478,56 +473,6 @@
               (- y (anchor-y geom v-align h))
               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-geometry
-  ([layer font-context]
-     (root-geometry layer font-context nil))
-  ([layer font-context target]
-     (binding [*root* layer
-               *target* target
-               *font-context* font-context]
-       (geometry layer))))
-
 ;;
 ;; Event handling.
 ;;
@@ -572,13 +517,12 @@
       java.awt.event.MouseEvent/MOUSE_WHEEL    :mouse-wheel})
 
 (def dummy-event-dispatcher
-     (reify
-      EventDispatcher
-      (listen! [this component])
-      (create-dispatcher [this handle handlers] this)
-      (commit [this])
-      (handle-picked? [this handle])
-      (handle-hovered? [this handle])))
+  (reify EventDispatcher
+    (listen! [_ _])
+    (create-dispatcher [this _ _] this)
+    (commit [_])
+    (handle-picked? [_ _])
+    (handle-hovered? [_ _])))
 
 (defrecord DispatcherNode [handle handlers parent
                            ^Shape clip ^AffineTransform transform
@@ -718,3 +662,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-geometry [scene font-context]
+  (binding [*scene* scene
+            *font-context* font-context]
+    (geometry (: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	Sat Oct 08 23:35:46 2011 +0300
+++ b/src/net/kryshen/indyvon/layers.clj	Mon Oct 10 01:58:35 2011 +0300
@@ -331,11 +331,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