changeset 34:6975b9a71eec

Finally use var bindings instead of a context record.
author Mikhail Kryshen <mikhail@kryshen.net>
date Thu, 08 Jul 2010 05:27:54 +0400
parents 439f6ecee119 (current diff) 828795987d4c (diff)
children 0d593970cb76
files src/indyvon/component.clj src/indyvon/core.clj src/indyvon/layers.clj
diffstat 3 files changed, 182 insertions(+), 186 deletions(-) [+]
line wrap: on
line diff
--- a/src/indyvon/component.clj	Wed Jul 07 07:17:08 2010 +0400
+++ b/src/indyvon/component.clj	Thu Jul 08 05:27:54 2010 +0400
@@ -5,54 +5,50 @@
 ;;
 
 (ns indyvon.component
-  (:use indyvon.core indyvon.layers)
-  (:import (indyvon.core Size Location)
-           (java.awt Component Graphics2D Dimension Color)
+  (:use indyvon.core
+        indyvon.layers)
+  (:import (indyvon.core Size Bounds)
+           (java.awt Graphics2D Component Dimension Color)
            (javax.swing JFrame JPanel)))
 
 (defn- font-context [^Component component]
   (.getFontRenderContext (.getFontMetrics component (.getFont component))))
 
 (defn paint-component
-  [^Component component layer context ^Graphics2D graphics]
+  [^Component component layer ^Graphics2D graphics event-dispatcher]
   (let [size (.getSize component)
         width (.width size)
-        height (.height size)
-        context (assoc context
-                  :x 0
-                  :y 0
-                  :width width
-                  :height height
-                  :clip (indyvon.core.Bounds. 0 0 width height)
-                  :target component
-                  :graphics graphics
-                  :font-context (.getFontRenderContext graphics)
-                  :update-fn #(.repaint component))]
+        height (.height size)]
     (.clearRect graphics 0 0 width height)
-    (draw! layer context))
-  (commit (:event-dispatcher context)))
+    (let [bounds (Bounds. 0 0 width height)]
+      (binding [*graphics* graphics
+                *font-context* (.getFontRenderContext graphics)
+                *target* component
+                *event-dispatcher* event-dispatcher
+                *update* #(.repaint component)
+                *bounds* bounds
+                *clip* bounds]
+        (render! layer nil)
+        (commit event-dispatcher)))))
 
-(defn preferred-size [component layer context]
-  (let [context (assoc context
-                  :target component
-                  :font-context (font-context component))
-        s (size layer context)]
-    (Dimension. (:width s) (:height s))))
+(defn preferred-size [component layer]
+  (binding [*target* component
+            *font-context*' (font-context component)]
+    (let [s (size layer nil)]
+      (Dimension. (:width s) (:height s)))))
 
 (defn make-jpanel
   ([layer]
      (make-jpanel layer (root-event-dispatcher)))
   ([layer event-dispatcher]
-     (let [context (default-context)
-           context (assoc context :event-dispatcher event-dispatcher)
-           panel
+     (let [panel
            (proxy [JPanel] []
              (paintComponent [g]
-                (paint-component this layer context g))
+                (paint-component this layer g event-dispatcher))
              (getPreferredSize []
-                (preferred-size this layer context)))]
+                (preferred-size this layer)))]
+       (.setBackground panel (:back-color *theme*))
        (listen! event-dispatcher panel)
-       (.setBackground panel (-> context :theme :back-color))
        panel)))
 
 (comment
@@ -62,28 +58,28 @@
     (def layer1
          (reify
           Layer
-          (render! [this context]
-             (let-handlers this [context]
-               (doto (graphics context)
+          (render! [layer opts]
+             (with-handlers layer
+               (doto *graphics*
                  (.setColor Color/RED)
-                 (.fillRect 0 0 (:width context) (:height context)))
+                 (.fillRect 0 0 (:width *bounds*) (:height *bounds*)))
                (:mouse-entered e (println e))
                (:mouse-exited e (println e))
                (:mouse-moved e (println e))))
-          (size [this context] (Size. 30 20))))
+          (size [layer opts] (Size. 30 20))))
     
     (def layer1b (border-layer layer1 2 3))
     
     (def layer2
          (reify
           Layer
-          (render! [this context]
-             (doto (graphics context)
+          (render! [layer opts]
+             (doto *graphics*
                (.setColor Color/YELLOW)
-               (.fillRect 0 0 (:width context) (:height context)))
-             (draw! layer1b context 10 5)
-             (draw! layer1 context 55 5))
-          (size [this context] (Size. 70 65))))
+               (.fillRect 0 0 (:width *bounds*) (:height *bounds*)))
+             (draw! layer1b [10 5])
+             (draw! layer1 [55 5]))
+          (size [layer opts] (Size. 70 65))))
     
     (def layer3
          (border-layer (text-layer "Sample\ntext" :right :center)))
