--- a/src/indyvon/core.clj	Mon Jun 21 04:00:45 2010 +0400
+++ b/src/indyvon/core.clj	Sun Jul 04 06:03:48 2010 +0400
@@ -8,6 +8,19 @@
   (:import (java.awt Color Font)
            (java.awt.event MouseListener MouseMotionListener)))
 
+(def *context*)
+(def *graphics*)
+
+(defrecord Size [width height])
+(defrecord Bounds [x y width height])
+
+(def *font-context*)
+(def *bounds*)
+(def *theme*)
+(def *target*)
+(def *update*)
+(def *event-dispatcher*)
+
 (defprotocol Layer
   "Basic UI element."
   (render! [this context graphics])
@@ -55,11 +68,20 @@
 (defn default-theme []
   (Theme. Color/BLACK Color/WHITE Color/BLUE (Font. "Sans" Font/PLAIN 12)))
   
-(defrecord LayerContext [layer parent x y width height update-fn
-  dispatcher font-context theme target])
+(defrecord LayerContext
+  [handle           ; Identifies context for dispatching mouse
+                    ; entered/exited and mainaining keyboard focus.
+   parent           ; Parent context.
+   x y width height ; Geometry.
+   update-fn        ; Call to request repaint.
+   dispatcher       ; Event dispatcher.
+   font-context     ; An instance of java.awt.font.FontRenderContext.
+   theme            ; An instance of Theme.
+   target           ; Component.
+   handlers])       ; Map: event-id -> handler fn.
 
 (defn default-context []
-  (LayerContext. nil nil 0 0 0 0 nil nil nil (default-theme) nil))
+  (LayerContext. nil nil 0 0 0 0 nil nil nil (default-theme) nil nil))
 
 (defn update [context]
   ((:update-fn context)))
@@ -75,6 +97,24 @@
     (.setColor (:fore-color theme))
     (.setFont (:font theme))))
 
