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))))