Mercurial > hg > indyvon

view src/indyvon/core.clj @ 5:74f1f265c3d9

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