Mercurial > hg > indyvon
view src/indyvon/async.clj @ 172:0394465ce1e2
Correctly specify docstrings for dynamic vars without root bindings.
author | Mikhail Kryshen <mikhail@kryshen.net> |
---|---|
date | Wed, 10 Dec 2014 18:59:20 +0300 |
parents | 0be55d38fe53 |
children | f4b82e358751 |
line wrap: on
line source
;; ;; Copyright 2010-2014 Mikhail Kryshen <mikhail@kryshen.net> ;; ;; This file is part of Indyvon. ;; ;; Indyvon is free software: you can redistribute it and/or modify it ;; under the terms of the GNU Lesser General Public License version 3 ;; only, as published by the Free Software Foundation. ;; ;; Indyvon is distributed in the hope that it will be useful, but ;; WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU ;; Lesser General Public License for more details. ;; ;; You should have received a copy of the GNU Lesser General Public ;; License along with Indyvon. If not, see ;; <http://www.gnu.org/licenses/>. ;; (ns indyvon.async "Asynchronous drawing." (:use indyvon.core) (:import java.awt.GraphicsConfiguration (java.awt Image AlphaComposite Transparency) (java.awt.image BufferedImage) (java.util.concurrent ThreadFactory ThreadPoolExecutor ThreadPoolExecutor$DiscardOldestPolicy ArrayBlockingQueue TimeUnit))) (defrecord Buffer [id image readers state]) ;; Buffer states: ;; :front, readers > 0 ;; being copied on screen ;; :back ;; being rendered to (offscreen) ;; :fresh ;; most recently updated ;; :free ;; not in use (defn- create-image [async-view ^GraphicsConfiguration device-conf] ;; TODO: support different image types. (.createCompatibleImage device-conf (:width async-view) (:height async-view) Transparency/TRANSLUCENT)) (defn- create-buffer [async-view device-conf] (->Buffer (Object.) (create-image async-view device-conf) 0 :free)) (defn- find-buffer "Find a buffer with the one of the specified states given in the order of preference." [buffers & states] (some identity (for [state states] (some #(if (= (:state %) state) % nil) buffers)))) (defn- replace-buffer [buffers buffer] (conj (remove #(= (:id %) (:id buffer)) buffers) buffer)) (defn- take-buffer [al type] (dosync (let [buffers @(:buffers al) b (case type :front (find-buffer buffers :front :fresh :free) :back (find-buffer buffers :free :fresh) (throw (IllegalArgumentException.))) readers (if (= type :front) (inc (:readers b)) (:readers b)) b (assoc b :state type :readers readers)] (alter (:buffers al) replace-buffer b) b))) (defn- release-buffer [al buffer] (dosync (let [state (:state buffer) readers (if (= state :front) (dec (:readers buffer)) (:readers buffer)) fresh (delay (find-buffer @(:buffers al) :fresh)) state (cond (pos? readers) :front (= :back state) :fresh @fresh :free :default :fresh)] (when (and (= state :fresh) @fresh) ;; Change state of the previously fresh buffer to :free. (alter (:buffers al) replace-buffer (assoc @fresh :state :free))) (alter (:buffers al) replace-buffer (assoc buffer :state state :readers readers))))) (defmacro with-buffer {:private true} [al type [name] & body] `(let [al# ~al ~name (take-buffer al# ~type)] (try ~@body (finally (release-buffer al# ~name))))) (defn- draw-offscreen [async-view] ;;(Thread/sleep 1000) (with-buffer async-view :back [b] (let [g (.createGraphics ^BufferedImage (:image b))] ;; Clear the buffer. (.setComposite g AlphaComposite/Clear) (.fillRect g 0 0 (:width async-view) (:height async-view)) (.setComposite g AlphaComposite/Src) (draw-scene! (:scene async-view) g (:width async-view) (:height async-view)))) (update async-view)) (defn- draw-offscreen-async [async-view] (.execute ^ThreadPoolExecutor (:executor async-view) (bound-fn* #(draw-offscreen async-view)))) (defrecord AsyncView [scene width height executor buffers] View (render! [view] (repaint-on-update view) (add-context-observer scene (bound-fn [_ _] (draw-offscreen-async view))) (when-not @buffers ;; TODO: dynamic size, recreate buffers when size increases. (let [device-conf (.getDeviceConfiguration *graphics*) new-buffers (repeatedly 2 (partial create-buffer view device-conf))] (dosync (ref-set buffers new-buffers))) (draw-offscreen-async view)) (with-buffer view :front [b] (.drawImage *graphics* ^Image (:image b) 0 0 nil))) (geometry [view] (->Size width height))) (defn- create-thread-factory [priority] (reify ThreadFactory (newThread [_ runnable] (let [thread (Thread. runnable)] (when priority (.setPriority thread priority)) (.setDaemon thread true) thread)))) (defn- create-executor [priority] (doto (ThreadPoolExecutor. (int 1) (int 1) (long 0) TimeUnit/SECONDS (ArrayBlockingQueue. 1) (ThreadPoolExecutor$DiscardOldestPolicy.)) (.setThreadFactory (create-thread-factory priority)))) (defn async-view "Creates a View that draws the content asynchronously using an offscreen buffer." ([width height content] (async-view width height nil content)) ([width height priority content] ;; TODO: use operational event dispatcher. (->AsyncView (make-scene content) width height (create-executor priority) (ref nil))))