Mercurial > hg > indyvon
view src/indyvon/async.clj @ 186:bf1f63968d85 default tip
Updated dependencies.
author | Mikhail Kryshen <mikhail@kryshen.net> |
---|---|
date | Wed, 25 Apr 2018 10:26:01 +0300 |
parents | f0f11db714f8 |
children |
line wrap: on
line source
;; ;; Copyright 2010-2015 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 Buffers [;; BufferedImage for copying on screen. front ;; Number of processes using the front buffer. front-readers ;; BufferedImage used for asynchronous drawing. back ;; True after drawing to the back buffer is finished. back-ready ;; True after the buffers were flipped, ;; indicates that AsyncView needs to be redrawn. flipped ;; Used to synchronize initialization of the buffers. new]) (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-buffers [async-view device-conf] (->Buffers (create-image async-view device-conf) 0 (create-image async-view device-conf) false false true)) (defn- maybe-flip [buffers] (if (and (:back-ready buffers) (zero? (:front-readers buffers))) (assoc buffers :front (:back buffers) :back (:front buffers) :back-ready false :flipped true) (assoc buffers :flipped false))) (defn- apply-flip [buffers f & args] (maybe-flip (apply f buffers args))) (defn- take-front! [av] (-> (:buffers av) (swap! update-in [:front-readers] inc) :front)) (defn- release-front! [av] (when (-> (:buffers av) (swap! apply-flip update-in [:front-readers] dec) :flipped) (notify! av))) (defn- take-back! [av] (-> (:buffers av) (swap! assoc :back-ready false) :back)) (defn- release-back! [av] (when (-> (:buffers av) (swap! apply-flip assoc :back-ready true) :flipped) (notify! av))) (defn- draw-offscreen! [async-view] ;;(Thread/sleep 1000) (let [b (take-back! async-view) g (.createGraphics ^BufferedImage 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)) ;; Will not be called if an exception is thrown in the code above. (release-back! async-view))) (defn- pool-execute! [async-view f] (.execute ^ThreadPoolExecutor (:executor async-view) f)) (defn- ensure-buffers! [async-view device-conf] (let [buffers (:buffers async-view)] (when (and (not @buffers) (:new (swap! buffers #(if % (assoc % :new false) (create-buffers async-view device-conf))))) (let [bound-draw! (bound-fn* draw-offscreen!) async-draw! #(pool-execute! % (partial bound-draw! %))] (add-observer! async-view (:scene async-view) ;; Must not hold onto async-view. (fn [a _] (async-draw! a))) (async-draw! async-view))))) (defrecord AsyncView [scene width height executor buffers] View (render! [view] (let [g *graphics*] (ensure-buffers! view (.getDeviceConfiguration g)) (let [^Image b (take-front! view)] (try (.drawImage g b 0 0 nil) (finally (release-front! view)))) (repaint-on-update! view))) (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) (atom nil))))