Mercurial > hg > indyvon

changeset 65:fd1bcb67bc32

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
New mechanism for layers to trigger repaints.
author Mikhail Kryshen <mikhail@kryshen.net>
date Fri, 27 Aug 2010 01:24:31 +0400
parents 702a4939312d
children a1999c1f7289
files src/net/kryshen/indyvon/component.clj src/net/kryshen/indyvon/core.clj src/net/kryshen/indyvon/demo.clj src/net/kryshen/indyvon/layers.clj
diffstat 4 files changed, 136 insertions(+), 110 deletions(-) [+]
line wrap: on
line diff
--- a/src/net/kryshen/indyvon/component.clj	Thu Aug 26 06:29:30 2010 +0400
+++ b/src/net/kryshen/indyvon/component.clj	Fri Aug 27 01:24:31 2010 +0400
@@ -17,22 +17,6 @@
 (defn- font-context [^Component component]
   (.getFontRenderContext (.getFontMetrics component (.getFont component))))
 
-(defn paint-component
-  [^Component component layer ^Graphics2D graphics event-dispatcher]
-  (let [size (.getSize component)
-        width (.width size)
-        height (.height size)
-        update-fn #(.repaint component)]
-    (.clearRect graphics 0 0 width height)
-    (context-draw! layer component graphics event-dispatcher update-fn
-                   width height)))
-
-(defn preferred-size [component layer]
-  (binding [*target* component
-            *font-context*' (font-context component)]
-    (let [s (layer-size layer)]
-      (Dimension. (:width s) (:height s)))))
-
 (defn make-jpanel
   ([layer]
      (make-jpanel layer (root-event-dispatcher)))
@@ -40,9 +24,13 @@
      (let [panel
            (proxy [JPanel] []
              (paintComponent [g]
-                (paint-component this layer g event-dispatcher))
+                (let [size (.getSize ^Component this)]
+                  (draw-root! layer g (.width size) (.height size)
+                              event-dispatcher this)))
              (getPreferredSize []
-                (preferred-size this layer)))]
+                (let [s (root-size layer (font-context this) this)]
+                  (Dimension. (:width s) (:height s)))))]
        (.setBackground panel (:back-color *theme*))
+       (add-observer layer (fn [_] (.repaint panel)))
        (listen! event-dispatcher panel)
        panel)))
--- a/src/net/kryshen/indyvon/core.clj	Thu Aug 26 06:29:30 2010 +0400
+++ b/src/net/kryshen/indyvon/core.clj	Fri Aug 27 01:24:31 2010 +0400
@@ -29,10 +29,9 @@
 
 (def ^Shape *clip*)
 
-(def *event-dispatcher*)
+(def *root*)
 
