Mercurial > hg > indyvon
changeset 10:9af27ccccfac
Separated namespaces.
author | Mikhail Kryshen <mikhail@kryshen.net> |
---|---|
date | Sun, 13 Jun 2010 04:57:14 +0400 |
parents | 160e9ec945a2 |
children | ea6fc44f19c8 |
files | project.clj src/indyvon/component.clj src/indyvon/core.clj src/indyvon/event.clj |
diffstat | 4 files changed, 238 insertions(+), 264 deletions(-) [+] |
line diff
1.1 --- a/project.clj Sun Jun 13 02:49:09 2010 +0400 1.2 +++ b/project.clj Sun Jun 13 04:57:14 2010 +0400 1.3 @@ -3,4 +3,6 @@ 1.4 :dependencies [[org.clojure/clojure "1.2.0-master-SNAPSHOT"] 1.5 [org.clojure/clojure-contrib "1.2.0-SNAPSHOT"]] 1.6 :dev-dependencies [[leiningen/lein-swank "1.2.0-SNAPSHOT"]] 1.7 - :namespaces [indyvon.core]) 1.8 + :namespaces [indyvon.core 1.9 + indyvon.event 1.10 + indyvon.component])
2.1 --- a/src/indyvon/component.clj Sun Jun 13 02:49:09 2010 +0400 2.2 +++ b/src/indyvon/component.clj Sun Jun 13 04:57:14 2010 +0400 2.3 @@ -1,54 +1,92 @@ 2.4 -;; (ns indyvon.component 2.5 -;; (:use indyvon.core) 2.6 -;; (:import (java.awt Graphics Graphics2D Dimension AWTEvent)) 2.7 -;; (:gen-class 2.8 -;; :name indyvon.IdvComponent 2.9 -;; :extends java.awt.Component 2.10 -;; :constructors {[indyvon.core.Layer] [], 2.11 -;; [indyvon.core.Layer indyvon.core.EventDispatcher] []} 2.12 -;; :exposes-methods {enableEvents enableEventsSuper} 2.13 -;; :state state 2.14 -;; :init init 2.15 -;; :post-init post-init)) 2.16 +;; 2.17 +;; Copyright (C) 2010 Mikhail Kryshen <mikhail@kryshen.net> 2.18 +;; 2.19 +;; This file is part of Indyvon. 2.20 +;; 2.21 2.22 -;; (defrecord State [layer event]) 2.23 +(ns indyvon.component 2.24 + (:use indyvon.core 2.25 + indyvon.event) 2.26 + (:import (java.awt Component Dimension Color) 2.27 + (java.awt.event MouseEvent))) 2.28 2.29 -;; (defn- -init 2.30 -;; ([layer] 2.31 -;; [[] (State. layer (make-event-dispatcher))]) 2.32 -;; ([layer dispatcher] 2.33 -;; [[] (State. layer dispatcher)])) 2.34 +(defn- make-update-fn [component] 2.35 + (fn [] (.repaint component))) 2.36 2.37 -;; (defn -enableEvents [this mask] 2.38 -;; (.enableEventsSuper this mask)) 2.39 +(defn make-component 2.40 + ([layer] 2.41 + (make-component layer (make-event-dispatcher))) 2.42 + ([layer event-dispatcher] 2.43 + (let [component 2.44 + (proxy [Component] [] 2.45 + (update [g] (.paint this g)) 2.46 + (paint [g] 2.47 + (let [size (.getSize this) 2.48 + width (.width size) 2.49 + height (.height size) 2.50 + context (assoc (default-context) 2.51 + :dispatcher event-dispatcher 2.52 + :update-fn (make-update-fn this))] 2.53 + (render-layer! context layer g 0 0 width height false)) 2.54 + (commit event-dispatcher)) 2.55 + (getPreferredSize [] 2.56 + ;; TODO: supply context 2.57 + (let [s (size layer nil)] 2.58 + (Dimension. (s 0) (s 1)))))] 2.59 + (listen! event-dispatcher component) 2.60 + component))) 2.61 2.62 -;; (defn- -post-init [this & args] 2.63 -;; (.enableEvents 2.64 -;; this 2.65 -;; ^long (reduce bit-or 2.66 -;; [AWTEvent/MOUSE_EVENT_MASK 2.67 -;; AWTEvent/MOUSE_MOTION_EVENT_MASK 2.68 -;; AWTEvent/MOUSE_WHEEL_EVENT_MASK 2.69 -;; AWTEvent/KEY_EVENT_MASK]))) 2.70 +(comment 2.71 + (do 2.72 + (def frame (java.awt.Frame. "Test")) 2.73 + (def layer1 2.74 + (reify-layer 2.75 + (render! [this context g] 2.76 + (register-context context) 2.77 + (.setColor g Color/WHITE) 2.78 + (.fillRect g 0 0 (:width context) (:height context))) 2.79 + (size [this context] [30 20]))) 2.80 + (def layer2 2.81 + (reify-layer 2.82 + (render! [this context g] 2.83 + (register-context context) 2.84 + (.setColor g Color/BLUE) 2.85 + (.fillRect g 0 0 (:width context) (:height context)) 2.86 + (render-layer! context layer1 g 10 5) 2.87 + (render-layer! context layer1 g 50 5)) 2.88 + (size [this context] [70 65]))) 2.89 + (def layer 2.90 + (reify-layer 2.91 + (render! [this context g] 2.92 + ;;(register-context context) 2.93 + (.drawLine g 0 0 (:width context) (:height context)) 2.94 + (render-layer! context layer2 g 15 20)) 2.95 + (size [this context] [100 100]))) 2.96 + (doto frame 2.97 + (.addWindowListener 2.98 + (proxy [java.awt.event.WindowAdapter] [] 2.99 + (windowClosing [event] (.dispose frame)))) 2.100 + (.add (make-component layer)) 2.101 + (.pack) 2.102 + (.setVisible true)) 2.103 2.104 -;; (defn- make-update-fn [component] 2.105 -;; (fn [] (.repaint component))) 2.106 - 2.107 -;; (defn -paint [this g] 2.108 -;; (let [layer (-> this .state :layer) 2.109 -;; size (.getSize this) 2.110 -;; width (.width size) 2.111 -;; height (.height size)] 2.112 -;; (binding [*graphics* g 2.113 -;; *update-fn* (make-update-fn this)] 2.114 -;; (render-layer! layer 0 0 width height false)))) 2.115 - 2.116 -;; (defn -update [this g] 2.117 -;; (-paint this g)) 2.118 - 2.119 -;; (defn -processEvent [this event] 2.120 -;; (dispatch (-> this .state :dispatcher) event)) 2.121 - 2.122 -;; (defn -getPreferredSize [this] 2.123 -;; (let [s (-> this .state :layer size)] 2.124 -;; (Dimension. (s 0) (s 1)))) 2.125 + (defmethod handle-layer-event [layer1 MouseEvent/MOUSE_ENTERED] 2.126 + [layer context event] 2.127 + (println "1 ENTERED")) 2.128 + (defmethod handle-layer-event [layer1 MouseEvent/MOUSE_EXITED] 2.129 + [layer context event] 2.130 + (println "1 EXITED")) 2.131 + (defmethod handle-layer-event [layer1 MouseEvent/MOUSE_MOVED] 2.132 + [layer context event] 2.133 + (println "1 MOVED")) 2.134 + (defmethod handle-layer-event [layer2 MouseEvent/MOUSE_ENTERED] 2.135 + [layer context event] 2.136 + (println "2 ENTERED")) 2.137 + (defmethod handle-layer-event [layer2 MouseEvent/MOUSE_EXITED] 2.138 + [layer context event] 2.139 + (println "2 EXITED")) 2.140 + (defmethod handle-layer-event [layer2 MouseEvent/MOUSE_MOVED] 2.141 + [layer context event] 2.142 + (println "2 MOVED")) 2.143 + ) 2.144 + )
3.1 --- a/src/indyvon/core.clj Sun Jun 13 02:49:09 2010 +0400 3.2 +++ b/src/indyvon/core.clj Sun Jun 13 04:57:14 2010 +0400 3.3 @@ -1,8 +1,10 @@ 3.4 -(ns indyvon.core 3.5 - (:require (clojure [set :as s])) 3.6 - (:import (java.awt Dimension Point Component Graphics2D Color AWTEvent) 3.7 - (java.awt.event MouseEvent MouseAdapter MouseMotionAdapter 3.8 - MouseListener MouseMotionListener))) 3.9 +;; 3.10 +;; Copyright (C) 2010 Mikhail Kryshen <mikhail@kryshen.net> 3.11 +;; 3.12 +;; This file is part of Indyvon. 3.13 +;; 3.14 + 3.15 +(ns indyvon.core) 3.16 3.17 (defprotocol Layer 3.18 (render! [this context graphics]) 3.19 @@ -62,212 +64,3 @@ 3.20 (finally 3.21 (.dispose graphics)))))) 3.22 3.23 -;; 3.24 -;; Event handling 3.25 -;; 3.26 - 3.27 -(defmulti handle-layer-event 3.28 - (fn [layer context event] 3.29 - [layer (.getID event)])) 3.30 - 3.31 -(defmethod handle-layer-event :default [layer context event]) 3.32 - 3.33 -(defprotocol EventDispatcher 3.34 - (register [this context]) 3.35 - (commit [this]) 3.36 - (hovered? [this layer]) 3.37 - (picked? [this layer])) 3.38 - 3.39 -(defn- registered-parent 3.40 - "Returns first context parent registered for event processing." 3.41 - [context-tree context] 3.42 - (let [parent (:parent context)] 3.43 - (cond 3.44 - (nil? parent) nil 3.45 - (contains? context-tree parent) parent 3.46 - :default (recur context-tree parent)))) 3.47 - 3.48 -(defn- register-context 3.49 - [context-tree context] 3.50 - (let [parent (registered-parent context-tree context)] 3.51 - (assoc context-tree parent (conj (context-tree parent) context) 3.52 - context nil))) 3.53 - 3.54 -(defn- inside? 3.55 - ([x y context] 3.56 - (inside? x y (:x context) (:y context) 3.57 - (:width context) (:height context))) 3.58 - ([px py x y w h] 3.59 - (and (>= px x) 3.60 - (>= py y) 3.61 - (< px (+ x w)) 3.62 - (< py (+ y h))))) 3.63 - 3.64 -(defn- under-cursor 3.65 - "Returns a sequence of contexts under cursor." 3.66 - ([context-tree x y] 3.67 - (under-cursor context-tree x y nil)) 3.68 - ([context-tree x y context] 3.69 - (some #(if (inside? x y %) 3.70 - (conj (under-cursor context-tree x y %) %)) 3.71 - (context-tree context)))) 3.72 - 3.73 -(defn- remove-all [coll1 coll2 pred] 3.74 - (filter #(not (some (partial pred %) coll2)) coll1)) 3.75 - 3.76 -(defn- translate-mouse-event 3.77 - [#^MouseEvent event x y id] 3.78 - (proxy [MouseEvent] [(.getComponent event) 3.79 - id 3.80 - (.getWhen event) 3.81 - (.getModifiers event) 3.82 - (- (.getX event) x) 3.83 - (- (.getY event) y) 3.84 - (.getClickCount event) 3.85 - (.isPopupTrigger event)] 3.86 - (getXOnScreen [] 3.87 - (.getXOnScreen event)) 3.88 - (getYOnScreen [] 3.89 - (.getYOnScreen event)))) 3.90 - 3.91 -(defn- translate-and-dispatch 3.92 - ([contexts event] 3.93 - (translate-and-dispatch contexts event (.getID event))) 3.94 - ([contexts event id] 3.95 - (doseq [c contexts] 3.96 - (handle-layer-event 3.97 - (:layer c) 3.98 - c 3.99 - (translate-mouse-event event (:x c) (:y c) id))))) 3.100 - 3.101 -(defn- dispatch-mouse-motion* 3.102 - "Dispatches mouse motion events. Returns a new set of contexts which 3.103 - currently are under cursor." 3.104 - [hovered context-tree #^MouseEvent event] 3.105 - (let [x (.getX event) 3.106 - y (.getY event) 3.107 - hovered2 (under-cursor context-tree x y) 3.108 - pred #(= (:layer %1) (:layer %2)) 3.109 - exited (remove-all hovered hovered2 pred) 3.110 - entered (remove-all hovered2 hovered pred) 3.111 - moved (remove-all hovered2 entered pred)] 3.112 - (translate-and-dispatch exited event MouseEvent/MOUSE_EXITED) 3.113 - (translate-and-dispatch entered event MouseEvent/MOUSE_ENTERED) 3.114 - (translate-and-dispatch moved event MouseEvent/MOUSE_MOVED) 3.115 - hovered2)) 3.116 - 3.117 -(defn- dispatch-mouse-motion 3.118 - [hovered-ref context-tree #^MouseEvent event] 3.119 - (dosync 3.120 - (alter hovered-ref dispatch-mouse-motion* context-tree event))) 3.121 - 3.122 -(defn make-event-dispatcher [] 3.123 - (let [context-tree-r (ref {}) ; register 3.124 - context-tree (ref {}) ; dispatch 3.125 - hovered (ref '()) 3.126 - picked (ref '())] 3.127 - (reify 3.128 - EventDispatcher 3.129 - (register [this context] 3.130 - (dosync (alter context-tree-r register-context context))) 3.131 - (commit [this] 3.132 - (dosync (ref-set context-tree @context-tree-r) 3.133 - (ref-set context-tree-r {}))) 3.134 - (picked? [this layer] false) 3.135 - (hovered? [this layer] false) 3.136 - MouseListener 3.137 - (mouseClicked [this event]) 3.138 - (mouseEntered [this event] 3.139 - (dispatch-mouse-motion hovered context-tree event)) 3.140 - (mouseExited [this event] 3.141 - (dispatch-mouse-motion hovered context-tree event)) 3.142 - (mousePressed [this event]) 3.143 - (mouseReleased [this event]) 3.144 - MouseMotionListener 3.145 - (mouseDragged [this event] 3.146 - (translate-and-dispatch @picked event)) 3.147 - (mouseMoved [this event] 3.148 - (dispatch-mouse-motion hovered context-tree event))))) 3.149 - 3.150 -;; 3.151 -;; Connection to AWT. 3.152 -;; 3.153 - 3.154 -(defn- make-update-fn [component] 3.155 - (fn [] (.repaint component))) 3.156 - 3.157 -(defn make-component 3.158 - ([layer] 3.159 - (make-component layer (make-event-dispatcher))) 3.160 - ([layer event-dispatcher] 3.161 - (doto 3.162 - (proxy [Component] [] 3.163 - (update [g] (.paint this g)) 3.164 - (paint [g] 3.165 - (let [size (.getSize this) 3.166 - width (.width size) 3.167 - height (.height size) 3.168 - context (assoc (default-context) 3.169 - :dispatcher event-dispatcher 3.170 - :update-fn (make-update-fn this))] 3.171 - (render-layer! context layer g 0 0 width height false)) 3.172 - (commit event-dispatcher)) 3.173 - (getPreferredSize [] 3.174 - (let [s (size layer nil)] ;; TODO: supply context 3.175 - (Dimension. (s 0) (s 1))))) 3.176 - (.addMouseListener event-dispatcher) 3.177 - (.addMouseMotionListener event-dispatcher)))) 3.178 - 3.179 -(comment 3.180 - (do 3.181 - (def frame (java.awt.Frame. "Test")) 3.182 - (def layer1 3.183 - (reify-layer 3.184 - (render! [this context g] 3.185 - (register (:dispatcher context) context) 3.186 - (.setColor g Color/WHITE) 3.187 - (.fillRect g 0 0 (:width context) (:height context))) 3.188 - (size [this context] [50 30]))) 3.189 - (def layer2 3.190 - (reify-layer 3.191 - (render! [this context g] 3.192 - (register (:dispatcher context) context) 3.193 - (.setColor g Color/BLUE) 3.194 - (.fillRect g 0 0 (:width context) (:height context)) 3.195 - (render-layer! context layer1 g 10 5)) 3.196 - (size [this context] [70 65]))) 3.197 - (def layer 3.198 - (reify-layer 3.199 - (render! [this context g] 3.200 - ;;(register (:dispatcher context) context) 3.201 - (.drawLine g 0 0 (:width context) (:height context)) 3.202 - (render-layer! context layer2 g 15 20)) 3.203 - (size [this context] [100 100]))) 3.204 - (doto frame 3.205 - (.addWindowListener 3.206 - (proxy [java.awt.event.WindowAdapter] [] 3.207 - (windowClosing [event] (.dispose frame)))) 3.208 - (.add (make-component layer)) 3.209 - (.pack) 3.210 - (.setVisible true)) 3.211 - 3.212 - (defmethod handle-layer-event [layer1 MouseEvent/MOUSE_ENTERED] 3.213 - [layer context event] 3.214 - (println "1 ENTERED")) 3.215 - (defmethod handle-layer-event [layer1 MouseEvent/MOUSE_EXITED] 3.216 - [layer context event] 3.217 - (println "1 EXITED")) 3.218 - (defmethod handle-layer-event [layer1 MouseEvent/MOUSE_MOVED] 3.219 - [layer context event] 3.220 - (println "1 MOVED")) 3.221 - (defmethod handle-layer-event [layer2 MouseEvent/MOUSE_ENTERED] 3.222 - [layer context event] 3.223 - (println "2 ENTERED")) 3.224 - (defmethod handle-layer-event [layer2 MouseEvent/MOUSE_EXITED] 3.225 - [layer context event] 3.226 - (println "2 EXITED")) 3.227 - (defmethod handle-layer-event [layer2 MouseEvent/MOUSE_MOVED] 3.228 - [layer context event] 3.229 - (println "2 MOVED")) 3.230 - ) 3.231 - ) 3.232 \ No newline at end of file
4.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000 4.2 +++ b/src/indyvon/event.clj Sun Jun 13 04:57:14 2010 +0400 4.3 @@ -0,0 +1,141 @@ 4.4 +;; 4.5 +;; Copyright (C) 2010 Mikhail Kryshen <mikhail@kryshen.net> 4.6 +;; 4.7 +;; This file is part of Indyvon. 4.8 +;; 4.9 + 4.10 +(ns indyvon.event 4.11 + (:use indyvon.core) 4.12 + (:import (java.awt.event MouseEvent MouseListener MouseMotionListener))) 4.13 + 4.14 +(defmulti handle-layer-event 4.15 + (fn [layer context event] 4.16 + [layer (.getID event)])) 4.17 + 4.18 +(defmethod handle-layer-event :default [layer context event]) 4.19 + 4.20 +(defprotocol EventDispatcher 4.21 + (listen! [this component]) 4.22 + (register [this context]) 4.23 + (commit [this]) 4.24 + (hovered? [this layer]) 4.25 + (picked? [this layer])) 4.26 + 4.27 +(defn register-context [context] 4.28 + (register (:dispatcher context) context)) 4.29 + 4.30 +(defn- registered-parent 4.31 + "Returns first context parent registered for event processing." 4.32 + [context-tree context] 4.33 + (let [parent (:parent context)] 4.34 + (cond 4.35 + (nil? parent) nil 4.36 + (contains? context-tree parent) parent 4.37 + :default (recur context-tree parent)))) 4.38 + 4.39 +(defn- add-context 4.40 + [context-tree context] 4.41 + (let [parent (registered-parent context-tree context)] 4.42 + (assoc context-tree parent (conj (context-tree parent) context) 4.43 + context nil))) 4.44 + 4.45 +(defn- inside? 4.46 + ([x y context] 4.47 + (inside? x y (:x context) (:y context) 4.48 + (:width context) (:height context))) 4.49 + ([px py x y w h] 4.50 + (and (>= px x) 4.51 + (>= py y) 4.52 + (< px (+ x w)) 4.53 + (< py (+ y h))))) 4.54 + 4.55 +(defn- under-cursor 4.56 + "Returns a sequence of contexts under cursor." 4.57 + ([context-tree x y] 4.58 + (under-cursor context-tree x y nil)) 4.59 + ([context-tree x y context] 4.60 + (some #(if (inside? x y %) 4.61 + (conj (under-cursor context-tree x y %) %)) 4.62 + (context-tree context)))) 4.63 + 4.64 +(defn- remove-all [coll1 coll2 pred] 4.65 + (filter #(not (some (partial pred %) coll2)) coll1)) 4.66 + 4.67 +(defn- translate-mouse-event 4.68 + [#^MouseEvent event x y id] 4.69 + (proxy [MouseEvent] [(.getComponent event) 4.70 + id 4.71 + (.getWhen event) 4.72 + (.getModifiers event) 4.73 + (- (.getX event) x) 4.74 + (- (.getY event) y) 4.75 + (.getClickCount event) 4.76 + (.isPopupTrigger event)] 4.77 + (getXOnScreen [] 4.78 + (.getXOnScreen event)) 4.79 + (getYOnScreen [] 4.80 + (.getYOnScreen event)))) 4.81 + 4.82 +(defn- translate-and-dispatch 4.83 + ([contexts event] 4.84 + (translate-and-dispatch contexts event (.getID event))) 4.85 + ([contexts event id] 4.86 + (doseq [c contexts] 4.87 + (handle-layer-event 4.88 + (:layer c) 4.89 + c 4.90 + (translate-mouse-event event (:x c) (:y c) id))))) 4.91 + 4.92 +(defn- dispatch-mouse-motion* 4.93 + "Dispatches mouse motion events. Returns a new set of contexts which 4.94 + currently are under cursor." 4.95 + [hovered context-tree #^MouseEvent event] 4.96 + (let [x (.getX event) 4.97 + y (.getY event) 4.98 + hovered2 (under-cursor context-tree x y) 4.99 + pred #(= (:layer %1) (:layer %2)) 4.100 + exited (remove-all hovered hovered2 pred) 4.101 + entered (remove-all hovered2 hovered pred) 4.102 + moved (remove-all hovered2 entered pred)] 4.103 + (translate-and-dispatch exited event MouseEvent/MOUSE_EXITED) 4.104 + (translate-and-dispatch entered event MouseEvent/MOUSE_ENTERED) 4.105 + (translate-and-dispatch moved event MouseEvent/MOUSE_MOVED) 4.106 + hovered2)) 4.107 + 4.108 +(defn- dispatch-mouse-motion 4.109 + [hovered-ref context-tree #^MouseEvent event] 4.110 + (dosync 4.111 + (alter hovered-ref dispatch-mouse-motion* context-tree event))) 4.112 + 4.113 +(defn make-event-dispatcher [] 4.114 + (let [context-tree-r (ref {}) ; register 4.115 + context-tree (ref {}) ; dispatch 4.116 + hovered (ref '()) 4.117 + picked (ref '())] 4.118 + (reify 4.119 + EventDispatcher 4.120 + (listen! [this component] 4.121 + (doto component 4.122 + (.addMouseListener this) 4.123 + (.addMouseMotionListener this))) 4.124 + (register [this context] 4.125 + (dosync (alter context-tree-r add-context context))) 4.126 + (commit [this] 4.127 + (dosync (ref-set context-tree @context-tree-r) 4.128 + (ref-set context-tree-r {}))) 4.129 + (picked? [this layer] false) 4.130 + (hovered? [this layer] false) 4.131 + MouseListener 4.132 + (mouseClicked [this event]) 4.133 + (mouseEntered [this event] 4.134 + (dispatch-mouse-motion hovered context-tree event)) 4.135 + (mouseExited [this event] 4.136 + (dispatch-mouse-motion hovered context-tree event)) 4.137 + (mousePressed [this event]) 4.138 + (mouseReleased [this event]) 4.139 + MouseMotionListener 4.140 + (mouseDragged [this event] 4.141 + (translate-and-dispatch @picked event)) 4.142 + (mouseMoved [this event] 4.143 + (dispatch-mouse-motion hovered context-tree event))))) 4.144 +