--- a/src/indyvon/component.clj	Mon Jul 05 06:11:42 2010 +0400
+++ b/src/indyvon/component.clj	Thu Jul 08 05:27:54 2010 +0400
@@ -5,36 +5,41 @@
 ;;
 
 (ns indyvon.component
-  (:use indyvon.core)
-  (:import (java.awt Component 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]
+(defn- font-context [^Component component]
   (.getFontRenderContext (.getFontMetrics component (.getFont component))))
 
-(defn paint-component [component layer graphics event-dispatcher]
+(defn paint-component
+  [^Component component layer ^Graphics2D graphics event-dispatcher]
   (let [size (.getSize component)
         width (.width size)
         height (.height size)]
     (.clearRect graphics 0 0 width height)
-    (binding [*path* nil
-              *graphics* graphics
-              *font-context*' (.getFontRenderContext graphics)
-              *event-dispatcher* event-dispatcher
-              *update* #(.repaint component)
-              *bounds* (indyvon.core.Bounds. 0 0 width height)]
-      (render! layer nil)
-      (commit event-dispatcher))))
+    (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]
-  (binding [*path* nil
+  (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 (make-event-dispatcher)))
+     (make-jpanel layer (root-event-dispatcher)))
   ([layer event-dispatcher]
      (let [panel
            (proxy [JPanel] []
@@ -53,28 +58,28 @@
     (def layer1
          (reify
           Layer
-          (render! [this context g]
-             (.setColor g Color/RED)
-             (.fillRect g 0 0 (:width context) (:height context)))
-          (size [this context] [30 20])
-          MouseHandler
-          (handle-mouse [this context event]
-             (println "layer1" event))))
+          (render! [layer opts]
+             (with-handlers layer
+               (doto *graphics*
+                 (.setColor Color/RED)
+                 (.fillRect 0 0 (:width *bounds*) (:height *bounds*)))
+               (:mouse-entered e (println e))
+               (:mouse-exited e (println e))
+               (:mouse-moved e (println e))))
+          (size [layer opts] (Size. 30 20))))
     
     (def layer1b (border-layer layer1 2 3))
     
     (def layer2
          (reify
           Layer
-          (render! [this context g]
-             (.setColor g Color/YELLOW)
-             (.fillRect g 0 0 (:width context) (:height context))
-             (draw! layer1b context g 10 5)
-             (draw! layer1 context g 55 5))
-          (size [this context] [70 65])
-          MouseHandler
-          (handle-mouse [this context event]
-             (println "layer2" event))))
+          (render! [layer opts]
+             (doto *graphics*
+               (.setColor Color/YELLOW)
+               (.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)))
@@ -89,8 +94,8 @@
                fl (ref (fps-layer 0.0))]
            (reify
             Layer
-            (render! [this c g]
-               (draw! @fl c g)
+            (render! [layer opts]
+               (render! @fl nil)
                (dosync
                 (alter frames + 1)
                 (let [time (System/currentTimeMillis)
@@ -99,18 +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 g]
-             ;;(update context)
-             (.setColor g (rand-nth [Color/BLACK Color/BLUE Color/RED]))       
-             (.drawLine g 0 0 (:width context) (:height context))
-             (draw! layer2 context g 15 20)
-             (draw! layer3 context g 100 100 80 50)
-             (draw! fps context g))
-           (size [this context] [400 300])))
+           (render! [layer opts]
+             (*update*)
+             (doto *graphics*
+               (.setColor (rand-nth [Color/BLACK Color/BLUE Color/RED]))
+               (.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	Mon Jul 05 06:11:42 2010 +0400
+++ b/src/indyvon/core.clj	Thu Jul 08 05:27:54 2010 +0400
@@ -5,56 +5,102 @@
 ;;
 
 (ns indyvon.core
-  (:import (java.awt Color Font)
-           (java.awt.event MouseListener MouseMotionListener)))
+  (:import (java.awt Graphics2D Component Color Font)
+           (java.awt.event MouseListener MouseMotionListener)
+           (java.awt.font FontRenderContext)))
+
+(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])
 
-(def *graphics*)
-(def *font-context*)
-(def *bounds*)
-(def *target*)
-(def *update*)
-(def *event-dispatcher*)
-(def *path*)
-
-(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))
-
 (defprotocol Layer
   "Basic UI element."
   (render! [this opts])
   (size [this opts]))
 
-(defn layer? [x]
-  (satisfies? Layer x)) 
-
-(defprotocol EventDispatcher
-  (listen! [this component])
-  (register [this handle-path])
-  (handler [this handle-path event-id f])
-  (commit [this]))
-
 ;; TODO: modifiers
 (defrecord MouseEvent [id when x y x-on-screen y-on-screen button])
 
-(defn- apply-theme [graphics]
+(defprotocol EventDispatcher
+  (listen! [this ^Component component]
+     "Listen for events on the specified AWT Component.")
+  (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.")
+  (commit [this]
+     "Apply the registered handlers for event processing."))
+
+(defprotocol Anchored
+  "Provide anchor point for Layers. Used by viewport."
+  (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 h-align v-align opts]
+          (if (and (= h-align :left)
+                   (= v-align :top))
+            (Location. 0 0)
+            (let [size (size this opts)]
+              (Location.
+               (case h-align
+                     :top 0
+                     :center (/ (:width size) 2)
+                     :right (:width size))
+               (case v-align
+                     :left 0
+                     :center (/ (:height size) 2)
+                     :bottom (:height size)))))))
+
+(defn- ^Graphics2D make-graphics [^Graphics2D graphics x y w h]
+  (.create graphics x y w h))
+
+(defn- ^Graphics2D apply-theme [^Graphics2D graphics theme]
   (doto graphics
-    (.setColor (:fore-color *theme*))
-    (.setFont (:font *theme*))))
+    (.setColor (:fore-color theme))
+    (.setFont (:font theme))))
+
+(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 with-translate* [x y w h f & args]
-  (let [graphics (apply-theme (.create *graphics* x y w h))]
+  (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. (+ x (:x *bounds*))
-                                                 (+ y (:y *bounds*))
-                                                 w h)
+      (apply with-bindings* {#'*bounds* bounds
+                             #'*clip* (intersect bounds *clip*)
                              #'*graphics* graphics}
              f args)
       (finally
@@ -63,29 +109,36 @@
 (defmacro with-translate [x y w h & body]
   `(with-translate* ~x ~y ~w ~h (fn [] ~@body)))
 
-(defn with-handle* [handle f & args]
-  (let [path (cons handle *path*)]
-    (register *event-dispatcher* path)
-    (apply with-bindings* {#'*path* path} f args)))
+
+
+(defn with-handlers* [handle handlers f & args]
+  (apply with-bindings*
+         {#'*event-dispatcher*
+          (create-dispatcher *event-dispatcher* handle handlers)}
+         f args))
 
-(defmacro with-handle [handle & body]
-  `(with-handle* ~handle (fn [] ~@body)))
+(defmacro with-handlers
+  "specs => (:event-id name & handler-body)*
 
-(defn handle-event* [event-id f & args]
-  (let [f (if args #(f % args) f)]
-    (handler *event-dispatcher* *path* event-id f)))
-
-(defmacro handle-event [event-id name & body]
-  `(handle-event* ~event-id (fn [~name] ~@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! [layer geometry & args]
+(defn draw!
   "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))
@@ -93,7 +146,7 @@
     (with-translate* x y w h render! layer args)))
 
 ;;
-;; EventDispatcher
+;; EventDispatcher implementation
 ;;
 
 (def awt-events
@@ -105,23 +158,24 @@
       java.awt.event.MouseEvent/MOUSE_PRESSED  :mouse-pressed
       java.awt.event.MouseEvent/MOUSE_RELEASED :mouse-released})
 
-(defrecord DispatcherNode [id bounds children handlers])
-
-(defn- add-child [node child]
-  (assoc node :children (cons child (:children node))))
+(defrecord DispatcherNode [handle handlers parent bounds bindings]
+  EventDispatcher
+  (listen! [this component]
+     (listen! parent component))
+  (create-dispatcher [this handle handlers]
+     (create-dispatcher parent handle handlers))
+  (commit [this]
+     (commit parent)))
 
-(defn- add-path [tree path]
-  (let [parent-path (next path)
-        parent-node (get tree parent-path)
-        node (DispatcherNode. path *bounds* nil
-                              (get-in tree [path :handlers]))]
-    (assoc tree
-      parent-path (add-child parent-node node)
-      path node)))
+(defn- make-node [handle handlers]
+  (DispatcherNode. handle handlers *event-dispatcher* *clip*
+                   (get-thread-bindings)))
 
-(defn add-handler [tree path event-id f]
-  (let [keys [path :handlers event-id]]
-  (assoc-in tree keys (cons f (get-in tree keys)))))
+(defn- assoc-cons [m key val]
+  (assoc m key (cons val (get m key))))
+
+(defn- add-node [tree node]
+  (assoc-cons tree (:parent node) node))
 
 (defn- inside?
   ([x y bounds]
@@ -134,45 +188,41 @@
           (< py (+ y h)))))
 
 (defn- under-cursor
-  "Returns a sequence of nodes under cursor."
-  ([tree x y]
-     (under-cursor tree x y nil))
-  ([tree x y node]
-     (some #(if (inside? x y (:bounds %))
-              (conj (under-cursor tree x y %) %))
-           (get tree (:children node)))))
+  "Returns a sequence of child nodes under cursor."
+  [x y tree node]
+  (some #(if (inside? x y (:bounds %))
+           (conj (under-cursor x y tree %) %))
+        (get tree node)))
 
 (defn- remove-all [coll1 coll2 pred]
   (filter #(not (some (partial pred %) coll2)) coll1))
 
-(defn- translate-mouse-event
-  [event x y id]
+(defn- translate-mouse-event [^java.awt.event.MouseEvent event x y id]
   (MouseEvent. id (.getWhen event)
                (- (.getX event) x) (- (.getY event) y)
                (.getXOnScreen event) (.getYOnScreen event)
                (.getButton event)))
 
 (defn- translate-and-dispatch
-  ([nodes event]
+  ([nodes ^java.awt.event.MouseEvent event]
      (translate-and-dispatch nodes event (awt-events (.getID event))))
   ([nodes event id]
-     (doseq [node nodes
-             :let [bounds (:bounds node)
-                   event (translate-mouse-event event
-                           (:x bounds) (:y bounds) id)]
-             handler (get (:handlers node) id)]
-       ;; TODO restore more of the original context.
-       (with-bindings* {#'*bounds* bounds} handler event))
+     (doseq [node nodes]
+       (when-let [handler (get (:handlers node) id)]
+         (with-bindings* (:bindings node)
+           handler
+           (translate-mouse-event event
+             (-> node :bounds :x) (-> node :bounds :y) id))))
      id))
 
 (defn- dispatch-mouse-motion*
   "Dispatches mouse motion events. Returns a new set of nodes which
   currently are under cursor."
-  [hovered tree event]
+  [hovered tree root ^java.awt.event.MouseEvent event]
   (let [x (.getX event)
         y (.getY event)
-        hovered2 (under-cursor tree x y)
-        pred #(= (:id %1) (:id %2))
+        hovered2 (under-cursor x y tree root)
+        pred #(= (:handle %1) (:handle %2))
         exited (remove-all hovered hovered2 pred)
         entered (remove-all hovered2 hovered pred)
         moved (remove-all hovered2 entered pred)]
@@ -182,9 +232,9 @@
     hovered2))
 
 (defn- dispatch-mouse-motion
-  [hovered-ref tree event]
+  [hovered-ref tree root event]
   (dosync
-   (alter hovered-ref dispatch-mouse-motion* tree event)))
+   (alter hovered-ref dispatch-mouse-motion* tree root event)))
 
 (defn- dispatch-mouse-button*
   "Dispatches mouse button events. Returns a new set of nodes which
@@ -199,11 +249,9 @@
   (dosync
    (alter picked-ref dispatch-mouse-button* @hovered-ref event)))
 
-(defn make-event-dispatcher []
-  (let [root-node (DispatcherNode. nil nil nil nil)
-        tree-i {nil root-node} ; initial
-        tree-r (ref tree-i)    ; register
-        tree (ref tree-i)      ; dispatch
+(defn root-event-dispatcher []
+  (let [tree-r (ref {})   ; register
+        tree (ref {})     ; dispatch
         hovered (ref '())
         picked (ref '())]
     (reify
@@ -212,18 +260,18 @@
         (doto component
           (.addMouseListener this)
           (.addMouseMotionListener this)))
-     (register [this path]
-        (dosync (alter tree-r add-path path)))
-     (handler [this path event-id f]
-        (dosync (alter tree-r add-handler path event-id f)))
+     (create-dispatcher [this handle handlers]
+        (let [node (make-node handle handlers)]
+          (dosync (alter tree-r add-node node))
+          node))
      (commit [this]
         (dosync (ref-set tree @tree-r)
-                (ref-set tree-r tree-i)))
+                (ref-set tree-r {})))
      MouseListener
      (mouseEntered [this event]
-        (dispatch-mouse-motion hovered @tree event))
+        (dispatch-mouse-motion hovered @tree this event))
      (mouseExited [this event]
-        (dispatch-mouse-motion hovered @tree event))
+        (dispatch-mouse-motion hovered @tree this event))
      (mouseClicked [this event]
         (dispatch-mouse-button picked hovered event))
      (mousePressed [this event]
@@ -234,7 +282,7 @@
      (mouseDragged [this event]
         (translate-and-dispatch @picked event))
      (mouseMoved [this event]
-        (dispatch-mouse-motion hovered @tree event)))))
+        (dispatch-mouse-motion hovered @tree this event)))))
 
 ;;
 ;; ИДЕИ:

--- a/src/indyvon/layers.clj	Mon Jul 05 06:11:42 2010 +0400
+++ b/src/indyvon/layers.clj	Thu Jul 08 05:27:54 2010 +0400
@@ -6,7 +6,8 @@
 
 (ns indyvon.layers
   (:use indyvon.core)
-  (:import (java.awt Cursor)
+  (:import (indyvon.core Size Location)
+           (java.awt Font Cursor)
            (java.awt.font FontRenderContext TextLayout)))
 
 ;; Define as macro to avoid unnecessary calculation of inner and outer
@@ -32,30 +33,33 @@
   ([content width gap]
      (let [offset (+ width gap)]
        (reify Layer
-        (render! [l c g]
-           (let [w (:width c)
-                 h (:height c)]
-             (.setColor g (-> 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 g i i (- w 1 i i) (- h 1 i i)))
-             (draw! content c g offset offset (- w offset offset)
-                    (- h offset offset))))
-        (size [l c]
-           (let [s (size content c)]
-             [(+ (s 0) offset offset)
-              (+ (s 1) offset offset)]))))))
+               (.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
@@ -65,27 +69,24 @@
   ([text h-align v-align]
      (let [lines (re-split #"\r\n|\n|\r|\u0085|\u2028|\u2029" text)]
        (reify Layer
-        (render! [l c g]
-           (let [w (:width c)
-                 h (:height c)
-                 font (.getFont g)
-                 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 g 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)]
-             [width height]))))))
+             (Size. width height)))))))
 
 (defn viewport
   "Creates scrollable viewport layer."
@@ -99,36 +100,30 @@
         last-height (ref 0)]
     (reify
      Layer
-     (render! [layer c g]
-        (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))
+           (apply draw! content
+                  [(- 0 @x (:x anchor)) (- 0 @y (:y anchor))] opts))
+         (:mouse-pressed e
           (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 g
-                 (- 0 @x (anchor 0))
-                 (- 0 @y (anchor 1)))))
-     (size [layer c] (size content c))
-     MouseHandler
-     (handle-mouse [layer c e]
-       (case (:id e)
-         :mouse-pressed
-         (do
-           (dosync
-            (ref-set fix-x (:x-on-screen e))
-            (ref-set fix-y (:y-on-screen e)))
-           (->> Cursor/MOVE_CURSOR Cursor. (.setCursor (:target c))))
-         :mouse-released
-         (->> Cursor/DEFAULT_CURSOR Cursor. (.setCursor (:target c)))
-         :mouse-dragged
-         (do
-           (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))
-         nil))))))
+           (ref-set fix-x (:x-on-screen e))
+           (ref-set fix-y (:y-on-screen e)))
+          (->> Cursor/MOVE_CURSOR Cursor. (.setCursor *target*)))
+         (:mouse-released e
+          (->> 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*))))
+     (size [layer opts] (size content opts))))))