-(def ^{:doc "Fn to be called in a layer context to request redraw."}
-     *update*)
+(def *event-dispatcher*)
 
 (def ^{:tag AffineTransform
        :doc "Initial transform associated with the graphics context"}
@@ -143,6 +142,24 @@
   (doseq [f (reduce #(concat %1 (get %2 target)) nil (vals @observers))]
     (apply f target args)))
 
+(defn repaint
+  "Repaint the current scene."
+  []
+  (update *root*))
+
+(defn add-context-observer
+  "Observer registered with this function will be automatically
+  removed after the next frame rendering is complete."
+  [target f]
+  (let [root *root*]
+    (add-observer target f root)))
+
+(defn repaint-on-update
+  "Trigger repaint of the current scene when the target updates."
+  [target]
+  (let [root *root*]
+    (add-observer target (fn [_] (update root)) root)))
+
 ;;
 ;; Rendering
 ;;
@@ -283,33 +300,6 @@
   ([layer x y width height]
      (with-bounds* x y width height render! layer)))
 
-;; TODO: объект-сцена вместо context-draw!
-;; Сцена устанавливает контекст и рисует слой. Сцена - слой?
-;; Сцена идентифицирует группу обозревателя слоев.
-;; Обновления любого слоя, изображенного в сцене, вызывает обновление сцены.
-;; Обозреватель сцены вызывает repaint().
-
-(defn context-draw!
-  "Sets up layer context, draws layer and commits event dispatcher."
-  ([layer graphics event-dispatcher update-fn width height]
-     (context-draw! layer nil graphics event-dispatcher update-fn width height))
-  ([layer component ^Graphics2D graphics event-dispatcher update-fn
-    width height]
-     (binding [*graphics* graphics
-               *font-context* (.getFontRenderContext graphics)
-               *initial-transform* (.getTransform graphics)
-               *inverse-initial-transform*
-                 (-> graphics .getTransform .createInverse)
-               *target* component
-               *update* update-fn
-               *event-dispatcher* event-dispatcher
-               *width* width
-               *height* height
-               *clip* (Rectangle2D$Double. 0 0 width height)]
-       (apply-theme)
-       (render! layer)
-       (commit event-dispatcher))))
-
 (defn draw-anchored!
   "Draws layer. Location is relative to the layer's anchor point for
    the specified alignment."
@@ -320,6 +310,41 @@
      (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]
+     (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)]
+       (let [tmp-group (Object.)]
+         (apply-theme)
+         (.clearRect graphics 0 0 width height)
+         (change-group-id layer tmp-group)
+         (try
+           (render! layer)
+           (finally
+            (remove-group tmp-group)
+            (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))))
+
 ;;
 ;; EventDispatcher implementation
 ;;
--- a/src/net/kryshen/indyvon/demo.clj	Thu Aug 26 06:29:30 2010 +0400
+++ b/src/net/kryshen/indyvon/demo.clj	Fri Aug 27 01:24:31 2010 +0400
@@ -76,7 +76,7 @@
      (reify
       Layer
       (render! [layer]
-         ;;(*update*)
+         ;;(repaint)
          (doto *graphics*
            (.setColor (rand-nth [Color/BLACK Color/BLUE Color/RED]))
            (.drawLine 0 0 *width* *height*))
--- a/src/net/kryshen/indyvon/layers.clj	Thu Aug 26 06:29:30 2010 +0400
+++ b/src/net/kryshen/indyvon/layers.clj	Fri Aug 27 01:24:31 2010 +0400
@@ -145,11 +145,11 @@
                  height (text-height layouts)]
              (Size. width height)))))))
 
-(defn- ^ImageObserver image-observer [update-fn]
+(defn- ^ImageObserver image-observer [layer]
   (reify
    ImageObserver
    (imageUpdate [this img infoflags x y width height]
-      (update-fn)
+      (update layer)
       (zero? (bit-and infoflags
                       (bit-or ImageObserver/ALLBITS
                               ImageObserver/ABORT))))))
@@ -164,72 +164,83 @@
     (reify
      Layer
      (render! [layer]
-        (.drawImage *graphics* image 0 0 (image-observer *update*)))
+        (repaint-on-update layer)
+        (.drawImage *graphics* image 0 0 (image-observer layer)))
      (layer-size [layer]
-        (let [observer (image-observer *update*)
+        (let [observer (image-observer layer)
               width (.getWidth image observer)
               height (.getHeight image observer)
               width (if (pos? width) width 1)
               height (if (pos? height) height 1)]
           (Size. width height))))))
 
