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