changeset 8:c53ec3052ae7

Dispatching mouse motion events.
author Mikhail Kryshen <mikhail@kryshen.net>
date Sat, 12 Jun 2010 06:06:41 +0400
parents f6d10a68b01d
children 160e9ec945a2
files src/indyvon/core.clj
diffstat 1 files changed, 97 insertions(+), 22 deletions(-) [+]
line wrap: on
line diff
--- a/src/indyvon/core.clj	Fri Jun 11 22:58:23 2010 +0400
+++ b/src/indyvon/core.clj	Sat Jun 12 06:06:41 2010 +0400
@@ -1,6 +1,7 @@
 (ns indyvon.core
-  (:import (java.awt Dimension Point Component Graphics2D AWTEvent)
-           (java.awt.event MouseAdapter MouseMotionAdapter
+  (:require (clojure [set :as s]))
+  (:import (java.awt Dimension Point Component Graphics2D Color AWTEvent)
+           (java.awt.event MouseEvent MouseAdapter MouseMotionAdapter
                            MouseListener MouseMotionListener)))
 
 (defprotocol Layer
@@ -42,7 +43,7 @@
   ([context layer graphics x y clip]
      (let [s (size layer context)]
        (render-layer! context layer graphics
-                      x y (.width s) (.height s) clip)))
+                      x y (s 0) (s 1) clip)))
   ([context layer graphics x y w h]
      (render-layer! context layer graphics
                     x y w h true))
@@ -90,6 +91,11 @@
      (contains? context-tree parent) parent
      :default (recur context-tree parent))))
 
+(defn- register-context
+  [context-tree context]
+  (assoc-conj
+   context-tree (registered-parent context-tree context) context))
+
 (defn- inside?
   ([x y context]
      (inside? x y (:x context) (:y context)
@@ -109,17 +115,64 @@
               (conj (under-cursor context-tree x y %) %))
            (context-tree context))))
 
+(defn- remove-all [coll1 coll2 pred]
+  (filter #(not (some (partial pred %) coll2)) coll1))
+
+(defn- translate-mouse-event
+  [#^MouseEvent 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-and-dispatch
+  ([contexts event]
+     (translate-and-dispatch contexts event (.getID event)))
+  ([contexts event id]
+  (doseq [c contexts]
+    (handle-layer-event
+     (:layer c)
+     c
+     (translate-mouse-event event (:x c) (:y c) id)))))
+
+(defn- dispatch-mouse-motion*
+  "Dispatches mouse motion events. Returns a new set of contexts which
+  currently are under cursor."
+  [hovered context-tree #^MouseEvent event]
+  (let [x (.getX event)
+        y (.getY event)
+        hovered2 (under-cursor context-tree x y)
+        pred #(= (:layer %1) (:layer %2))
+        exited (remove-all hovered hovered2 pred)
+        entered (remove-all hovered2 hovered pred)
+        moved (remove-all hovered2 entered pred)]
+    (translate-and-dispatch exited event MouseEvent/MOUSE_EXITED)
+    (translate-and-dispatch entered event MouseEvent/MOUSE_ENTERED)
+    (translate-and-dispatch moved event MouseEvent/MOUSE_MOVED)
+    hovered2))
+
+(defn- dispatch-mouse-motion
+  [hovered-ref context-tree #^MouseEvent event]
+  (dosync
+   (alter hovered-ref dispatch-mouse-motion* context-tree event)))
+
 (defn make-event-dispatcher []
   (let [context-tree-r (ref {}) ; register
         context-tree (ref {})   ; dispatch
-        hovered (ref [])
-        picked (ref [])]
+        hovered (ref '())
+        picked (ref '())]
     (reify
      EventDispatcher
      (register [this context]
-               (dosync
-                (alter context-tree-r assoc-conj
-                       (registered-parent context) context)))
+               (dosync (alter context-tree-r register-context context)))
      (commit [this]
              (dosync (ref-set context-tree @context-tree-r)
                      (ref-set context-tree-r {})))
@@ -127,13 +180,17 @@
      (hovered? [this layer] false)
      MouseListener
      (mouseClicked [this event])
-     (mouseEntered [this event])
-     (mouseExited [this event])
+     (mouseEntered [this event]
+                   (dispatch-mouse-motion hovered context-tree event))
+     (mouseExited [this event]
+                  (dispatch-mouse-motion hovered context-tree event))
      (mousePressed [this event])
      (mouseReleased [this event])
      MouseMotionListener
-     (mouseDragged [this event])
-     (mouseMoved [this event]))))
+     (mouseDragged [this event]
+                   (translate-and-dispatch @picked event))
+     (mouseMoved [this event]
+                 (dispatch-mouse-motion hovered context-tree event)))))
 
 ;;
 ;; Connection to AWT.
@@ -154,25 +211,33 @@
                         width (.width size)
                         height (.height size)
                         context (assoc (default-context)
+                                  :dispatcher event-dispatcher
                                   :update-fn (make-update-fn this))]
-                    (render-layer! context layer g 0 0 width height false)))
+                    (render-layer! context layer g 0 0 width height false))
+                  (commit event-dispatcher))
            (getPreferredSize []
                              (let [s (size layer nil)] ;; TODO: supply context
-                               (Dimension. (s 0) (s 1))))
-           (processEvent [event]))
-       ;; No way to call protected final evenbleEvents even in gen-class,
-       ;; have to use the following hack:
-       (.addMouseListener (proxy [MouseAdapter] []))
-       (.addMouseMotionListener (proxy [MouseMotionAdapter] [])))))
+                               (Dimension. (s 0) (s 1)))))
+       (.addMouseListener event-dispatcher)
+       (.addMouseMotionListener event-dispatcher))))
 
 (comment
   (do 
     (def frame (java.awt.Frame. "Test"))
+    (def layer1
+         (reify-layer
+          (render! [this context g]
+                   (register (:dispatcher context) context)
+                   (.setColor g Color/BLUE)
+                   (.fillRect g 0 0 50 30))
+          (size [this context] [50 30])))
     (def layer
          (reify-layer
-          (render! [this]
-                   (.fillRect *graphics* 10 10 40 40))
-          (size [this] [100 100])))
+          (render! [this context g]
+                   (register (:dispatcher context) context)
+                   (.drawLine g 0 0 (:width context) (:height context))
+                   (render-layer! context layer1 g 15 20))
+          (size [this context] [100 100])))
     (doto frame
       (.addWindowListener
        (proxy [java.awt.event.WindowAdapter] []
@@ -180,5 +245,15 @@
       (.add (make-component layer))
       (.pack)
       (.setVisible true))
+
+    (defmethod handle-layer-event [layer1 MouseEvent/MOUSE_ENTERED]
+      [layer context event]
+      (println "ENTERED"))
+    (defmethod handle-layer-event [layer1 MouseEvent/MOUSE_EXITED]
+      [layer context event]
+      (println "EXITED"))
+    (defmethod handle-layer-event [layer1 MouseEvent/MOUSE_MOVED]
+      [layer context event]
+      (println "MOVED")) 
     )
   )
\ No newline at end of file