1.1 --- a/src/indyvon/component.clj	Wed Jul 07 04:14:21 2010 +0400
     1.2 +++ b/src/indyvon/component.clj	Wed Jul 07 05:57:49 2010 +0400
     1.3 @@ -7,13 +7,14 @@
     1.4  (ns indyvon.component
     1.5    (:use indyvon.core indyvon.layers)
     1.6    (:import (indyvon.core Size Location)
     1.7 -           (java.awt Component Dimension Color)
     1.8 +           (java.awt Component Graphics2D Dimension Color)
     1.9             (javax.swing JFrame JPanel)))
    1.10  
    1.11 -(defn- font-context [component]
    1.12 +(defn- font-context [^Component component]
    1.13    (.getFontRenderContext (.getFontMetrics component (.getFont component))))
    1.14  
    1.15 -(defn paint-component [component layer context graphics]
    1.16 +(defn paint-component
    1.17 +  [^Component component layer context ^Graphics2D graphics]
    1.18    (let [size (.getSize component)
    1.19          width (.width size)
    1.20          height (.height size)
    1.21 @@ -23,7 +24,7 @@
    1.22                    :update-fn #(.repaint component))]
    1.23      (.clearRect graphics 0 0 width height)
    1.24      (draw! layer context graphics 0 0 width height false))
    1.25 -  (commit (:dispatcher context)))
    1.26 +  (commit (:event-dispatcher context)))
    1.27  
    1.28  (defn preferred-size [component layer context]
    1.29    (let [context (assoc context
    1.30 @@ -37,7 +38,7 @@
    1.31       (make-jpanel layer (root-event-dispatcher)))
    1.32    ([layer event-dispatcher]
    1.33       (let [context (default-context)
    1.34 -           context (assoc context :dispatcher event-dispatcher)
    1.35 +           context (assoc context :event-dispatcher event-dispatcher)
    1.36             panel
    1.37             (proxy [JPanel] []
    1.38               (paintComponent [g]
    1.39 @@ -100,7 +101,7 @@
    1.40      (def layer
    1.41           (reify Layer
    1.42             (render! [this context g]
    1.43 -             ;;(update context)
    1.44 +             (update context)
    1.45               (.setColor g (rand-nth [Color/BLACK Color/BLUE Color/RED]))       
    1.46               (.drawLine g 0 0 (:width context) (:height context))
    1.47               (draw! layer2 context g 15 20)

     2.1 --- a/src/indyvon/core.clj	Wed Jul 07 04:14:21 2010 +0400
     2.2 +++ b/src/indyvon/core.clj	Wed Jul 07 05:57:49 2010 +0400
     2.3 @@ -5,7 +5,7 @@
     2.4  ;;
     2.5  
     2.6  (ns indyvon.core
     2.7 -  (:import (java.awt Color Font)
     2.8 +  (:import (java.awt Graphics Component Color Font)
     2.9             (java.awt.event MouseListener MouseMotionListener)))
    2.10  
    2.11  (defprotocol Layer
    2.12 @@ -20,7 +20,7 @@
    2.13  (defrecord MouseEvent [id when x y x-on-screen y-on-screen button])
    2.14  
    2.15  (defprotocol EventDispatcher
    2.16 -  (listen! [this component]
    2.17 +  (listen! [this ^Component component]
    2.18       "Listen for events on the specified AWT Component.")
    2.19    (create-dispatcher [this context handle handlers]
    2.20       "Returns new event dispatcher associated with the specified event
    2.21 @@ -67,13 +67,13 @@
    2.22  (defn update [context]
    2.23    ((:update-fn context)))
    2.24  
    2.25 -(defn- make-graphics [graphics x y w h clip]
    2.26 +(defn- ^Graphics make-graphics [^Graphics graphics x y w h clip]
    2.27    (if clip
    2.28      (.create graphics x y w h)
    2.29      (doto (.create graphics)
    2.30        (.translate x y))))
    2.31  
    2.32 -(defn- apply-theme [graphics theme]
    2.33 +(defn- ^Graphics apply-theme [^Graphics graphics theme]
    2.34    (doto graphics
    2.35      (.setColor (:fore-color theme))
    2.36      (.setFont (:font theme))))
    2.37 @@ -81,8 +81,7 @@
    2.38  (defn draw!
    2.39    "Render layer in a new graphics context."
    2.40    ([layer context graphics]
    2.41 -     (draw! layer context graphics
    2.42 -                    0 0 (:width context) (:height context)))
    2.43 +     (render! layer context graphics))
    2.44    ([layer context graphics x y]
    2.45       (draw! layer context graphics x y true))
    2.46    ([layer context graphics x y clip]
    2.47 @@ -107,8 +106,15 @@
    2.48           (finally
    2.49            (.dispose graphics))))))
    2.50  
    2.51 -(defmacro handlers [handle bindings & specs]
    2.52 -  "bindings => binding-form context
    2.53 +(defn add-handlers [context handle handlers]
    2.54 +  "Returns new context with the specified event handlers."
    2.55 +  (assoc context
    2.56 +    :event-dispatcher
    2.57 +    (create-dispatcher (:event-dispatcher context) context
    2.58 +                       handle handlers)))
    2.59 +
    2.60 +(defmacro let-handlers [handle bindings & specs]
    2.61 +  "bindings => [binding-form context] or [context-symbol]
    2.62     specs => (:event-id name & handler-body)* form
    2.63  
    2.64    Execute form with the specified event handlers."
    2.65 @@ -116,14 +122,12 @@
    2.66          context (or context binding)]
    2.67      `(let [context# ~context
    2.68             ~binding
    2.69 -           (assoc context# :event-dispatcher
    2.70 -             (create-dispatcher (:event-dispatcher context#)
    2.71 -               context# handle
    2.72 -               ~(reduce (fn [m spec]
    2.73 -                          (assoc m (first spec)
    2.74 -                                 `(fn [~(second spec)]
    2.75 -                                    ~@(nnext spec)))) {}
    2.76 -                                    (butlast specs))))]
    2.77 +           (add-handlers context# ~handle
    2.78 +             ~(reduce (fn [m spec]
    2.79 +                        (assoc m (first spec)
    2.80 +                               `(fn [~(second spec)]
    2.81 +                                  ~@(nnext spec)))) {}
    2.82 +                                  (butlast specs)))]
    2.83             ~(last specs))))
    2.84  
    2.85  ;;
    2.86 @@ -148,8 +152,8 @@
    2.87    (commit [this]
    2.88       (commit parent)))
    2.89  
    2.90 -(defn- make-node [parent c handle handlers]
    2.91 -  (DispatcherNode. handle handlers parent
    2.92 +(defn- make-node [c handle handlers]
    2.93 +  (DispatcherNode. handle handlers (:event-dispatcher c)
    2.94                     (:x c) (:y c) (:width c) (:height c)))
    2.95  
    2.96  (defn- assoc-cons [m key val]
    2.97 @@ -170,25 +174,22 @@
    2.98  
    2.99  (defn- under-cursor
   2.100    "Returns a sequence of child nodes under cursor."
   2.101 -  ([x y tree]
   2.102 -     (under-cursor x y tree nil))
   2.103 -  ([x y tree node]
   2.104 -     (some #(if (inside? x y %)
   2.105 -              (conj (under-cursor x y %) %))
   2.106 -           (get tree node))))
   2.107 +  [x y tree node]
   2.108 +  (some #(if (inside? x y %)
   2.109 +           (conj (under-cursor x y tree %) %))
   2.110 +        (get tree node)))
   2.111  
   2.112  (defn- remove-all [coll1 coll2 pred]
   2.113    (filter #(not (some (partial pred %) coll2)) coll1))
   2.114  
   2.115 -(defn- translate-mouse-event
   2.116 -  [event x y id]
   2.117 +(defn- translate-mouse-event [^java.awt.event.MouseEvent event x y id]
   2.118    (MouseEvent. id (.getWhen event)
   2.119                 (- (.getX event) x) (- (.getY event) y)
   2.120                 (.getXOnScreen event) (.getYOnScreen event)
   2.121                 (.getButton event)))
   2.122  
   2.123  (defn- translate-and-dispatch
   2.124 -  ([nodes event]
   2.125 +  ([nodes ^java.awt.event.MouseEvent event]
   2.126       (translate-and-dispatch nodes event (awt-events (.getID event))))
   2.127    ([nodes event id]
   2.128       (doseq [node nodes]
   2.129 @@ -200,10 +201,10 @@
   2.130  (defn- dispatch-mouse-motion*
   2.131    "Dispatches mouse motion events. Returns a new set of nodes which
   2.132    currently are under cursor."
   2.133 -  [hovered tree event]
   2.134 +  [hovered tree root ^java.awt.event.MouseEvent event]
   2.135    (let [x (.getX event)
   2.136          y (.getY event)
   2.137 -        hovered2 (under-cursor x y tree)
   2.138 +        hovered2 (under-cursor x y tree root)
   2.139          pred #(= (:handle %1) (:handle %2))
   2.140          exited (remove-all hovered hovered2 pred)
   2.141          entered (remove-all hovered2 hovered pred)
   2.142 @@ -214,9 +215,9 @@
   2.143      hovered2))
   2.144  
   2.145  (defn- dispatch-mouse-motion
   2.146 -  [hovered-ref tree event]
   2.147 +  [hovered-ref tree root event]
   2.148    (dosync
   2.149 -   (alter hovered-ref dispatch-mouse-motion* tree event)))
   2.150 +   (alter hovered-ref dispatch-mouse-motion* tree root event)))
   2.151  
   2.152  (defn- dispatch-mouse-button*
   2.153    "Dispatches mouse button events. Returns a new set of nodes which
   2.154 @@ -243,7 +244,7 @@
   2.155            (.addMouseListener this)
   2.156            (.addMouseMotionListener this)))
   2.157       (create-dispatcher [this context handle handlers]
   2.158 -        (let [node (make-node this context handle handlers)]
   2.159 +        (let [node (make-node context handle handlers)]
   2.160            (dosync (alter tree-r add-node node))
   2.161            node))
   2.162       (commit [this]
   2.163 @@ -251,9 +252,9 @@
   2.164                  (ref-set tree-r {})))
   2.165       MouseListener
   2.166       (mouseEntered [this event]
   2.167 -        (dispatch-mouse-motion hovered @tree event))
   2.168 +        (dispatch-mouse-motion hovered @tree this event))
   2.169       (mouseExited [this event]
   2.170 -        (dispatch-mouse-motion hovered @tree event))
   2.171 +        (dispatch-mouse-motion hovered @tree this event))
   2.172       (mouseClicked [this event]
   2.173          (dispatch-mouse-button picked hovered event))
   2.174       (mousePressed [this event]
   2.175 @@ -264,7 +265,7 @@
   2.176       (mouseDragged [this event]
   2.177          (translate-and-dispatch @picked event))
   2.178       (mouseMoved [this event]
   2.179 -        (dispatch-mouse-motion hovered @tree event)))))
   2.180 +        (dispatch-mouse-motion hovered @tree this event)))))
   2.181  
   2.182  ;;
   2.183  ;; ИДЕИ:

     3.1 --- a/src/indyvon/layers.clj	Wed Jul 07 04:14:21 2010 +0400
     3.2 +++ b/src/indyvon/layers.clj	Wed Jul 07 05:57:49 2010 +0400
     3.3 @@ -101,7 +101,7 @@
     3.4      (reify
     3.5       Layer
     3.6       (render! [layer c g]
     3.7 -        (listen c
     3.8 +        (let-handlers layer [c]
     3.9           (:mouse-pressed e
    3.10            (dosync
    3.11             (ref-set fix-x (:x-on-screen e))
    3.12 @@ -115,16 +115,16 @@
    3.13             (alter y + (- @fix-y (:y-on-screen e)))
    3.14             (ref-set fix-x (:x-on-screen e))
    3.15             (ref-set fix-y (:y-on-screen e)))
    3.16 -          (update c)))
    3.17 -        (let [anchor (anchor content c h-align v-align)
    3.18 -              width (:width c)
    3.19 -              height (:height c)]
    3.20 -          (dosync
    3.21 -           (alter x + (align-x width @last-width h-align))
    3.22 -           (alter y + (align-y height @last-height v-align))
    3.23 -           (ref-set last-width width)
    3.24 -           (ref-set last-height height))
    3.25 -          (draw! content c g
    3.26 -                 (- 0 @x (:x anchor))
    3.27 -                 (- 0 @y (:y anchor)))))
    3.28 +          (update c))
    3.29 +         (let [anchor (anchor content c h-align v-align)
    3.30 +               width (:width c)
    3.31 +               height (:height c)]
    3.32 +           (dosync
    3.33 +            (alter x + (align-x width @last-width h-align))
    3.34 +            (alter y + (align-y height @last-height v-align))
    3.35 +            (ref-set last-width width)
    3.36 +            (ref-set last-height height))
    3.37 +           (draw! content c g
    3.38 +                  (- 0 @x (:x anchor))
    3.39 +                  (- 0 @y (:y anchor))))))
    3.40       (size [layer c] (size content c))))))