;;
;; 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]
  (BufferedImage. (:width async-layer) (:height async-layer)
                  BufferedImage/TYPE_INT_ARGB))

(defn- create-buffer [async-layer id]
  (Buffer. id (create-image async-layer) 0 :free))

(defn- find-buffer [buffers & states]
  "Find a buffer with the one of the specified states given
   in the order of preference."
  (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 [buffers @(:buffers al)
         state (:state buffer)
         readers (if (= state :front)
                   (dec (:readers buffer))
                   (:readers buffer))
         state (cond
                (pos? readers) :front
                (= :back (:state buffer)) :fresh
                :default :free)
         buffers
          (if (= state :fresh)
            ;; Change state of all the other buffers from :fresh to :free.
            (reduce replace-buffer buffers 
                    (for [b buffers :when (= (:state b) :fresh)]
                      (assoc b :state :free)))
            buffers)
         buffers (replace-buffer buffers (assoc buffer
                                           :state state
                                           :readers readers))]
     (ref-set (:buffers al) buffers))))
  
(defmacro with-buffer [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 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 (list (create-buffer layer 1)
                               (create-buffer layer 2))]
         (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 in an
   offscreen buffer."
  [content width height]
  (AsyncLayer. content width height
               (ThreadPoolExecutor.
                (int 1) (int 1)
                (long 0) TimeUnit/SECONDS
                (ArrayBlockingQueue. 1)
                (ThreadPoolExecutor$DiscardOldestPolicy.))
               (ref nil)))