+;; (defn with-context* [opts fn & args]
+;;   (let [context (apply assoc *context*
+;;                        :parent *context*
+;;                        :handlers nil
+;;                        opts)
+;;         graphics (make-graphics *graphics* x y w h false)
+;;         graphics (apply-theme graphics (:theme context))]
+;;     (try
+;;       (register (:dispatcher context) context)
+;;       (with-bindings* {#'*context* context
+;;                        #'*graphics* graphics}
+;;         fn args)
+;;       (finally
+;;        (.dispose graphics)))))
+
+;; (defmacro with-context [opts & body]
+;;   `(with-context* ~opts #(~@body)))
+
 (defn draw!
   "Render layer in a new graphics context."
   ([layer context graphics]
@@ -91,7 +131,7 @@
             x y w h true))
   ([layer context graphics x y w h clip]
      (let [context (assoc context
-                     :layer layer
+                     :handle layer
                      :parent context
                      :x (+ (:x context) x)
                      :y (+ (:y context) y)
@@ -155,19 +195,6 @@
 (defn- remove-all [coll1 coll2 pred]
   (filter #(not (some (partial pred %) coll2)) coll1))
 
-;; (defn- translate-mouse-event
-;;   [event x y id]
-;;   (proxy [MouseEvent] [(.getComponent event)
-;;                        id
-;;                        (.getWhen event)
-;;                        (.getModifiers event)
-;;                        (- (.getX event) x)
-;;                        (- (.getY event) y)
-;;                        (.getClickCount event)
-;;                        (.isPopupTrigger event)]
-;;     (getXOnScreen [] (.getXOnScreen event))
-;;     (getYOnScreen [] (.getYOnScreen event))))
-
 (defn- translate-mouse-event
   [event x y id]
   (MouseEvent. id (.getWhen event)
@@ -180,11 +207,18 @@
      (translate-and-dispatch contexts event (awt-events (.getID event))))
   ([contexts event id]
      (doseq [context contexts]
-       (handle-mouse
-        (:layer context) context 
-        (translate-mouse-event event (:x context) (:y context) id)))
+       (if-let [handler (get (:handlers context) id)]
+         (handler context (translate-mouse-event
+                           event (:x context) (:y context) id))))
      id))
 
+(defn- context-id [context]
+  (loop [context context
+         id nil]
+    (if context
+      (recur (:parent context) (cons (:handle context) id))
+      id)))
+
 (defn- dispatch-mouse-motion*
   "Dispatches mouse motion events. Returns a new set of contexts which
   currently are under cursor."
@@ -192,7 +226,7 @@
   (let [x (.getX event)
         y (.getY event)
         hovered2 (under-cursor context-tree x y)
-        pred #(= (:layer %1) (:layer %2))
+        pred #(= (context-id %1) (context-id %2))
         exited (remove-all hovered hovered2 pred)
         entered (remove-all hovered2 hovered pred)
         moved (remove-all hovered2 entered pred)]
@@ -231,7 +265,7 @@
           (.addMouseListener this)
           (.addMouseMotionListener this)))
      (register [this context]
-        (when (satisfies? MouseHandler (:layer context))
+        (if (:handlers context)
           (dosync (alter context-tree-r add-context context))))
      (commit [this]
         (dosync (ref-set context-tree @context-tree-r)

--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/indyvon/core_new.clj	Sun Jul 04 06:03:48 2010 +0400
@@ -0,0 +1,228 @@
+;; Copyright (C) 2010 Mikhail Kryshen <mikhail@kryshen.net>
+;;
+;; This file is part of Indyvon.
+;;
+
+(ns indyvon.core_new
+  (:import (java.awt Color Font)
+           (java.awt.event MouseListener MouseMotionListener)))
+
+(defrecord Location [x y])
+(defrecord Size [width height])
+(defrecord Bounds [x y width height])
+
+(def *graphics*)
+(def *font-context*)
+(def *bounds*)
+(def *theme*)
+(def *target*)
+(def *update*)
+(def *event-dispatcher*)
+(def *path*)
+
+(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 with-translate* [x y w h f & args]
+  (let [graphics (.create *graphics* x y w h)]  
+    (try
+      (apply with-bindings* {#'*bounds* (Bounds. (+ x (:x *bounds*))
+                                                 (+ y (:y *bounds*))
+                                                 w h)
+                             #'*graphics* graphics}
+             f args)
+      (finally
+       (.dispose graphics)))))
+
+(defn with-handle* [handle f & args]
+  (let [path (cons handle *path*)]
+    (register *event-dispatcher* path)
+    (apply with-bindings* {#'*path* path} f args)))
+
+(defn- geometry-vec [geometry]
+  (if (vector? geometry)
+    geometry
+    [(:x geometry) (:y geometry) (:width geometry) (:height geometry)]))
+
+(defn draw! [layer geometry & args]
+  "Draw a layer. Geometry is either a map or vector [x y] or
+   [x y width height]."
+  (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)))
+
+(defn draw-root! [layer width height graphics event-dispatcher]
+  (with-bindings* {#'*path* nil
+                   #'*graphics* graphics
+                   #'*event-dispatcher* event-dispatcher
+                   #'*bounds* (Bounds. 0 0 width height)}
+    render! layer))
+
+;;
+;; EventDispatcher
+;;
+
+(def awt-events
+     {java.awt.event.MouseEvent/MOUSE_CLICKED  :mouse-clicked
+      java.awt.event.MouseEvent/MOUSE_DRAGGED  :mouse-dragged
+      java.awt.event.MouseEvent/MOUSE_ENTERED  :mouse-entered
+      java.awt.event.MouseEvent/MOUSE_EXITED   :mouse-exited
+      java.awt.event.MouseEvent/MOUSE_MOVED    :mouse-moved
+      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))))
+
+(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 add-handler [tree path event-id f]
+  (let [keys [path :handlers event-id]]
+  (assoc-in tree keys (cons f (get-in tree keys)))))
+
+(defn- inside?
+  ([x y bounds]
+     (inside? x y (:x bounds) (:y bounds)
+              (:width bounds) (:height bounds)))
+  ([px py x y w h]
+     (and (>= px x)
+          (>= py y)
+          (< px (+ x w))
+          (< 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)))))
+
+(defn- remove-all [coll1 coll2 pred]
+  (filter #(not (some (partial pred %) coll2)) coll1))
+
+(defn- translate-mouse-event
+  [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]
+     (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))
+     id))
+
+(defn- dispatch-mouse-motion*
+  "Dispatches mouse motion events. Returns a new set of nodes which
+  currently are under cursor."
+  [hovered tree event]
+  (let [x (.getX event)
+        y (.getY event)
+        hovered2 (under-cursor tree x y)
+        pred #(= (:id %1) (:id %2))
+        exited (remove-all hovered hovered2 pred)
+        entered (remove-all hovered2 hovered pred)
+        moved (remove-all hovered2 entered pred)]
+    (translate-and-dispatch exited event :mouse-exited)
+    (translate-and-dispatch entered event :mouse-entered)
+    (translate-and-dispatch moved event :mouse-moved)
+    hovered2))
+
+(defn- dispatch-mouse-motion
+  [hovered-ref tree event]
+  (dosync
+   (alter hovered-ref dispatch-mouse-motion* tree event)))
+
+(defn- dispatch-mouse-button*
+  "Dispatches mouse button events. Returns a new set of nodes which
+  currently are picked with a pressed button."
+  [picked hovered event]
+  (if (= (translate-and-dispatch hovered event) :mouse-pressed)
+    hovered
+    nil))
+
+(defn- dispatch-mouse-button
+  [picked-ref hovered-ref event]
+  (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
+        hovered (ref '())
+        picked (ref '())]
+    (reify
+     EventDispatcher
+     (listen! [this component]
+        (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)))
+     (commit [this]
+        (dosync (ref-set tree @tree-r)
+                (ref-set tree-r tree-i)))
+     MouseListener
+     (mouseEntered [this event]
+        (dispatch-mouse-motion hovered @tree event))
+     (mouseExited [this event]
+        (dispatch-mouse-motion hovered @tree event))
+     (mouseClicked [this event]
+        (dispatch-mouse-button picked hovered event))
+     (mousePressed [this event]
+        (dispatch-mouse-button picked hovered event))
+     (mouseReleased [this event]
+        (dispatch-mouse-button picked hovered event))
+     MouseMotionListener
+     (mouseDragged [this event]
+        (translate-and-dispatch @picked event))
+     (mouseMoved [this event]
+        (dispatch-mouse-motion hovered @tree event)))))
+
+;; (with-handle :button1
+;;   (draw! button [5 5 100 200] "Cick Me!"))
+
+;; (when-event :action :button1
+;;     ...)
+
+;; (handle-event :mouse-entered :button1
+;;     ...)