changeset 29:4cb70c5a6e0d

Event handlers are registered using listen macro instead of implementing a protocol.
author Mikhail Kryshen <mikhail@kryshen.net>
date Tue, 06 Jul 2010 06:05:28 +0400
parents 1237f7555029
children a8821f4b5ade
files src/indyvon/component.clj src/indyvon/core.clj src/indyvon/layers.clj
diffstat 3 files changed, 133 insertions(+), 111 deletions(-) [+]
line diff
     1.1 --- a/src/indyvon/component.clj	Mon Jun 21 04:00:45 2010 +0400
     1.2 +++ b/src/indyvon/component.clj	Tue Jul 06 06:05:28 2010 +0400
     1.3 @@ -6,7 +6,8 @@
     1.4  
     1.5  (ns indyvon.component
     1.6    (:use indyvon.core indyvon.layers)
     1.7 -  (:import (java.awt Component Dimension Color)
     1.8 +  (:import (indyvon.core Size Location)
     1.9 +           (java.awt Component Dimension Color)
    1.10             (javax.swing JFrame JPanel)))
    1.11  
    1.12  (defn- font-context [component]
    1.13 @@ -29,7 +30,7 @@
    1.14                    :target component
    1.15                    :font-context (font-context component))
    1.16          s (size layer context)]
    1.17 -    (Dimension. (s 0) (s 1))))
    1.18 +    (Dimension. (:width s) (:height s))))
    1.19  
    1.20  (defn make-jpanel
    1.21    ([layer]
    1.22 @@ -57,10 +58,7 @@
    1.23            (render! [this context g]
    1.24               (.setColor g Color/RED)
    1.25               (.fillRect g 0 0 (:width context) (:height context)))
    1.26 -          (size [this context] [30 20])
    1.27 -          MouseHandler
    1.28 -          (handle-mouse [this context event]
    1.29 -             (println "layer1" event))))
    1.30 +          (size [this context] (Size. 30 20))))
    1.31      
    1.32      (def layer1b (border-layer layer1 2 3))
    1.33      
    1.34 @@ -72,10 +70,7 @@
    1.35               (.fillRect g 0 0 (:width context) (:height context))
    1.36               (draw! layer1b context g 10 5)
    1.37               (draw! layer1 context g 55 5))
    1.38 -          (size [this context] [70 65])
    1.39 -          MouseHandler
    1.40 -          (handle-mouse [this context event]
    1.41 -             (println "layer2" event))))
    1.42 +          (size [this context] (Size. 70 65))))
    1.43      
    1.44      (def layer3
    1.45           (border-layer (text-layer "Sample\ntext" :right :center)))
    1.46 @@ -111,7 +106,7 @@
    1.47               (draw! layer2 context g 15 20)
    1.48               (draw! layer3 context g 100 100 80 50)
    1.49               (draw! fps context g))
    1.50 -           (size [this context] [400 300])))
    1.51 +           (size [this context] (Size. 400 300))))
    1.52      
    1.53      (doto frame
    1.54        (.addWindowListener
     2.1 --- a/src/indyvon/core.clj	Mon Jun 21 04:00:45 2010 +0400
     2.2 +++ b/src/indyvon/core.clj	Tue Jul 06 06:05:28 2010 +0400
     2.3 @@ -13,19 +13,16 @@
     2.4    (render! [this context graphics])
     2.5    (size [this context]))
     2.6  
     2.7 +(defrecord Location [x y])
     2.8 +(defrecord Size [width height])
     2.9 +
    2.10  ;; TODO: modifiers
    2.11  (defrecord MouseEvent [id when x y x-on-screen y-on-screen button])
    2.12  
    2.13 -(defprotocol MouseHandler
    2.14 -  "Layers that also satisfy this protocol will recieve mouse events."
    2.15 -  (handle-mouse [this context event]))
    2.16 -
    2.17  (defprotocol EventDispatcher
    2.18    (listen! [this component])
    2.19 -  (register [this context])
    2.20 -  (commit [this])
    2.21 -  (hovered? [this layer])
    2.22 -  (picked? [this layer]))
    2.23 +  (register [this context handlers])
    2.24 +  (commit [this]))
    2.25  
    2.26  (defprotocol Anchored
    2.27    "Provide anchor point for Layers. Used by viewport."
    2.28 @@ -39,16 +36,17 @@
    2.29    (anchor [this context h-align v-align]
    2.30            (if (and (= h-align :left)
    2.31                     (= v-align :top))
    2.32 -            [0 0]
    2.33 +            (Location. 0 0)
    2.34              (let [size (size this context)]
    2.35 -              [(case h-align
    2.36 -                 :top 0
    2.37 -                 :center (/ (size 0) 2)
    2.38 -                 :right (size 0))
    2.39 +              (Location.
    2.40 +               (case h-align
    2.41 +                     :top 0
    2.42 +                     :center (/ (:width size) 2)
    2.43 +                     :right (:width size))
    2.44                 (case v-align
    2.45 -                 :left 0
    2.46 -                 :center (/ (size 1) 2)
    2.47 -                 :bottom (size 1))]))))
    2.48 +                     :left 0
    2.49 +                     :center (/ (:height size) 2)
    2.50 +                     :bottom (:height size)))))))
    2.51  
    2.52  (defrecord Theme [fore-color back-color border-color font])
    2.53  
    2.54 @@ -85,7 +83,7 @@
    2.55    ([layer context graphics x y clip]
    2.56       (let [s (size layer context)]
    2.57         (draw! layer context graphics
    2.58 -              x y (s 0) (s 1) clip)))
    2.59 +              x y (:width s) (:height s) clip)))
    2.60    ([layer context graphics x y w h]
    2.61       (draw! layer context graphics
    2.62              x y w h true))
    2.63 @@ -100,11 +98,23 @@
    2.64             graphics (make-graphics graphics x y w h clip)
    2.65             graphics (apply-theme graphics (:theme context))]
    2.66         (try
    2.67 -         (register (:dispatcher context) context)
    2.68           (render! layer context graphics)
    2.69           (finally
    2.70            (.dispose graphics))))))
    2.71  
    2.72 +(defn listen* [context & handlers]
    2.73 +  (register (:dispatcher context) context (apply array-map handlers)))
    2.74 +
    2.75 +;; (listen context
    2.76 +;;   (:mouse-entered e (println e))
    2.77 +;;   (:mouse-exited e (println e)))
    2.78 +(defmacro listen [context & specs]
    2.79 +  `(register (:dispatcher ~context) ~context
    2.80 +             ~(reduce #(assoc %1
    2.81 +                         (first %2)
    2.82 +                         `(fn [~(second %2)] ~@(nnext %2)))
    2.83 +                      {} specs)))
    2.84 +
    2.85  ;;
    2.86  ;; EventDispatcher implementation
    2.87  ;;
    2.88 @@ -118,25 +128,38 @@
    2.89        java.awt.event.MouseEvent/MOUSE_PRESSED  :mouse-pressed
    2.90        java.awt.event.MouseEvent/MOUSE_RELEASED :mouse-released})
    2.91  
    2.92 +(defrecord DispatcherNode [layer x y width height handlers children])
    2.93 +
    2.94 +(defrecord DispatcherRootNode [children])
    2.95 +
    2.96 +(defn- make-node [c handlers]
    2.97 +  (DispatcherNode. (:layer c) (:x c) (:y c) (:width c) (:height c)
    2.98 +                   handlers nil))
    2.99 +
   2.100 +(defn- add-child [node child]
   2.101 +  (assoc node :children (cons child (:children node))))
   2.102 +
   2.103  (defn- registered-parent
   2.104    "Returns first context parent registered for event processing."
   2.105 -  [context-tree context]
   2.106 +  [tree context]
   2.107    (let [parent (:parent context)]
   2.108      (cond
   2.109       (nil? parent) nil
   2.110 -     (contains? context-tree parent) parent
   2.111 -     :default (recur context-tree parent))))
   2.112 +     (contains? tree parent) parent
   2.113 +     :default (recur tree parent))))
   2.114  
   2.115  (defn- add-context
   2.116 -  [context-tree context]
   2.117 -  (let [parent (registered-parent context-tree context)]
   2.118 -    (assoc context-tree parent (cons context (context-tree parent))
   2.119 -           context nil)))
   2.120 +  [tree context handlers]
   2.121 +  (let [parent (registered-parent tree context)
   2.122 +        node (make-node context handlers)]
   2.123 +    (assoc tree
   2.124 +      parent (add-child (tree parent) node)
   2.125 +      context node)))
   2.126  
   2.127  (defn- inside?
   2.128 -  ([x y context]
   2.129 -     (inside? x y (:x context) (:y context)
   2.130 -              (:width context) (:height context)))
   2.131 +  ([x y node]
   2.132 +     (inside? x y (:x node) (:y node)
   2.133 +              (:width node) (:height node)))
   2.134    ([px py x y w h]
   2.135       (and (>= px x)
   2.136            (>= py y)
   2.137 @@ -144,30 +167,15 @@
   2.138            (< py (+ y h)))))
   2.139  
   2.140  (defn- under-cursor
   2.141 -  "Returns a sequence of contexts under cursor."
   2.142 -  ([context-tree x y]
   2.143 -     (under-cursor context-tree x y nil))
   2.144 -  ([context-tree x y context]
   2.145 -     (some #(if (inside? x y %)
   2.146 -              (conj (under-cursor context-tree x y %) %))
   2.147 -           (context-tree context))))
   2.148 +  "Returns a sequence of child nodes under cursor."
   2.149 +  [x y node]
   2.150 +  (some #(if (inside? x y %)
   2.151 +           (conj (under-cursor x y %) %))
   2.152 +        (:children node)))
   2.153  
   2.154  (defn- remove-all [coll1 coll2 pred]
   2.155    (filter #(not (some (partial pred %) coll2)) coll1))
   2.156  
   2.157 -;; (defn- translate-mouse-event
   2.158 -;;   [event x y id]
   2.159 -;;   (proxy [MouseEvent] [(.getComponent event)
   2.160 -;;                        id
   2.161 -;;                        (.getWhen event)
   2.162 -;;                        (.getModifiers event)
   2.163 -;;                        (- (.getX event) x)
   2.164 -;;                        (- (.getY event) y)
   2.165 -;;                        (.getClickCount event)
   2.166 -;;                        (.isPopupTrigger event)]
   2.167 -;;     (getXOnScreen [] (.getXOnScreen event))
   2.168 -;;     (getYOnScreen [] (.getYOnScreen event))))
   2.169 -
   2.170  (defn- translate-mouse-event
   2.171    [event x y id]
   2.172    (MouseEvent. id (.getWhen event)
   2.173 @@ -176,22 +184,22 @@
   2.174                 (.getButton event)))
   2.175  
   2.176  (defn- translate-and-dispatch
   2.177 -  ([contexts event]
   2.178 -     (translate-and-dispatch contexts event (awt-events (.getID event))))
   2.179 -  ([contexts event id]
   2.180 -     (doseq [context contexts]
   2.181 -       (handle-mouse
   2.182 -        (:layer context) context 
   2.183 -        (translate-mouse-event event (:x context) (:y context) id)))
   2.184 +  ([nodes event]
   2.185 +     (translate-and-dispatch nodes event (awt-events (.getID event))))
   2.186 +  ([nodes event id]
   2.187 +     (doseq [node nodes]
   2.188 +       (when-let [handler (get (:handlers node) id)]
   2.189 +         (handler
   2.190 +          (translate-mouse-event event (:x node) (:y node) id))))
   2.191       id))
   2.192  
   2.193  (defn- dispatch-mouse-motion*
   2.194 -  "Dispatches mouse motion events. Returns a new set of contexts which
   2.195 +  "Dispatches mouse motion events. Returns a new set of nodes which
   2.196    currently are under cursor."
   2.197 -  [hovered context-tree event]
   2.198 +  [hovered tree event]
   2.199    (let [x (.getX event)
   2.200          y (.getY event)
   2.201 -        hovered2 (under-cursor context-tree x y)
   2.202 +        hovered2 (under-cursor x y (get tree nil))
   2.203          pred #(= (:layer %1) (:layer %2))
   2.204          exited (remove-all hovered hovered2 pred)
   2.205          entered (remove-all hovered2 hovered pred)
   2.206 @@ -202,12 +210,12 @@
   2.207      hovered2))
   2.208  
   2.209  (defn- dispatch-mouse-motion
   2.210 -  [hovered-ref context-tree event]
   2.211 +  [hovered-ref tree event]
   2.212    (dosync
   2.213 -   (alter hovered-ref dispatch-mouse-motion* context-tree event)))
   2.214 +   (alter hovered-ref dispatch-mouse-motion* tree event)))
   2.215  
   2.216  (defn- dispatch-mouse-button*
   2.217 -  "Dispatches mouse button events. Returns a new set of contexts which
   2.218 +  "Dispatches mouse button events. Returns a new set of nodes which
   2.219    currently are picked with a pressed button."
   2.220    [picked hovered event]
   2.221    (if (= (translate-and-dispatch hovered event) :mouse-pressed)
   2.222 @@ -220,8 +228,9 @@
   2.223     (alter picked-ref dispatch-mouse-button* @hovered-ref event)))
   2.224  
   2.225  (defn make-event-dispatcher []
   2.226 -  (let [context-tree-r (ref {}) ; register
   2.227 -        context-tree (ref {})   ; dispatch
   2.228 +  (let [tree-i {nil (DispatcherRootNode. nil)} ; initial
   2.229 +        tree-r (ref tree-i)                    ; register
   2.230 +        tree (ref tree-i)                      ; dispatch
   2.231          hovered (ref '())
   2.232          picked (ref '())]
   2.233      (reify
   2.234 @@ -230,19 +239,16 @@
   2.235          (doto component
   2.236            (.addMouseListener this)
   2.237            (.addMouseMotionListener this)))
   2.238 -     (register [this context]
   2.239 -        (when (satisfies? MouseHandler (:layer context))
   2.240 -          (dosync (alter context-tree-r add-context context))))
   2.241 +     (register [this context handlers]
   2.242 +        (dosync (alter tree-r add-context context handlers)))
   2.243       (commit [this]
   2.244 -        (dosync (ref-set context-tree @context-tree-r)
   2.245 -                (ref-set context-tree-r {})))
   2.246 -     (picked? [this layer] false)
   2.247 -     (hovered? [this layer] false)
   2.248 +        (dosync (ref-set tree @tree-r)
   2.249 +                (ref-set tree-r tree-i)))
   2.250       MouseListener
   2.251       (mouseEntered [this event]
   2.252 -        (dispatch-mouse-motion hovered @context-tree event))
   2.253 +        (dispatch-mouse-motion hovered @tree event))
   2.254       (mouseExited [this event]
   2.255 -        (dispatch-mouse-motion hovered @context-tree event))
   2.256 +        (dispatch-mouse-motion hovered @tree event))
   2.257       (mouseClicked [this event]
   2.258          (dispatch-mouse-button picked hovered event))
   2.259       (mousePressed [this event]
   2.260 @@ -253,4 +259,29 @@
   2.261       (mouseDragged [this event]
   2.262          (translate-and-dispatch @picked event))
   2.263       (mouseMoved [this event]
   2.264 -        (dispatch-mouse-motion hovered @context-tree event)))))
   2.265 +        (dispatch-mouse-motion hovered @tree event)))))
   2.266 +
   2.267 +;;
   2.268 +;; ИДЕИ:
   2.269 +;;
   2.270 +;; Контекст: биндинги или запись?
   2.271 +;;
   2.272 +;; Установка обработчиков (в контексте слоя):
   2.273 +;;
   2.274 +;; (listen
   2.275 +;;   (:mouse-entered e
   2.276 +;;     ...)
   2.277 +;;   (:mouse-exited e
   2.278 +;;     ...))
   2.279 +;;
   2.280 +;; Не надо IMGUI.
   2.281 +;; Построение сцены путем декорирования слоев:
   2.282 +;;
   2.283 +;; (listener
   2.284 +;;  (:action e (println e))
   2.285 +;;  (:mouse-dragged e (println e))
   2.286 +;;  (theme :font "Helvetica-14"
   2.287 +;;    (vbox
   2.288 +;;      (button (text-layer "Button 1"))
   2.289 +;;      (button (text-layer "Button 2")))))
   2.290 +;;
     3.1 --- a/src/indyvon/layers.clj	Mon Jun 21 04:00:45 2010 +0400
     3.2 +++ b/src/indyvon/layers.clj	Tue Jul 06 06:05:28 2010 +0400
     3.3 @@ -6,7 +6,8 @@
     3.4  
     3.5  (ns indyvon.layers
     3.6    (:use indyvon.core)
     3.7 -  (:import (java.awt Cursor)
     3.8 +  (:import (indyvon.core Size Location)
     3.9 +           (java.awt Cursor)
    3.10             (java.awt.font FontRenderContext TextLayout)))
    3.11  
    3.12  ;; Define as macro to avoid unnecessary calculation of inner and outer
    3.13 @@ -42,8 +43,8 @@
    3.14                      (- h offset offset))))
    3.15          (size [l c]
    3.16             (let [s (size content c)]
    3.17 -             [(+ (s 0) offset offset)
    3.18 -              (+ (s 1) offset offset)]))))))
    3.19 +             (Size. (+ (:width s) offset offset)
    3.20 +                    (+ (:height s) offset offset))))))))
    3.21  
    3.22  (defn- re-split [re s]
    3.23    (seq (.split re s)))
    3.24 @@ -85,7 +86,7 @@
    3.25                                        (:font-context c))
    3.26                   width (text-width layouts)
    3.27                   height (text-height layouts)]
    3.28 -             [width height]))))))
    3.29 +             (Size. width height)))))))
    3.30  
    3.31  (defn viewport
    3.32    "Creates scrollable viewport layer."
    3.33 @@ -100,6 +101,21 @@
    3.34      (reify
    3.35       Layer
    3.36       (render! [layer c g]
    3.37 +        (listen c
    3.38 +         (:mouse-pressed e
    3.39 +          (dosync
    3.40 +           (ref-set fix-x (:x-on-screen e))
    3.41 +           (ref-set fix-y (:y-on-screen e)))
    3.42 +          (->> Cursor/MOVE_CURSOR Cursor. (.setCursor (:target c))))
    3.43 +         (:mouse-released e
    3.44 +          (->> Cursor/DEFAULT_CURSOR Cursor. (.setCursor (:target c))))
    3.45 +         (:mouse-dragged e
    3.46 +          (dosync
    3.47 +           (alter x + (- @fix-x (:x-on-screen e)))
    3.48 +           (alter y + (- @fix-y (:y-on-screen e)))
    3.49 +           (ref-set fix-x (:x-on-screen e))
    3.50 +           (ref-set fix-y (:y-on-screen e)))
    3.51 +          (update c)))
    3.52          (let [anchor (anchor content c h-align v-align)
    3.53                width (:width c)
    3.54                height (:height c)]
    3.55 @@ -109,26 +125,6 @@
    3.56             (ref-set last-width width)
    3.57             (ref-set last-height height))
    3.58            (draw! content c g
    3.59 -                 (- 0 @x (anchor 0))
    3.60 -                 (- 0 @y (anchor 1)))))
    3.61 -     (size [layer c] (size content c))
    3.62 -     MouseHandler
    3.63 -     (handle-mouse [layer c e]
    3.64 -       (case (:id e)
    3.65 -         :mouse-pressed
    3.66 -         (do
    3.67 -           (dosync
    3.68 -            (ref-set fix-x (:x-on-screen e))
    3.69 -            (ref-set fix-y (:y-on-screen e)))
    3.70 -           (->> Cursor/MOVE_CURSOR Cursor. (.setCursor (:target c))))
    3.71 -         :mouse-released
    3.72 -         (->> Cursor/DEFAULT_CURSOR Cursor. (.setCursor (:target c)))
    3.73 -         :mouse-dragged
    3.74 -         (do
    3.75 -           (dosync
    3.76 -            (alter x + (- @fix-x (:x-on-screen e)))
    3.77 -            (alter y + (- @fix-y (:y-on-screen e)))
    3.78 -            (ref-set fix-x (:x-on-screen e))
    3.79 -            (ref-set fix-y (:y-on-screen e)))
    3.80 -           (update c))
    3.81 -         nil))))))
    3.82 +                 (- 0 @x (:x anchor))
    3.83 +                 (- 0 @y (:y anchor)))))
    3.84 +     (size [layer c] (size content c))))))