1.1 --- a/src/indyvon/async.clj	Wed Dec 10 19:00:17 2014 +0300
     1.2 +++ b/src/indyvon/async.clj	Wed Dec 10 20:01:45 2014 +0300
     1.3 @@ -29,16 +29,19 @@
     1.4                           ThreadPoolExecutor$DiscardOldestPolicy
     1.5                           ArrayBlockingQueue TimeUnit)))
     1.6  
     1.7 -(defrecord Buffer [id image readers state])
     1.8 -;; Buffer states:
     1.9 -;;   :front, readers > 0
    1.10 -;;      being copied on screen
    1.11 -;;   :back
    1.12 -;;      being rendered to (offscreen)
    1.13 -;;   :fresh
    1.14 -;;      most recently updated
    1.15 -;;   :free
    1.16 -;;      not in use
    1.17 +(defrecord Buffers [;; BufferedImage for copying on screen.
    1.18 +                    front
    1.19 +                    ;; Number of processes using the front buffer.
    1.20 +                    front-readers 
    1.21 +                    ;; BufferedImage used for asynchronous drawing.
    1.22 +                    back
    1.23 +                    ;; True after drawing to the back buffer is finished.
    1.24 +                    back-ready
    1.25 +                    ;; True after the buffers were flipped,
    1.26 +                    ;; indicates that AsyncView needs to be redrawn.
    1.27 +                    flipped
    1.28 +                    ;; Used to synchronize initialization of the buffers.
    1.29 +                    new])
    1.30  
    1.31  (defn- create-image [async-view ^GraphicsConfiguration device-conf]
    1.32    ;; TODO: support different image types.
    1.33 @@ -47,103 +50,94 @@
    1.34                            (:height async-view)
    1.35                            Transparency/TRANSLUCENT))
    1.36  
    1.37 -(defn- create-buffer [async-view device-conf]
    1.38 -  (->Buffer (Object.) (create-image async-view device-conf) 0 :free))
    1.39 +(defn- create-buffers [async-view device-conf]
    1.40 +  (->Buffers (create-image async-view device-conf)
    1.41 +             0
    1.42 +             (create-image async-view device-conf)
    1.43 +             false
    1.44 +             false
    1.45 +             true))
    1.46  
    1.47 -(defn- find-buffer
    1.48 -  "Find a buffer with the one of the specified states given
    1.49 -   in the order of preference."
    1.50 -  [buffers & states]
    1.51 -  (some identity
    1.52 -        (for [state states]
    1.53 -          (some #(if (= (:state %) state) % nil) buffers))))
    1.54 +(defn- maybe-flip [buffers]
    1.55 +  (if (and (:back-ready buffers)
    1.56 +           (zero? (:front-readers buffers)))
    1.57 +    (assoc buffers
    1.58 +      :front (:back buffers)
    1.59 +      :back (:front buffers)
    1.60 +      :back-ready false
    1.61 +      :flipped true)
    1.62 +    (assoc buffers
    1.63 +      :flipped false)))
    1.64  
    1.65 -(defn- replace-buffer [buffers buffer]
    1.66 -  (conj (remove #(= (:id %) (:id buffer)) buffers)
    1.67 -        buffer))
    1.68 +(defn- apply-flip [buffers f & args]
    1.69 +  (maybe-flip (apply f buffers args)))
    1.70  
    1.71 -(defn- take-buffer [al type]
    1.72 -  (dosync
    1.73 -   (let [buffers @(:buffers al)
    1.74 -         b (case type
    1.75 -             :front (find-buffer buffers :front :fresh :free)
    1.76 -             :back (find-buffer buffers :free :fresh)
    1.77 -             (throw (IllegalArgumentException.)))
    1.78 -         readers (if (= type :front)
    1.79 -                   (inc (:readers b))
    1.80 -                   (:readers b))
    1.81 -         b (assoc b
    1.82 -             :state type
    1.83 -             :readers readers)]
    1.84 -     (alter (:buffers al) replace-buffer b)
    1.85 -     b)))
    1.86 +(defn- take-front! [av]
    1.87 +  (-> (:buffers av)
    1.88 +      (swap! update-in [:front-readers] inc)
    1.89 +      :front))
    1.90  
    1.91 -(defn- release-buffer [al buffer]
    1.92 -  (dosync
    1.93 -   (let [state (:state buffer)
    1.94 -         readers (if (= state :front)
    1.95 -                   (dec (:readers buffer))
    1.96 -                   (:readers buffer))
    1.97 -         fresh (delay (find-buffer @(:buffers al) :fresh))
    1.98 -         state (cond
    1.99 -                (pos? readers) :front
   1.100 -                (= :back state) :fresh
   1.101 -                @fresh :free
   1.102 -                :default :fresh)]
   1.103 -     (when (and (= state :fresh) @fresh)
   1.104 -       ;; Change state of the previously fresh buffer to :free.
   1.105 -       (alter (:buffers al)
   1.106 -              replace-buffer (assoc @fresh
   1.107 -                               :state :free)))
   1.108 -     (alter (:buffers al)
   1.109 -            replace-buffer (assoc buffer
   1.110 -                             :state state
   1.111 -                             :readers readers)))))
   1.112 +(defn- release-front! [av]
   1.113 +  (when (-> (:buffers av)
   1.114 +            (swap! apply-flip update-in [:front-readers] dec)
   1.115 +            :flipped)
   1.116 +    (update av)))
   1.117  
   1.118 -(defmacro with-buffer
   1.119 -  {:private true}
   1.120 -  [al type [name] & body]
   1.121 -  `(let [al# ~al
   1.122 -         ~name (take-buffer al# ~type)]
   1.123 -     (try
   1.124 -       ~@body
   1.125 -       (finally
   1.126 -        (release-buffer al# ~name)))))
   1.127 +(defn- take-back! [av]
   1.128 +  (-> (:buffers av)
   1.129 +      (swap! assoc :back-ready false)
   1.130 +      :back))
   1.131  
   1.132 -(defn- draw-offscreen [async-view]
   1.133 +(defn- release-back! [av]
   1.134 +  (when (-> (:buffers av)
   1.135 +            (swap! apply-flip assoc :back-ready true)
   1.136 +            :flipped)
   1.137 +    (update av)))
   1.138 +
   1.139 +(defn- draw-offscreen! [async-view]
   1.140    ;;(Thread/sleep 1000)
   1.141 -  (with-buffer async-view :back [b]
   1.142 -    (let [g (.createGraphics ^BufferedImage (:image b))]
   1.143 -      ;; Clear the buffer.
   1.144 -      (.setComposite g AlphaComposite/Clear)
   1.145 -      (.fillRect g 0 0 (:width async-view) (:height async-view))
   1.146 -      (.setComposite g AlphaComposite/Src)
   1.147 -      (draw-scene! (:scene async-view)
   1.148 -                   g
   1.149 -                   (:width async-view)
   1.150 -                   (:height async-view))))
   1.151 -  (update async-view))
   1.152 +  (let [b (take-back! async-view)
   1.153 +        g (.createGraphics ^BufferedImage b)]
   1.154 +    ;; Clear the buffer.
   1.155 +    (.setComposite g AlphaComposite/Clear)
   1.156 +    (.fillRect g 0 0 (:width async-view) (:height async-view))
   1.157 +    (.setComposite g AlphaComposite/Src)
   1.158 +    (draw-scene! (:scene async-view)
   1.159 +                 g
   1.160 +                 (:width async-view)
   1.161 +                 (:height async-view))
   1.162 +    ;; Will not be called if an exception is thrown in the code above.
   1.163 +    (release-back! async-view)))
   1.164  
   1.165 -(defn- draw-offscreen-async [async-view]
   1.166 -  (.execute ^ThreadPoolExecutor (:executor async-view)
   1.167 -            (bound-fn* #(draw-offscreen async-view))))
   1.168 +(defn- pool-execute! [async-view f]
   1.169 +  (.execute ^ThreadPoolExecutor (:executor async-view) f))
   1.170 +
   1.171 +(defn- ensure-buffers! [async-view device-conf]
   1.172 +  (let [buffers (:buffers async-view)]
   1.173 +    (when (and (not @buffers)
   1.174 +               (:new (swap! buffers
   1.175 +                            #(if %
   1.176 +                               (assoc % :new false)
   1.177 +                               (create-buffers async-view device-conf)))))
   1.178 +      (let [bound-draw! (bound-fn* draw-offscreen!)
   1.179 +            async-draw! #(pool-execute! % (partial bound-draw! %))]
   1.180 +        (add-observer async-view
   1.181 +                      (:scene async-view)
   1.182 +                      ;; Must not hold onto async-view.
   1.183 +                      (fn [a _] (async-draw! a)))
   1.184 +        (async-draw! async-view)))))
   1.185  
   1.186  (defrecord AsyncView [scene width height executor buffers]
   1.187    View
   1.188    (render! [view]
   1.189 -    (repaint-on-update view)
   1.190 -    (add-context-observer scene (bound-fn [_ _]
   1.191 -                                  (draw-offscreen-async view)))
   1.192 -    (when-not @buffers
   1.193 -      ;; TODO: dynamic size, recreate buffers when size increases.
   1.194 -      (let [device-conf (.getDeviceConfiguration *graphics*)
   1.195 -            new-buffers (repeatedly 2
   1.196 -                          (partial create-buffer view device-conf))]
   1.197 -        (dosync
   1.198 -         (ref-set buffers new-buffers)))
   1.199 -      (draw-offscreen-async view))
   1.200 -    (with-buffer view :front [b]
   1.201 -      (.drawImage *graphics* ^Image (:image b) 0 0 nil)))
   1.202 +    (let [g *graphics*]
   1.203 +      (ensure-buffers! view (.getDeviceConfiguration g))
   1.204 +      (let [^Image b (take-front! view)]
   1.205 +        (try
   1.206 +          (.drawImage g b 0 0 nil)
   1.207 +          (finally
   1.208 +            (release-front! view))))
   1.209 +      (repaint-on-update view)))
   1.210    (geometry [view]
   1.211      (->Size width height)))
   1.212  
   1.213 @@ -167,13 +161,13 @@
   1.214  
   1.215  (defn async-view 
   1.216    "Creates a View that draws the content asynchronously using an
   1.217 -   offscreen buffer."
   1.218 +  offscreen buffer."
   1.219    ([width height content]
   1.220 -     (async-view width height nil content))
   1.221 +   (async-view width height nil content))
   1.222    ([width height priority content]
   1.223 -     ;; TODO: use operational event dispatcher.
   1.224 -     (->AsyncView (make-scene content)
   1.225 -                  width
   1.226 -                  height
   1.227 -                  (create-executor priority)
   1.228 -                  (ref nil))))
   1.229 +   ;; TODO: use operational event dispatcher.
   1.230 +   (->AsyncView (make-scene content)
   1.231 +                width
   1.232 +                height
   1.233 +                (create-executor priority)
   1.234 +                (atom nil))))