Mercurial > hg > indyvon

changeset 32:0b3757d263db

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Fixed event dispatcher. Added type hints.
author Mikhail Kryshen <mikhail@kryshen.net>
date Wed, 07 Jul 2010 05:57:49 +0400
parents 8ac3a21955db
children 439f6ecee119
files src/indyvon/component.clj src/indyvon/core.clj src/indyvon/layers.clj
diffstat 3 files changed, 56 insertions(+), 54 deletions(-) [+]
line wrap: on
line diff
--- a/src/indyvon/component.clj	Wed Jul 07 04:14:21 2010 +0400
+++ b/src/indyvon/component.clj	Wed Jul 07 05:57:49 2010 +0400
@@ -7,13 +7,14 @@
 (ns indyvon.component
   (:use indyvon.core indyvon.layers)
   (:import (indyvon.core Size Location)
-           (java.awt Component Dimension Color)
+           (java.awt Component Graphics2D Dimension Color)
            (javax.swing JFrame JPanel)))
 
-(defn- font-context [component]
+(defn- font-context [^Component component]
   (.getFontRenderContext (.getFontMetrics component (.getFont component))))
 
-(defn paint-component [component layer context graphics]
+(defn paint-component
+  [^Component component layer context ^Graphics2D graphics]
   (let [size (.getSize component)
         width (.width size)
         height (.height size)
@@ -23,7 +24,7 @@
                   :update-fn #(.repaint component))]
     (.clearRect graphics 0 0 width height)
     (draw! layer context graphics 0 0 width height false))
-  (commit (:dispatcher context)))
+  (commit (:event-dispatcher context)))
 
 (defn preferred-size [component layer context]
   (let [context (assoc context
@@ -37,7 +38,7 @@
      (make-jpanel layer (root-event-dispatcher)))
   ([layer event-dispatcher]
      (let [context (default-context)
-           context (assoc context :dispatcher event-dispatcher)
+           context (assoc context :event-dispatcher event-dispatcher)
            panel
            (proxy [JPanel] []
              (paintComponent [g]
@@ -100,7 +101,7 @@
     (def layer
          (reify Layer
            (render! [this context g]
-             ;;(update context)
+             (update context)
              (.setColor g (rand-nth [Color/BLACK Color/BLUE Color/RED]))       
              (.drawLine g 0 0 (:width context) (:height context))
              (draw! layer2 context g 15 20)
--- a/src/indyvon/core.clj	Wed Jul 07 04:14:21 2010 +0400
+++ b/src/indyvon/core.clj	Wed Jul 07 05:57:49 2010 +0400
@@ -5,7 +5,7 @@
 ;;
 
 (ns indyvon.core
-  (:import (java.awt Color Font)
+  (:import (java.awt Graphics Component Color Font)
            (java.awt.event MouseListener MouseMotionListener)))
 
 (defprotocol Layer
@@ -20,7 +20,7 @@
 (defrecord MouseEvent [id when x y x-on-screen y-on-screen button])
 
 (defprotocol EventDispatcher
-  (listen! [this component]
+  (listen! [this ^Component component]
      "Listen for events on the specified AWT Component.")
   (create-dispatcher [this context handle handlers]
      "Returns new event dispatcher associated with the specified event
@@ -67,13 +67,13 @@
 (defn update [context]
   ((:update-fn context)))
 
-(defn- make-graphics [graphics x y w h clip]
+(defn- ^Graphics make-graphics [^Graphics graphics x y w h clip]
   (if clip
     (.create graphics x y w h)
     (doto (.create graphics)
       (.translate x y))))
 
-(defn- apply-theme [graphics theme]
+(defn- ^Graphics apply-theme [^Graphics graphics theme]
   (doto graphics
     (.setColor (:fore-color theme))
     (.setFont (:font theme))))
@@ -81,8 +81,7 @@
 (defn draw!
   "Render layer in a new graphics context."
   ([layer context graphics]
-     (draw! layer context graphics
-                    0 0 (:width context) (:height context)))
+     (render! layer context graphics))
   ([layer context graphics x y]
      (draw! layer context graphics x y true))
   ([layer context graphics x y clip]
@@ -107,8 +106,15 @@
          (finally
           (.dispose graphics))))))
 
-(defmacro handlers [handle bindings & specs]
-  "bindings => binding-form context
+(defn add-handlers [context handle handlers]
+  "Returns new context with the specified event handlers."
+  (assoc context
+    :event-dispatcher
+    (create-dispatcher (:event-dispatcher context) context
+                       handle handlers)))
+
+(defmacro let-handlers [handle bindings & specs]
+  "bindings => [binding-form context] or [context-symbol]
    specs => (:event-id name & handler-body)* form
 
   Execute form with the specified event handlers."
@@ -116,14 +122,12 @@
         context (or context binding)]
     `(let [context# ~context
            ~binding
-           (assoc context# :event-dispatcher
-             (create-dispatcher (:event-dispatcher context#)
-               context# handle
-               ~(reduce (fn [m spec]
-                          (assoc m (first spec)
-                                 `(fn [~(second spec)]
-                                    ~@(nnext spec)))) {}
-                                    (butlast specs))))]
+           (add-handlers context# ~handle
+             ~(reduce (fn [m spec]
+                        (assoc m (first spec)
+                               `(fn [~(second spec)]
+                                  ~@(nnext spec)))) {}
+                                  (butlast specs)))]
            ~(last specs))))
 
 ;;
@@ -148,8 +152,8 @@
   (commit [this]
      (commit parent)))
 
-(defn- make-node [parent c handle handlers]
-  (DispatcherNode. handle handlers parent
+(defn- make-node [c handle handlers]
+  (DispatcherNode. handle handlers (:event-dispatcher c)
                    (:x c) (:y c) (:width c) (:height c)))
 
 (defn- assoc-cons [m key val]
@@ -170,25 +174,22 @@
 
 (defn- under-cursor
   "Returns a sequence of child nodes under cursor."
-  ([x y tree]
-     (under-cursor x y tree nil))
-  ([x y tree node]
-     (some #(if (inside? x y %)
-              (conj (under-cursor x y %) %))
-           (get tree node))))
+  [x y tree node]
+  (some #(if (inside? x y %)
+           (conj (under-cursor x y tree %) %))
+        (get tree node)))
 
 (defn- remove-all [coll1 coll2 pred]
   (filter #(not (some (partial pred %) coll2)) coll1))
 
-(defn- translate-mouse-event
-  [event x y id]
+(defn- translate-mouse-event [^java.awt.event.MouseEvent 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]
+  ([nodes ^java.awt.event.MouseEvent event]
      (translate-and-dispatch nodes event (awt-events (.getID event))))
   ([nodes event id]
      (doseq [node nodes]
@@ -200,10 +201,10 @@
 (defn- dispatch-mouse-motion*
   "Dispatches mouse motion events. Returns a new set of nodes which
   currently are under cursor."
-  [hovered tree event]
+  [hovered tree root ^java.awt.event.MouseEvent event]
   (let [x (.getX event)
         y (.getY event)
-        hovered2 (under-cursor x y tree)
+        hovered2 (under-cursor x y tree root)
         pred #(= (:handle %1) (:handle %2))
         exited (remove-all hovered hovered2 pred)
         entered (remove-all hovered2 hovered pred)
@@ -214,9 +215,9 @@
     hovered2))
 
 (defn- dispatch-mouse-motion
-  [hovered-ref tree event]
+  [hovered-ref tree root event]
   (dosync
-   (alter hovered-ref dispatch-mouse-motion* tree event)))
+   (alter hovered-ref dispatch-mouse-motion* tree root event)))
 
 (defn- dispatch-mouse-button*
   "Dispatches mouse button events. Returns a new set of nodes which
@@ -243,7 +244,7 @@
           (.addMouseListener this)
           (.addMouseMotionListener this)))
      (create-dispatcher [this context handle handlers]
-        (let [node (make-node this context handle handlers)]
+        (let [node (make-node context handle handlers)]
           (dosync (alter tree-r add-node node))
           node))
      (commit [this]
@@ -251,9 +252,9 @@
                 (ref-set tree-r {})))
      MouseListener
      (mouseEntered [this event]
-        (dispatch-mouse-motion hovered @tree event))
+        (dispatch-mouse-motion hovered @tree this event))
      (mouseExited [this event]
-        (dispatch-mouse-motion hovered @tree event))
+        (dispatch-mouse-motion hovered @tree this event))
      (mouseClicked [this event]
         (dispatch-mouse-button picked hovered event))
      (mousePressed [this event]
@@ -264,7 +265,7 @@
      (mouseDragged [this event]
         (translate-and-dispatch @picked event))
      (mouseMoved [this event]
-        (dispatch-mouse-motion hovered @tree event)))))
+        (dispatch-mouse-motion hovered @tree this event)))))
 
 ;;
 ;; ИДЕИ:
--- a/src/indyvon/layers.clj	Wed Jul 07 04:14:21 2010 +0400
+++ b/src/indyvon/layers.clj	Wed Jul 07 05:57:49 2010 +0400
@@ -101,7 +101,7 @@
     (reify
      Layer
      (render! [layer c g]
-        (listen c
+        (let-handlers layer [c]
          (:mouse-pressed e
           (dosync
            (ref-set fix-x (:x-on-screen e))
@@ -115,16 +115,16 @@
            (alter y + (- @fix-y (:y-on-screen e)))
            (ref-set fix-x (:x-on-screen e))
            (ref-set fix-y (:y-on-screen e)))
-          (update c)))
-        (let [anchor (anchor content c h-align v-align)
-              width (:width c)
-              height (:height c)]
-          (dosync
-           (alter x + (align-x width @last-width h-align))
-           (alter y + (align-y height @last-height v-align))
-           (ref-set last-width width)
-           (ref-set last-height height))
-          (draw! content c g
-                 (- 0 @x (:x anchor))
-                 (- 0 @y (:y anchor)))))
+          (update c))
+         (let [anchor (anchor content c h-align v-align)
+               width (:width c)
+               height (:height c)]
+           (dosync
+            (alter x + (align-x width @last-width h-align))
+            (alter y + (align-y height @last-height v-align))
+            (ref-set last-width width)
+            (ref-set last-height height))
+           (draw! content c g
+                  (- 0 @x (:x anchor))
+                  (- 0 @y (:y anchor))))))
      (size [layer c] (size content c))))))