@@ -98,8 +94,8 @@
                fl (ref (fps-layer 0.0))]
            (reify
             Layer
-            (render! [this c]
-               (draw! @fl c)
+            (render! [layer opts]
+               (render! @fl nil)
                (dosync
                 (alter frames + 1)
                 (let [time (System/currentTimeMillis)
@@ -108,19 +104,19 @@
                     (ref-set fl (fps-layer (/ @frames elapsed)))
                     (ref-set frames 0)
                     (ref-set last time)))))
-            (size [this c] (size @fl c)))))
+            (size [layer opts] (size @fl nil)))))
     
     (def layer
          (reify Layer
-           (render! [this context]
-             (update context)
-             (doto (graphics context)       
+           (render! [layer opts]
+             (*update*)
+             (doto *graphics*
                (.setColor (rand-nth [Color/BLACK Color/BLUE Color/RED]))
-               (.drawLine 0 0 (:width context) (:height context)))
-             (draw! layer2 context 15 20)
-             (draw! layer3 context 100 100 80 50)
-             (draw! fps context))
-           (size [this context] (Size. 400 300))))
+               (.drawLine 0 0 (:width *bounds*) (:height *bounds*)))
+             (draw! layer2 [15 20])
+             (draw! layer3 [100 100 80 50])
+             (render! fps nil))
+           (size [layer opts] (Size. 400 300))))
     
     (doto frame
       (.addWindowListener
--- a/src/indyvon/core.clj	Wed Jul 07 07:17:08 2010 +0400
+++ b/src/indyvon/core.clj	Thu Jul 08 05:27:54 2010 +0400
@@ -6,24 +6,40 @@
 
 (ns indyvon.core
   (:import (java.awt Graphics2D Component Color Font)
-           (java.awt.event MouseListener MouseMotionListener)))
+           (java.awt.event MouseListener MouseMotionListener)
+           (java.awt.font FontRenderContext)))
 
-(defprotocol Layer
-  "Basic UI element."
-  (render! [this context])
-  (size [this context]))
+(def ^Graphics2D *graphics*)
+(def ^FontRenderContext *font-context*)
+(def ^Component *target*)
+(def *bounds*)
+(def *clip*)
+(def *update*)
+(def *event-dispatcher*)
+
+(defrecord Theme [fore-color back-color border-color font])
+
+(defn default-theme []
+  (Theme. Color/BLACK Color/WHITE Color/BLUE (Font. "Sans" Font/PLAIN 12)))
+
+(def *theme* (default-theme))
 
 (defrecord Location [x y])
 (defrecord Size [width height])
 (defrecord Bounds [x y width height])
 