-(defn async-layer
+(defn- create-buffer [async-layer]
+  (BufferedImage. (:width async-layer) (:height async-layer)
+                  BufferedImage/TYPE_INT_ARGB))
+
+(defn- draw-offscreen [async-layer]
+  ;;(Thread/sleep 3000)
+  (let [buffers (:buffers async-layer)
+        ^Image b (dosync
+                  (let [b (peek @buffers)]
+                    (alter buffers pop)
+                    b))]
+    (try
+      ;; TODO: use operational event dispatcher.
+      (draw-root! (:content async-layer)
+                  (.getGraphics b)
+                  (:width async-layer)
+                  (:height async-layer)
+                  dummy-event-dispatcher)
+      (finally
+       (dosync
+        (alter buffers conj b)
+        (ref-set (:updated async-layer) true))))
+    (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 updated]
+  Layer
+  (render! [layer]
+     (repaint-on-update layer)
+     (add-context-observer content (fn [_] (draw-offscreen-async layer)))
+     (when-not @buffers
+       ;; TODO: dynamic size, recreate buffers when size increases.
+       (let [new-buffers [(create-buffer layer) (create-buffer layer)]]
+         (dosync
+          (ref-set buffers new-buffers)))
+       (draw-offscreen-async layer))
+     (let [buffer (dosync
+            (if @updated
+              (let [b (peek @buffers)]
+                (alter buffers pop)
+                (ref-set updated false)
+                b)
+              (let [b (first @buffers)]
+                (alter buffers subvec 1)
+                b)))]
+       (.drawImage *graphics* ^Image buffer 0 0 nil)
+       (dosync
+        (alter buffers #(vec (cons buffer %))))))
+  (layer-size [layer]
+     (Size. width height)))
+
+(defn async-layer 
   "Creates layer that draws the content asynchroniously in an
    offscreen buffer."
   [content width height]
-  (let [executor (ThreadPoolExecutor. (int 1) (int 1) (long 0) TimeUnit/SECONDS
-                   (ArrayBlockingQueue. 1)
-                   (ThreadPoolExecutor$DiscardOldestPolicy.))
-        buffers (ref nil)
-        updated (ref false)
-        update-fn (ref nil)
-        create-buffer
-          #(BufferedImage. width height BufferedImage/TYPE_INT_ARGB)
-        draw-offscreen
-          (fn draw-offscreen []
-            ;;(Thread/sleep 3000)
-            (let [^Image b (dosync
-                            (let [b (peek @buffers)]
-                              (alter buffers pop)
-                              b))]
-              (try
-                ;; TODO: use operational event dispatcher.
-                (context-draw! content
-                               (.getGraphics b)
-                               dummy-event-dispatcher
-                               #(.execute executor draw-offscreen)
-                               width height)
-                (finally
-                 (dosync
-                  (alter buffers conj b)
-                  (ref-set updated true))))
-                (update-fn)))]
-    (reify
-     Layer
-     (render! [layer]
-        (when-not @buffers
-          ;; TODO: dynamic size, recreate buffers when size increases.
-          (let [new-buffers [(create-buffer) (create-buffer)]]
-            (dosync
-             (ref-set buffers new-buffers)
-             (ref-set update-fn *update*)))
-          (.execute executor draw-offscreen))
-        (let [buffer (dosync
-                 (ref-set update-fn *update*)
-                 (if @updated
-                   (let [b (peek @buffers)]
-                     (alter buffers pop)
-                     (ref-set updated false)
-                     b)
-                   (let [b (first @buffers)]
-                     (alter buffers subvec 1)
-                     b)))]
-          (.drawImage *graphics* ^Image buffer 0 0 nil)
-          (dosync
-           (alter buffers #(vec (cons buffer %))))))
-     (layer-size [layer]
-        (Size. width height)))))
-
+  (AsyncLayer. content width height
+               (ThreadPoolExecutor.
+                (int 1) (int 1)
+                (long 0) TimeUnit/SECONDS
+                (ArrayBlockingQueue. 1)
+                (ThreadPoolExecutor$DiscardOldestPolicy.))
+               (ref nil)
+               (ref false)))
+    
 (defn miniature
   "Creates layer that asynchroniously renders view of the content
   scaled to the specified size."
@@ -272,16 +283,18 @@
            (dosync
             (ref-set fix-x (:x-on-screen e))
             (ref-set fix-y (:y-on-screen e)))
-           (->> Cursor/MOVE_CURSOR Cursor. (.setCursor *target*)))
+           (when *target*
+             (->> Cursor/MOVE_CURSOR Cursor. (.setCursor *target*))))
           (:mouse-released e
-           (->> Cursor/DEFAULT_CURSOR Cursor. (.setCursor *target*)))
+           (when *target*
+             (->> Cursor/DEFAULT_CURSOR Cursor. (.setCursor *target*))))
           (:mouse-dragged e
            (dosync
             (alter x + (- @fix-x (:x-on-screen e)))
             (alter y + (- @fix-y (:y-on-screen e)))
             (ref-set fix-x (:x-on-screen e))
             (ref-set fix-y (:y-on-screen e)))
-           (*update*))))
+           (repaint))))
      (layer-size [layer] (layer-size content))))))
 
 ;;