1.1 --- a/src/indyvon/core.clj	Fri Jun 11 22:58:23 2010 +0400
     1.2 +++ b/src/indyvon/core.clj	Sat Jun 12 06:06:41 2010 +0400
     1.3 @@ -1,6 +1,7 @@
     1.4  (ns indyvon.core
     1.5 -  (:import (java.awt Dimension Point Component Graphics2D AWTEvent)
     1.6 -           (java.awt.event MouseAdapter MouseMotionAdapter
     1.7 +  (:require (clojure [set :as s]))
     1.8 +  (:import (java.awt Dimension Point Component Graphics2D Color AWTEvent)
     1.9 +           (java.awt.event MouseEvent MouseAdapter MouseMotionAdapter
    1.10                             MouseListener MouseMotionListener)))
    1.11  
    1.12  (defprotocol Layer
    1.13 @@ -42,7 +43,7 @@
    1.14    ([context layer graphics x y clip]
    1.15       (let [s (size layer context)]
    1.16         (render-layer! context layer graphics
    1.17 -                      x y (.width s) (.height s) clip)))
    1.18 +                      x y (s 0) (s 1) clip)))
    1.19    ([context layer graphics x y w h]
    1.20       (render-layer! context layer graphics
    1.21                      x y w h true))
    1.22 @@ -90,6 +91,11 @@
    1.23       (contains? context-tree parent) parent
    1.24       :default (recur context-tree parent))))
    1.25  
    1.26 +(defn- register-context
    1.27 +  [context-tree context]
    1.28 +  (assoc-conj
    1.29 +   context-tree (registered-parent context-tree context) context))
    1.30 +
    1.31  (defn- inside?
    1.32    ([x y context]
    1.33       (inside? x y (:x context) (:y context)
    1.34 @@ -109,17 +115,64 @@
    1.35                (conj (under-cursor context-tree x y %) %))
    1.36             (context-tree context))))
    1.37  
    1.38 +(defn- remove-all [coll1 coll2 pred]
    1.39 +  (filter #(not (some (partial pred %) coll2)) coll1))
    1.40 +
    1.41 +(defn- translate-mouse-event
    1.42 +  [#^MouseEvent event x y id]
    1.43 +  (proxy [MouseEvent] [(.getComponent event)
    1.44 +                       id
    1.45 +                       (.getWhen event)
    1.46 +                       (.getModifiers event)
    1.47 +                       (- (.getX event) x)
    1.48 +                       (- (.getY event) y)
    1.49 +                       (.getClickCount event)
    1.50 +                       (.isPopupTrigger event)]
    1.51 +    (getXOnScreen []
    1.52 +                  (.getXOnScreen event))
    1.53 +    (getYOnScreen []
    1.54 +                  (.getYOnScreen event))))
    1.55 +
    1.56 +(defn- translate-and-dispatch
    1.57 +  ([contexts event]
    1.58 +     (translate-and-dispatch contexts event (.getID event)))
    1.59 +  ([contexts event id]
    1.60 +  (doseq [c contexts]
    1.61 +    (handle-layer-event
    1.62 +     (:layer c)
    1.63 +     c
    1.64 +     (translate-mouse-event event (:x c) (:y c) id)))))
    1.65 +
    1.66 +(defn- dispatch-mouse-motion*
    1.67 +  "Dispatches mouse motion events. Returns a new set of contexts which
    1.68 +  currently are under cursor."
    1.69 +  [hovered context-tree #^MouseEvent event]
    1.70 +  (let [x (.getX event)
    1.71 +        y (.getY event)
    1.72 +        hovered2 (under-cursor context-tree x y)
    1.73 +        pred #(= (:layer %1) (:layer %2))
    1.74 +        exited (remove-all hovered hovered2 pred)
    1.75 +        entered (remove-all hovered2 hovered pred)
    1.76 +        moved (remove-all hovered2 entered pred)]
    1.77 +    (translate-and-dispatch exited event MouseEvent/MOUSE_EXITED)
    1.78 +    (translate-and-dispatch entered event MouseEvent/MOUSE_ENTERED)
    1.79 +    (translate-and-dispatch moved event MouseEvent/MOUSE_MOVED)
    1.80 +    hovered2))
    1.81 +
    1.82 +(defn- dispatch-mouse-motion
    1.83 +  [hovered-ref context-tree #^MouseEvent event]
    1.84 +  (dosync
    1.85 +   (alter hovered-ref dispatch-mouse-motion* context-tree event)))
    1.86 +
    1.87  (defn make-event-dispatcher []
    1.88    (let [context-tree-r (ref {}) ; register
    1.89          context-tree (ref {})   ; dispatch
    1.90 -        hovered (ref [])
    1.91 -        picked (ref [])]
    1.92 +        hovered (ref '())
    1.93 +        picked (ref '())]
    1.94      (reify
    1.95       EventDispatcher
    1.96       (register [this context]
    1.97 -               (dosync
    1.98 -                (alter context-tree-r assoc-conj
    1.99 -                       (registered-parent context) context)))
   1.100 +               (dosync (alter context-tree-r register-context context)))
   1.101       (commit [this]
   1.102               (dosync (ref-set context-tree @context-tree-r)
   1.103                       (ref-set context-tree-r {})))
   1.104 @@ -127,13 +180,17 @@
   1.105       (hovered? [this layer] false)
   1.106       MouseListener
   1.107       (mouseClicked [this event])
   1.108 -     (mouseEntered [this event])
   1.109 -     (mouseExited [this event])
   1.110 +     (mouseEntered [this event]
   1.111 +                   (dispatch-mouse-motion hovered context-tree event))
   1.112 +     (mouseExited [this event]
   1.113 +                  (dispatch-mouse-motion hovered context-tree event))
   1.114       (mousePressed [this event])
   1.115       (mouseReleased [this event])
   1.116       MouseMotionListener
   1.117 -     (mouseDragged [this event])
   1.118 -     (mouseMoved [this event]))))
   1.119 +     (mouseDragged [this event]
   1.120 +                   (translate-and-dispatch @picked event))
   1.121 +     (mouseMoved [this event]
   1.122 +                 (dispatch-mouse-motion hovered context-tree event)))))
   1.123  
   1.124  ;;
   1.125  ;; Connection to AWT.
   1.126 @@ -154,25 +211,33 @@
   1.127                          width (.width size)
   1.128                          height (.height size)
   1.129                          context (assoc (default-context)
   1.130 +                                  :dispatcher event-dispatcher
   1.131                                    :update-fn (make-update-fn this))]
   1.132 -                    (render-layer! context layer g 0 0 width height false)))
   1.133 +                    (render-layer! context layer g 0 0 width height false))
   1.134 +                  (commit event-dispatcher))
   1.135             (getPreferredSize []
   1.136                               (let [s (size layer nil)] ;; TODO: supply context
   1.137 -                               (Dimension. (s 0) (s 1))))
   1.138 -           (processEvent [event]))
   1.139 -       ;; No way to call protected final evenbleEvents even in gen-class,
   1.140 -       ;; have to use the following hack:
   1.141 -       (.addMouseListener (proxy [MouseAdapter] []))
   1.142 -       (.addMouseMotionListener (proxy [MouseMotionAdapter] [])))))
   1.143 +                               (Dimension. (s 0) (s 1)))))
   1.144 +       (.addMouseListener event-dispatcher)
   1.145 +       (.addMouseMotionListener event-dispatcher))))
   1.146  
   1.147  (comment
   1.148    (do 
   1.149      (def frame (java.awt.Frame. "Test"))
   1.150 +    (def layer1
   1.151 +         (reify-layer
   1.152 +          (render! [this context g]
   1.153 +                   (register (:dispatcher context) context)
   1.154 +                   (.setColor g Color/BLUE)
   1.155 +                   (.fillRect g 0 0 50 30))
   1.156 +          (size [this context] [50 30])))
   1.157      (def layer
   1.158           (reify-layer
   1.159 -          (render! [this]
   1.160 -                   (.fillRect *graphics* 10 10 40 40))
   1.161 -          (size [this] [100 100])))
   1.162 +          (render! [this context g]
   1.163 +                   (register (:dispatcher context) context)
   1.164 +                   (.drawLine g 0 0 (:width context) (:height context))
   1.165 +                   (render-layer! context layer1 g 15 20))
   1.166 +          (size [this context] [100 100])))
   1.167      (doto frame
   1.168        (.addWindowListener
   1.169         (proxy [java.awt.event.WindowAdapter] []
   1.170 @@ -180,5 +245,15 @@
   1.171        (.add (make-component layer))
   1.172        (.pack)
   1.173        (.setVisible true))
   1.174 +
   1.175 +    (defmethod handle-layer-event [layer1 MouseEvent/MOUSE_ENTERED]
   1.176 +      [layer context event]
   1.177 +      (println "ENTERED"))
   1.178 +    (defmethod handle-layer-event [layer1 MouseEvent/MOUSE_EXITED]
   1.179 +      [layer context event]
   1.180 +      (println "EXITED"))
   1.181 +    (defmethod handle-layer-event [layer1 MouseEvent/MOUSE_MOVED]
   1.182 +      [layer context event]
   1.183 +      (println "MOVED")) 
   1.184      )
   1.185    )
   1.186 \ No newline at end of file