view src/net/kryshen/indyvon/async.clj @ 68:9b511fe09867

Code cleanup, docstrings.
author Mikhail Kryshen <mikhail@kryshen.net>
date Sun, 29 Aug 2010 03:59:10 +0400
parents a19cf5007d14
children a823dd0c2736
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]
  ;; TODO: support different image types.
  (BufferedImage. (:width async-layer) (:height async-layer)
                  BufferedImage/TYPE_INT_ARGB_PRE))

(defn- create-buffer [async-layer]
  (Buffer. (Object.) (create-image async-layer) 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))
         state (cond
                (pos? readers) :front
                (= :back (:state buffer)) :fresh
                :default :free)]
     (when (= state :fresh)
       ;; Change state of the prefiously fresh buffer to :free.
       (when-let [fresh (find-buffer @(:buffers al) :fresh)]
         (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-layer]
  ;;(Thread/sleep 1000)
  (with-buffer async-layer :back [b]
    (draw-root! (:content async-layer)
                (.getGraphics ^Image (: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 (repeatedly 2 (partial create-buffer layer))]
         (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 using
   offscreen buffer."
  [content width height]
  (AsyncLayer. content width height
               (ThreadPoolExecutor.
                (int 1) (int 1)
                (long 0) TimeUnit/SECONDS
                (ArrayBlockingQueue. 1)
                (ThreadPoolExecutor$DiscardOldestPolicy.))
               (ref nil)))