Mercurial > hg > indyvon

view src/indyvon/core.clj @ 3:6bc931b1b755

find changesets by author, revision, files, or words in the commit message
Event processing.
author Mikhail Kryshen <mikhail@kryshen.net>
date Tue, 08 Jun 2010 15:24:45 +0400
parents 0f2a98f71a9c
children 0771180bf7c2
line source
1 (ns indyvon.core
2 (:import (java.awt Dimension Point Component Graphics2D AWTEvent)))
3
4 (def ^{:private true} *rx* 0)
5 (def ^{:private true} *ry* 0)
6
7 (def *graphics*)
8
9 (def *width*)
10 (def *height*)
11
12 (def *lag*)
13
14 (def *update-fn*)
15
16 (defprotocol Layer
17 (render! [this])
18 (size [this])
19 (anchor [this]))
20
21 (defmacro reify-layer [& fns]
22 (let [method-map {'size [['_] [0 0]]
23 'anchor [['_] [0 0]]}
24 method-map (loop [fns fns
25 mm method-map]
26 (if-let [form (first fns)]
27 (recur (next fns)
28 (conj mm [(first form) (next form)]))
29 mm))
30 methods (for [m method-map]
31 (cons (first m) (second m)))]
32 `(reify Layer ~@methods)))
33
34 (defn- make-graphics [g x y w h clip]
35 (if clip
36 (.create g x y w h)
37 (doto (.create g)
38 (.translate x y))))
39
40 (defn render-layer!
41 "Render layer in a new graphics context."
42 ([layer]
43 (render-layer! layer 0 0 *width* *height*))
44 ([layer x y]
45 (render-layer! layer x y true))
46 ([layer x y clip]
47 (let [s (size layer)]
48 (render-layer! layer x y (.width s) (.height s) clip)))
49 ([layer x y w h]
50 (render-layer! layer x y w h true))
51 ([layer x y w h clip]
52 (binding [*graphics* (make-graphics *graphics* x y w h clip)
53 *rx* (+ *rx* x)
54 *ry* (+ *ry* y)
55 *width* w
56 *height* h]
57 (render! layer))))
58
59 ;;
60 ;; Event handling
61 ;;
62
63 (defmulti handle-layer-event
64 (fn [layer event]
65 [layer (.getID event)]))
66
67 (defmethod handle-layer-event :default [layer event])
68
69 (defprotocol EventDispatcher
70 (register [this layer])
71 (commit [this])
72 (dispatch [this event]))
73
74 (defrecord LayerContext [layer rx ry width height update-fn])
75
76 (defn make-event-dispatcher []
77 (let [contexts-r (ref [])
78 contexts-d (ref [])]
79 (reify
80 EventDispatcher
81 (register [this layer]
82 (dosync
83 (alter contexts-r conj
84 (LayerContext. layer *rx* *ry*
85 *width* *height*
86 *update-fn*))))
87 (commit [this]
88 (dosync (ref-set contexts-d @contexts-r)
89 (ref-set contexts-r [])))
90 (dispatch [this event]
91 (println "dispatch" this event)
92 ;; TODO
93 ))))
94
95 ;;
96 ;; Connection to AWT.
97 ;;
98
99 (defn- make-update-fn [component]
100 (fn [] (.repaint component)))
101
102 ;; (defn make-component [layer]
103 ;; (proxy [Component] []
104 ;; (update [g] (.paint this g))
105 ;; (paint [g]
106 ;; (let [insets (.getInsets this)
107 ;; top (.top insets)
108 ;; left (.left insets)
109 ;; bottom (.bottom insets)
110 ;; right (.right insets)
111 ;; size (.getSize this)
112 ;; width (- (.width size) left right)
113 ;; height (- (.height size) top bottom)]
114 ;; (binding [*graphics* g
115 ;; *update-fn* (make-update-fn this)]
116 ;; (render-layer! layer top left width height false))))
117 ;; (getPreferredSize []
118 ;; (size layer))))
119
120 (defn make-component
121 ([layer]
122 (make-component layer (make-event-dispatcher)))
123 ([layer event-dispatcher]
124 (proxy [Component] []
125 (update [g] (.paint this g))
126 (paint [g]
127 (let [size (.getSize this)
128 width (.width size)
129 height (.height size)]
130 (binding [*graphics* g
131 *update-fn* (make-update-fn this)]
132 (render-layer! layer 0 0 width height false))))
133 (getPreferredSize []
134 (let [s (size layer)]
135 (Dimension. (s 0) (s 1))))
136 (processEvent [event]
137 (dispatch event-dispatcher event)))))
138
139 (comment
140 (do
141 (def frame (java.awt.Frame. "Test"))
142 (def layer
143 (reify-layer
144 (render! [this]
145 (.fillRect *graphics* 10 10 40 40))
146 (size [this] [100 100])))
147 (doto frame
148 (.addWindowListener
149 (proxy [java.awt.event.WindowAdapter] []
150 (windowClosing [event] (.dispose frame))))
151 (.add (make-component layer))
152 (.pack)
153 (.setVisible true))
154 )
155 )