Mercurial > hg > indyvon
view src/net/kryshen/indyvon/async.clj @ 67:a19cf5007d14
Asynchronous drawing.
author | Mikhail Kryshen <mikhail@kryshen.net> |
---|---|
date | Sat, 28 Aug 2010 02:37:30 +0400 |
parents | |
children | 9b511fe09867 |
line wrap: on
line source
;; ;; Copyright (C) 2010 Mikhail Kryshen <mikhail@kryshen.net> ;; ;; This file is part of Indyvon. ;; (ns net.kryshen.indyvon.async "Asynchronous drawing." (:use net.kryshen.indyvon.core) (:import (net.kryshen.indyvon.core Size Location) (java.awt Image) (java.awt.image BufferedImage) (java.util.concurrent 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 ;; offscreen rendering finished ;; :free ;; not in use (defn- create-image [async-layer] (BufferedImage. (:width async-layer) (:height async-layer) BufferedImage/TYPE_INT_ARGB)) (defn- create-buffer [async-layer id] (Buffer. id (create-image async-layer) 0 :free)) (defn- find-buffer [buffers & states] "Find a buffer with the one of the specified states given in the order of preference." (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 [buffers @(:buffers al) state (:state buffer) readers (if (= state :front) (dec (:readers buffer)) (:readers buffer)) state (cond (pos? readers) :front (= :back (:state buffer)) :fresh :default :free) buffers (if (= state :fresh) ;; Change state of all the other buffers from :fresh to :free. (reduce replace-buffer buffers (for [b buffers :when (= (:state b) :fresh)] (assoc b :state :free))) buffers) buffers (replace-buffer buffers (assoc buffer :state state :readers readers))] (ref-set (:buffers al) buffers)))) (defmacro with-buffer [al type [name] & body] `(let [al# ~al ~name (take-buffer al# ~type)] (try ~@body (finally (release-buffer al# ~name))))) (defn- draw-offscreen [async-layer] ;;(Thread/sleep 1000) (with-buffer async-layer :back [b] (draw-root! (:content async-layer) (.getGraphics (:image b)) (:width async-layer) (:height async-layer) dummy-event-dispatcher)) (update async-layer)) (defn- draw-offscreen-async [async-layer] (.execute ^ThreadPoolExecutor (:executor async-layer) #(draw-offscreen async-layer))) (defrecord AsyncLayer [content width height executor buffers] Layer (render! [layer] (repaint-on-update layer) (add-context-observer content (fn [_] (draw-offscreen-async layer))) (when-not @buffers ;; TODO: dynamic size, recreate buffers when size increases. (let [new-buffers (list (create-buffer layer 1) (create-buffer layer 2))] (dosync (ref-set buffers new-buffers))) (draw-offscreen-async layer)) (with-buffer layer :front [b] (.drawImage *graphics* ^Image (:image b) 0 0 nil))) (layer-size [layer] (Size. width height))) (defn async-layer "Creates layer that draws the content asynchronously in an offscreen buffer." [content width height] (AsyncLayer. content width height (ThreadPoolExecutor. (int 1) (int 1) (long 0) TimeUnit/SECONDS (ArrayBlockingQueue. 1) (ThreadPoolExecutor$DiscardOldestPolicy.)) (ref nil)))