Mercurial > hg > indyvon

view src/indyvon/core.clj @ 4:0771180bf7c2

find changesets by author, revision, files, or words in the commit message
Abandoned approach at event dispatching.
author Mikhail Kryshen <mikhail@kryshen.net>
date Thu, 10 Jun 2010 02:54:35 +0400
parents 6bc931b1b755
children 74f1f265c3d9
line source
1 (ns indyvon.core
2 (:import (java.awt Dimension Point Component Graphics2D AWTEvent)
3 (java.awt.event MouseAdapter MouseMotionAdapter
4 MouseListener MouseMotionListener)))
5
6 (def ^{:private true} *rx* 0)
7 (def ^{:private true} *ry* 0)
8
9 (def *graphics*)
10
11 (def *width*)
12 (def *height*)
13
14 (def *lag*)
15
16 (def *update-fn*)
17
18 (defprotocol Layer
19 (render! [this])
20 (size [this])
21 (anchor [this]))
22
23 (defmacro reify-layer [& fns]
24 (let [method-map {'size [['_] [0 0]]
25 'anchor [['_] [0 0]]}
26 method-map (loop [fns fns
27 mm method-map]
28 (if-let [form (first fns)]
29 (recur (next fns)
30 (conj mm [(first form) (next form)]))
31 mm))
32 methods (for [m method-map]
33 (cons (first m) (second m)))]
34 `(reify Layer ~@methods)))
35
36 (defn- make-graphics [g x y w h clip]
37 (if clip
38 (.create g x y w h)
39 (doto (.create g)
40 (.translate x y))))
41
42 (defn render-layer!
43 "Render layer in a new graphics context."
44 ([layer]
45 (render-layer! layer 0 0 *width* *height*))
46 ([layer x y]
47 (render-layer! layer x y true))
48 ([layer x y clip]
49 (let [s (size layer)]
50 (render-layer! layer x y (.width s) (.height s) clip)))
51 ([layer x y w h]
52 (render-layer! layer x y w h true))
53 ([layer x y w h clip]
54 (binding [*graphics* (make-graphics *graphics* x y w h clip)
55 *rx* (+ *rx* x)
56 *ry* (+ *ry* y)
57 *width* w
58 *height* h]
59 (render! layer))))
60
61 ;;
62 ;; Event handling
63 ;;
64
65 (defmulti handle-layer-event
66 (fn [layer event]
67 [layer (.getID event)]))
68
69 (defmethod handle-layer-event :default [layer event]
70 false)
71
72 (defprotocol EventDispatcher
73 (register [this layer])
74 (commit [this])
75 (dispatch [this event]))
76
77 ;;(defrecord LayerContextState [hovered contexts])
78
79 (defrecord LayerContext [layer rx ry width height update-fn])
80
81 ;; LayerContext сам реализует EventDispatcher.
82 ;; Дерево диспетчеров-контекстов.
83 ;; Передача события от корня.
84
85 (defn make-event-dispatcher []
86 (let [contexts-r (ref []) ; register
87 contexts (ref []) ; dispatch
88 hovered (ref [])
89 picked (ref [])]
90 (reify
91 EventDispatcher
92 (register [this layer]
93 (dosync
94 (alter contexts-r conj
95 (LayerContext. layer *rx* *ry*
96 *width* *height*
97 *update-fn*))))
98 (commit [this]
99 (dosync (ref-set contexts @contexts-r)
100 (ref-set contexts-r [])))
101 (dispatch [this event]
102 (println "dispatch" this event)
103 ;; TODO
104 )
105 MouseListener
106 (mouseClicked [this event])
107 (mouseEntered [this event])
108 (mouseExited [this event])
109 (mousePressed [this event])
110 (mouseReleased [this event])
111 MouseMotionListener
112 (mouseDragged [this event])
113 (mouseMoved [this event]))))
114
115 ;;
116 ;; Connection to AWT.
117 ;;
118
119 (defn- make-update-fn [component]
120 (fn [] (.repaint component)))
121
122 ;; (defn make-component [layer]
123 ;; (proxy [Component] []
124 ;; (update [g] (.paint this g))
125 ;; (paint [g]
126 ;; (let [insets (.getInsets this)
127 ;; top (.top insets)
128 ;; left (.left insets)
129 ;; bottom (.bottom insets)
130 ;; right (.right insets)
131 ;; size (.getSize this)
132 ;; width (- (.width size) left right)
133 ;; height (- (.height size) top bottom)]
134 ;; (binding [*graphics* g
135 ;; *update-fn* (make-update-fn this)]
136 ;; (render-layer! layer top left width height false))))
137 ;; (getPreferredSize []
138 ;; (size layer))))
139
140 (defn make-component
141 ([layer]
142 (make-component layer (make-event-dispatcher)))
143 ([layer event-dispatcher]
144 (doto
145 (proxy [Component] []
146 (update [g] (.paint this g))
147 (paint [g]
148 (let [size (.getSize this)
149 width (.width size)
150 height (.height size)]
151 (binding [*graphics* g
152 *update-fn* (make-update-fn this)]
153 (render-layer! layer 0 0 width height false))))
154 (getPreferredSize []
155 (let [s (size layer)]
156 (Dimension. (s 0) (s 1))))
157 (processEvent [event]
158 (dispatch event-dispatcher event)))
159 ;; No way to call protected final evenbleEvents even in gen-class,
160 ;; have to use the following hack:
161 (.addMouseListener (proxy [MouseAdapter] []))
162 (.addMouseMotionListener (proxy [MouseMotionAdapter] [])))))
163
164 (comment
165 (do
166 (def frame (java.awt.Frame. "Test"))
167 (def layer
168 (reify-layer
169 (render! [this]
170 (.fillRect *graphics* 10 10 40 40))
171 (size [this] [100 100])))
172 (doto frame
173 (.addWindowListener
174 (proxy [java.awt.event.WindowAdapter] []
175 (windowClosing [event] (.dispose frame))))
176 (.add (make-component layer))
177 (.pack)
178 (.setVisible true))
179 )
180 )