Mercurial > hg > indyvon

view src/net/kryshen/indyvon/async.clj @ 81:5d2153e8a28d

find changesets by author, revision, files, or words in the commit message
Code cleanup.
author Mikhail Kryshen <mikhail@kryshen.net>
date Thu, 02 Sep 2010 03:55:44 +0400
parents a823dd0c2736
children 9a69db231531
line source
1 ;;
2 ;; Copyright 2010 Mikhail Kryshen <mikhail@kryshen.net>
3 ;;
4 ;; This file is part of Indyvon.
5 ;;
6 ;; Indyvon is free software: you can redistribute it and/or modify it
7 ;; under the terms of the GNU Lesser General Public License version 3
8 ;; only, as published by the Free Software Foundation.
9 ;;
10 ;; Indyvon is distributed in the hope that it will be useful, but
11 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
12 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
13 ;; Lesser General Public License for more details.
14 ;;
15 ;; You should have received a copy of the GNU Lesser General Public
16 ;; License along with Indyvon. If not, see
17 ;; <http://www.gnu.org/licenses/>.
18 ;;
19
20 (ns net.kryshen.indyvon.async
21 "Asynchronous drawing."
22 (:use
23 net.kryshen.indyvon.core)
24 (:import
25 (net.kryshen.indyvon.core Size Location)
26 (java.awt Image)
27 (java.awt.image BufferedImage)
28 (java.util.concurrent ThreadPoolExecutor
29 ThreadPoolExecutor$DiscardOldestPolicy
30 ArrayBlockingQueue TimeUnit)))
31
32 (defrecord Buffer [id image readers state])
33 ;; Buffer states:
34 ;; :front, readers > 0
35 ;; being copied on screen
36 ;; :back
37 ;; being rendered to (offscreen)
38 ;; :fresh
39 ;; offscreen rendering finished
40 ;; :free
41 ;; not in use
42
43 (defn- create-image [async-layer]
44 ;; TODO: support different image types.
45 (BufferedImage. (:width async-layer) (:height async-layer)
46 BufferedImage/TYPE_INT_ARGB_PRE))
47
48 (defn- create-buffer [async-layer]
49 (Buffer. (Object.) (create-image async-layer) 0 :free))
50
51 (defn- find-buffer
52 "Find a buffer with the one of the specified states given
53 in the order of preference."
54 [buffers & states]
55 (some identity
56 (for [state states]
57 (some #(if (= (:state %) state) % nil) buffers))))
58
59 (defn- replace-buffer [buffers buffer]
60 (conj (remove #(= (:id %) (:id buffer)) buffers)
61 buffer))
62
63 (defn- take-buffer [al type]
64 (dosync
65 (let [buffers @(:buffers al)
66 b (case type
67 :front (find-buffer buffers :front :fresh :free)
68 :back (find-buffer buffers :free :fresh)
69 (throw (IllegalArgumentException.)))
70 readers (if (= type :front)
71 (inc (:readers b))
72 (:readers b))
73 b (assoc b
74 :state type
75 :readers readers)]
76 (alter (:buffers al) replace-buffer b)
77 b)))
78
79 (defn- release-buffer [al buffer]
80 (dosync
81 (let [state (:state buffer)
82 readers (if (= state :front)
83 (dec (:readers buffer))
84 (:readers buffer))
85 state (cond
86 (pos? readers) :front
87 (= :back (:state buffer)) :fresh
88 :default :free)]
89 (when (= state :fresh)
90 ;; Change state of the prefiously fresh buffer to :free.
91 (when-let [fresh (find-buffer @(:buffers al) :fresh)]
92 (alter (:buffers al) replace-buffer (assoc fresh
93 :state :free))))
94 (alter (:buffers al) replace-buffer (assoc buffer
95 :state state
96 :readers readers)))))
97
98 (defmacro with-buffer
99 {:private true}
100 [al type [name] & body]
101 `(let [al# ~al
102 ~name (take-buffer al# ~type)]
103 (try
104 ~@body
105 (finally
106 (release-buffer al# ~name)))))
107
108 (defn- draw-offscreen [async-layer]
109 ;;(Thread/sleep 1000)
110 (with-buffer async-layer :back [b]
111 (draw-root! (:content async-layer)
112 (.getGraphics ^Image (:image b))
113 (:width async-layer)
114 (:height async-layer)
115 ;; TODO: use operational event dispatcher.
116 dummy-event-dispatcher))
117 (update async-layer))
118
119 (defn- draw-offscreen-async [async-layer]
120 (.execute ^ThreadPoolExecutor (:executor async-layer)
121 #(draw-offscreen async-layer)))
122
123 (defrecord AsyncLayer [content width height executor buffers]
124 Layer
125 (render! [layer]
126 (repaint-on-update layer)
127 (add-context-observer content (fn [_] (draw-offscreen-async layer)))
128 (when-not @buffers
129 ;; TODO: dynamic size, recreate buffers when size increases.
130 (let [new-buffers (repeatedly 2 (partial create-buffer layer))]
131 (dosync
132 (ref-set buffers new-buffers)))
133 (draw-offscreen-async layer))
134 (with-buffer layer :front [b]
135 (.drawImage *graphics* ^Image (:image b) 0 0 nil)))
136 (layer-size [layer]
137 (Size. width height)))
138
139 (defn async-layer
140 "Creates layer that draws the content asynchronously using
141 offscreen buffer."
142 [content width height]
143 (AsyncLayer. content width height
144 (ThreadPoolExecutor.
145 (int 1) (int 1)
146 (long 0) TimeUnit/SECONDS
147 (ArrayBlockingQueue. 1)
148 (ThreadPoolExecutor$DiscardOldestPolicy.))
149 (ref nil)))