+(defprotocol Layer
+  "Basic UI element."
+  (render! [this opts])
+  (size [this opts]))
+
 ;; TODO: modifiers
 (defrecord MouseEvent [id when x y x-on-screen y-on-screen button])
 
 (defprotocol EventDispatcher
   (listen! [this ^Component component]
      "Listen for events on the specified AWT Component.")
-  (create-dispatcher [this context handle handlers]
+  (create-dispatcher [this handle handlers]
      "Returns new event dispatcher associated with the specified event
       handlers (an event-id -> handler-fn map). Handle is used to
       match the contexts between commits.")
@@ -32,18 +48,18 @@
 
 (defprotocol Anchored
   "Provide anchor point for Layers. Used by viewport."
-  (anchor [this context h-align v-align]
+  (anchor [this h-align v-align opts]
      "Anchor point: [x y], h-align could be :left, :center or :right,
       v-align is :top, :center or :bottom"))
 
 ;; Default implementation of Anchored for any Layer.
 (extend-protocol Anchored
   indyvon.core.Layer
-  (anchor [this context h-align v-align]
+  (anchor [this h-align v-align opts]
           (if (and (= h-align :left)
                    (= v-align :top))
             (Location. 0 0)
-            (let [size (size this context)]
+            (let [size (size this opts)]
               (Location.
                (case h-align
                      :top 0
@@ -54,26 +70,6 @@
                      :center (/ (:height size) 2)
                      :bottom (:height size)))))))
 
-(defrecord Theme [fore-color back-color border-color font])
-
-(defn default-theme []
-  (Theme. Color/BLACK Color/WHITE Color/BLUE (Font. "Sans" Font/PLAIN 12)))
-  
-(defrecord LayerContext [x y width height clip
-                         update-fn font-context theme
-                         target event-dispatcher])
-
-(defn default-context []
-  (LayerContext. 0 0 0 0 nil nil nil (default-theme) nil nil))
-
-(defn update [context]
-  ((:update-fn context)))
-
-(defn ^Graphics2D graphics
-  "Get AWT Graphics2D from context."
-  [context]
-  (:graphics context))
-
 (defn- ^Graphics2D make-graphics [^Graphics2D graphics x y w h]
   (.create graphics x y w h))
 
@@ -82,69 +78,72 @@
     (.setColor (:fore-color theme))
     (.setFont (:font theme))))
 
-(defn intersect [bounds x y w h]
-  (let [x12 (+ x w)
-        y12 (+ y h)
-        x21 (:x bounds)
-        y21 (:y bounds)
-        x22 (+ x21 (:width bounds))
-        y22 (+ y21 (:height bounds))
-        x1 (max x x21)
-        y1 (max y y21)
+(defn intersect [b1 b2]
+  (let [x11 (:x b1)
+        y11 (:y b1)
+        x12 (+ x11 (:width b1))
+        y12 (+ y11 (:height b1))
+        x21 (:x b2)
+        y21 (:y b2)
+        x22 (+ x21 (:width b2))
+        y22 (+ y21 (:height b2))
+        x1 (max x11 x21)
+        y1 (max y11 y21)
         x2 (min x12 x22)
         y2 (min y12 y22)]
     (Bounds. x1 y1 (- x2 x1) (- y2 y1))))
 
-(defn translate [context x y w h]
-  (let [ax (+ (:x context) x)
-        ay (+ (:y context) y)]
-    (assoc context
-      :x (+ (:x context) x)
-      :y (+ (:y context) y)
-      :width w
-      :height h
-      :clip (intersect (:clip context) ax ay w h)
-      :graphics (apply-theme
-                 (make-graphics (:graphics context) x y w h)
-                 (:theme context)))))
+(defn with-translate* [x y w h f & args]
+  (let [graphics (apply-theme (.create *graphics* x y w h) *theme*)
+        bounds (Bounds. (+ x (:x *bounds*))
+                        (+ y (:y *bounds*))
+                        w h)]
+    (try
+      (apply with-bindings* {#'*bounds* bounds
+                             #'*clip* (intersect bounds *clip*)
+                             #'*graphics* graphics}
+             f args)
+      (finally
+       (.dispose graphics)))))
+
+(defmacro with-translate [x y w h & body]
+  `(with-translate* ~x ~y ~w ~h (fn [] ~@body)))
+
+
+
+(defn with-handlers* [handle handlers f & args]
+  (apply with-bindings*
+         {#'*event-dispatcher*
+          (create-dispatcher *event-dispatcher* handle handlers)}
+         f args))
+
+(defmacro with-handlers
+  "specs => (:event-id name & handler-body)*
+
+  Execute form with the specified event handlers."
+  [handle form & specs]
+  `(with-handlers* ~handle
+     ~(reduce (fn [m spec]
+                (assoc m (first spec)
+                       `(fn [~(second spec)]
+                          ~@(nnext spec)))) {}
+                          specs)
+     (fn [] ~form)))
+
+(defn- geometry-vec [geometry]
+  (if (vector? geometry)
+    geometry
+    [(:x geometry) (:y geometry) (:width geometry) (:height geometry)]))
 
 (defn draw!
-  "Render layer in a new graphics context."
-  ([layer context]
-     (render! layer context))
-  ([layer context x y]
-     (let [s (size layer context)]
-       (draw! layer context x y (:width s) (:height s))))
-  ([layer context x y w h]
-     (let [context (translate context x y w h)]
-       (try
-         (render! layer context)
-         (finally
-          (.dispose (:graphics context)))))))
-
-(defn add-handlers [context handle handlers]
-  "Returns new context with the specified event handlers."
-  (assoc context
-    :event-dispatcher
-    (create-dispatcher (:event-dispatcher context) context
-                       handle handlers)))
-
-(defmacro let-handlers [handle bindings form & specs]
-  "bindings => [binding-form context] or [context-symbol]
-   specs => (:event-id name & handler-body)*
-
-  Execute form with the specified event handlers."
-  (let [[binding context] bindings
-        context (or context binding)]
-    `(let [context# ~context
-           ~binding
-           (add-handlers context# ~handle
-             ~(reduce (fn [m spec]
-                        (assoc m (first spec)
-                               `(fn [~(second spec)]
-                                  ~@(nnext spec)))) {}
-                                  specs))]
-           ~form)))
+  "Draw a layer. Geometry is either a map or vector [x y] or
+   [x y width height]."
+  [layer geometry & args]
+  (let [[x y w h] (geometry-vec geometry)
+        size (if-not (and w h) (size layer args))
+        w (or w (:width size))
+        h (or h (:height size))]
+    (with-translate* x y w h render! layer args)))
 
 ;;
 ;; EventDispatcher implementation
@@ -159,17 +158,18 @@
       java.awt.event.MouseEvent/MOUSE_PRESSED  :mouse-pressed
       java.awt.event.MouseEvent/MOUSE_RELEASED :mouse-released})
 
-(defrecord DispatcherNode [handle handlers parent bounds]
+(defrecord DispatcherNode [handle handlers parent bounds bindings]
   EventDispatcher
   (listen! [this component]
      (listen! parent component))
-  (create-dispatcher [this context handle handlers]
-     (create-dispatcher parent context handle handlers))
+  (create-dispatcher [this handle handlers]
+     (create-dispatcher parent handle handlers))
   (commit [this]
      (commit parent)))
 
-(defn- make-node [c handle handlers]
-  (DispatcherNode. handle handlers (:event-dispatcher c) (:clip c)))
+(defn- make-node [handle handlers]
+  (DispatcherNode. handle handlers *event-dispatcher* *clip*
+                   (get-thread-bindings)))
 
 (defn- assoc-cons [m key val]
   (assoc m key (cons val (get m key))))
@@ -209,9 +209,10 @@
   ([nodes event id]
      (doseq [node nodes]
        (when-let [handler (get (:handlers node) id)]
-         (handler
-          (translate-mouse-event event
-            (-> node :bounds :x) (-> node :bounds :y) id))))
+         (with-bindings* (:bindings node)
+           handler
+           (translate-mouse-event event
+             (-> node :bounds :x) (-> node :bounds :y) id))))
      id))
 
 (defn- dispatch-mouse-motion*
@@ -259,8 +260,8 @@
         (doto component
           (.addMouseListener this)
           (.addMouseMotionListener this)))
-     (create-dispatcher [this context handle handlers]
-        (let [node (make-node context handle handlers)]
+     (create-dispatcher [this handle handlers]
+        (let [node (make-node handle handlers)]
           (dosync (alter tree-r add-node node))
           node))
      (commit [this]
--- a/src/indyvon/layers.clj	Wed Jul 07 07:17:08 2010 +0400
+++ b/src/indyvon/layers.clj	Thu Jul 08 05:27:54 2010 +0400
@@ -7,7 +7,7 @@
 (ns indyvon.layers
   (:use indyvon.core)
   (:import (indyvon.core Size Location)
-           (java.awt Cursor)
+           (java.awt Font Cursor)
            (java.awt.font FontRenderContext TextLayout)))
 
 ;; Define as macro to avoid unnecessary calculation of inner and outer
@@ -33,30 +33,33 @@
   ([content width gap]
      (let [offset (+ width gap)]
        (reify Layer
-        (render! [l c]
-           (let [w (:width c)
-                 h (:height c)]
-             (.setColor (graphics c) (-> c :theme :border-color))
+        (render! [l opts]
+           (let [w (:width *bounds*)
+                 h (:height *bounds*)]
+             (.setColor *graphics* (:border-color *theme*))
              (doseq [i (range 0 width)]
-               (.drawRect (graphics c) i i (- w 1 i i) (- h 1 i i)))
-             (draw! content c offset offset (- w offset offset)
-                    (- h offset offset))))
-        (size [l c]
-           (let [s (size content c)]
+               (.drawRect *graphics* i i (- w 1 i i) (- h 1 i i)))
+             (apply draw! content
+                    [offset offset (- w offset offset) (- h offset offset)]
+                    opts)))
+        (size [l opts]
+           (let [s (size content opts)]
              (Size. (+ (:width s) offset offset)
                     (+ (:height s) offset offset))))))))
 
-(defn- re-split [re s]
+(defn- re-split [^java.util.regex.Pattern re s]
   (seq (.split re s)))
 
-(defn- layout-text [lines font font-context]
-  (map #(TextLayout. % font font-context) lines))
+(defn- layout-text [lines ^Font font ^FontRenderContext font-context]
+  (map #(TextLayout. ^String % font font-context) lines))
 
 (defn- text-width [layouts]
-  (reduce #(max %1 (.getAdvance %2)) 0 layouts))
+  (reduce (fn [w ^TextLayout tl] (max w (.getAdvance tl))) 0 layouts))
 
 (defn- text-height [layouts]
-  (reduce #(+ %1 (.getAscent %2) (.getDescent %2) (.getLeading %2))
+  (reduce (fn [w ^TextLayout tl] (+ w (.getAscent tl)
+                                   (.getDescent tl)
+                                   (.getLeading tl)))
           0 layouts))
 
 (defn text-layer
@@ -66,24 +69,21 @@
   ([text h-align v-align]
      (let [lines (re-split #"\r\n|\n|\r|\u0085|\u2028|\u2029" text)]
        (reify Layer
-        (render! [l c]
-           (let [w (:width c)
-                 h (:height c)
-                 font (.getFont (graphics c))
-                 font-context (:font-context c)
-                 layouts (layout-text lines font font-context)
+        (render! [layer opts]
+           (let [w (:width *bounds*)
+                 h (:height *bounds*)
+                 font (.getFont *graphics*)
+                 layouts (layout-text lines font *font-context*)
                  y (align-y (text-height layouts) h v-align)]
              (loop [layouts layouts, y y]
-               (when-first [layout layouts]
+               (when-first [^TextLayout layout layouts]
                  (let [ascent (.getAscent layout)
                        lh (+ ascent (.getDescent layout) (.getLeading layout))
                        x (align-x (.getAdvance layout) w h-align)]
-                   (.draw layout (graphics c) x (+ y ascent))
+                   (.draw layout *graphics* x (+ y ascent))
                    (recur (next layouts) (+ y lh)))))))
-        (size [l c]
-           (let [layouts (layout-text lines
-                                      (-> c :theme :font)
-                                      (:font-context c))
+        (size [layer opts]
+           (let [layouts (layout-text lines (:font *theme*) *font-context*)
                  width (text-width layouts)
                  height (text-height layouts)]
              (Size. width height)))))))
@@ -100,31 +100,30 @@
         last-height (ref 0)]
     (reify
      Layer
-     (render! [layer c]
-        (let-handlers layer [c]
-         (let [anchor (anchor content c h-align v-align)
-               width (:width c)
-               height (:height c)]
+     (render! [layer opts]
+        (with-handlers layer
+         (let [anchor (anchor content h-align v-align opts)
+               width (:width *bounds*)
+               height (:height *bounds*)]
            (dosync
             (alter x + (align-x width @last-width h-align))
             (alter y + (align-y height @last-height v-align))
             (ref-set last-width width)
             (ref-set last-height height))
-           (draw! content c
-                  (- 0 @x (:x anchor))
-                  (- 0 @y (:y anchor))))
+           (apply draw! content
+                  [(- 0 @x (:x anchor)) (- 0 @y (:y anchor))] opts))
          (:mouse-pressed e
           (dosync
            (ref-set fix-x (:x-on-screen e))
            (ref-set fix-y (:y-on-screen e)))
-          (->> Cursor/MOVE_CURSOR Cursor. (.setCursor (:target c))))
+          (->> Cursor/MOVE_CURSOR Cursor. (.setCursor *target*)))
          (:mouse-released e
-          (->> Cursor/DEFAULT_CURSOR Cursor. (.setCursor (:target c))))
+          (->> 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 c))))
-     (size [layer c] (size content c))))))
+          (*update*))))
+     (size [layer opts] (size content opts))))))