;;
;; Copyright 2010 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 net.kryshen.indyvon.layers
  "Implementations of Layer protocol."
  (:use
   (net.kryshen.indyvon core async))
  (:import
   (net.kryshen.indyvon.core Size Location)
   (java.lang.ref SoftReference)
   (java.awt Font Cursor Image Toolkit)
   (java.awt.image ImageObserver)
   (java.awt.font FontRenderContext TextLayout)))
  
;; Define as macro to avoid unnecessary calculation of inner and outer
;; sizes in the first case.
(defmacro align-xy [inner outer align first center last]
  `(case ~align
         ~first 0
         ~center (/ (- ~outer ~inner) 2)
         ~last (- ~outer ~inner)))

(defmacro align-x [inner outer align]
  `(align-xy ~inner ~outer ~align :left :center :right))

(defmacro align-y [inner outer align]
  `(align-xy ~inner ~outer ~align :top :center :bottom))

(defmacro decorate-layer
  "Decorate Layer and Anchored replacing render! implementation."
  [layer & render-tail]
  `(reify
    Layer
    (render! ~@render-tail)
    (layer-size [t#] (layer-size ~layer))
    Anchored
    (anchor [t# xa# ya#] (anchor ~layer xa# ya#))))

(defn padding
  "Decorates layer adding padding."
  ([content pad]
     (padding content pad pad pad pad))
  ([content top left bottom right]
     (if (== 0 top left bottom right)
       content
       (reify
        Layer
        (render! [l]
           (draw! content
                  left top
                  (- *width* left right)
                  (- *height* top bottom)))
        (layer-size [l]
           (let [s (layer-size content)]
             (Size. (+ (:width s) left right)
                    (+ (:height s) top bottom))))))))

(defn border
  "Decorate layer with a border."
  ([content]
     (border content 1))
  ([content width]
     (border content width 0))
  ([content width gap]
     (let [layer (padding content (+ width gap))]
       (decorate-layer layer [_]
         (with-color :border-color
           (doseq [i (range 0 width)]
             (.drawRect *graphics* i i
                        (- *width* 1 i i)
                        (- *height* 1 i i))))
         (render! layer)))))

(defn panel
  "Opaque layer using theme's alt-back-color."
  ([content]
     (panel content 0))
  ([content gap]
     (let [layer (padding content gap)]
       (decorate-layer layer [_]
         (with-color :alt-back-color
           (.fillRect *graphics* 0 0 *width* *height*))
         (render! layer)))))

(defn hbox
  "Creates layer that draws the specified content layers placing them
   horizontally."
  [& contents]
  (reify
   Layer
   (render! [_]
     ;; TODO: distribute space proportionally.
     (let [w (/ *width* (count contents))]
       (doseq [[i c] (map-indexed vector contents)]
         (draw! c (* i w) 0 w *height*))))
   (layer-size [_]
     (reduce #(Size. (+ (:width %1) (:width %2))
                     (max (:height %1) (:height %2)))
             (Size. 0 0)
             (map layer-size contents)))))

(defn- re-split [^java.util.regex.Pattern re s]
  (seq (.split re s)))

(def text-layout-cache (atom {}))

(defn- get-text-layout
  [^String line ^Font font ^FontRenderContext font-context]
  (let [key [line font font-context]]
    (or (if-let [^SoftReference softref (@text-layout-cache key)]
          (.get softref)
          (do (swap! text-layout-cache dissoc key)
              false))
        (let [layout (TextLayout. line font font-context)]
          ;;(println "text-layout-cache miss" line)
          (swap! text-layout-cache assoc key (SoftReference. layout))
          layout))))

(defn- layout-text
  [lines ^Font font ^FontRenderContext font-context]
  (map #(get-text-layout % font font-context) lines))
  ;;(map #(TextLayout. ^String % font font-context) lines))

(defn- text-width [layouts]
  (reduce (fn [w ^TextLayout tl] (max w (.getAdvance tl))) 0 layouts))

(defn- text-height [layouts]
  (reduce (fn [w ^TextLayout tl]
            (+ w (.getAscent tl)
               (.getDescent tl)
               (.getLeading tl)))
          0 layouts))

(defn label
  "Creates a layer to display multiline text."
  ([text]
     (label text :left :top))
  ([text h-align v-align]
     (let [lines (re-split #"\r\n|\n|\r|\u0085|\u2028|\u2029" text)]
       (reify Layer
        (render! [layer]
          (let [w *width*
                h *height*
                font (.getFont *graphics*)
                layouts (layout-text lines font *font-context*)
                y (align-y (text-height layouts) h v-align)]
            (loop [layouts layouts, y y]
              (when-first [^TextLayout layout layouts]
                (let [ascent (.getAscent layout)
                      lh (+ ascent (.getDescent layout) (.getLeading layout))
                      x (align-x (.getAdvance layout) w h-align)]
                  (.draw layout *graphics* x (+ y ascent))
                  (recur (next layouts) (+ y lh)))))))
        (layer-size [layer]
          (let [layouts (layout-text lines (:font *theme*) *font-context*)
                width (text-width layouts)
                height (text-height layouts)]
            (Size. width height)))))))

(defn- ^ImageObserver image-observer [layer]
  (reify
   ImageObserver
   (imageUpdate [this img infoflags x y width height]
     (update layer)
     (zero? (bit-and infoflags
                     (bit-or ImageObserver/ALLBITS
                             ImageObserver/ABORT))))))

(defn image-layer
  [image-or-uri]
  (let [^Image image (if (isa? image-or-uri Image)
                       image-or-uri
                       (.getImage (Toolkit/getDefaultToolkit)
                                  ^java.net.URL image-or-uri))]
    (.prepareImage (Toolkit/getDefaultToolkit) image -1 -1 nil)
    (reify
     Layer
     (render! [layer]
       (repaint-on-update layer)
       (.drawImage *graphics* image 0 0 (image-observer layer)))
     (layer-size [layer]
       (let [observer (image-observer layer)
             width (.getWidth image observer)
             height (.getHeight image observer)
             width (if (pos? width) width 1)
             height (if (pos? height) height 1)]
         (Size. width height))))))

(defn miniature
  "Creates layer that asynchronously renders view of the content
  scaled to the specified size."
  [content width height]
  (async-layer
   (reify
    Layer
    (render! [this]
      (let [size (layer-size content)
            sx (/ width (:width size))
            sy (/ height (:height size))]
        (.scale *graphics* sx sy)
        (draw! content 0 0 (:width size) (:height size))))
    (layer-size [this]
      (Size. width height)))
   width height))

(defrecord Viewport [content h-align v-align
                     ;; State (refs)
                     ;; TODO: group into data structures.
                     x y fix-x fix-y last-width last-height
                     vp-x vp-y]
  Layer
  (render! [layer]
    (repaint-on-update layer)
    (with-handlers layer
      (let [anchor (anchor content h-align v-align)]
        (dosync
         (alter x + (align-x *width* @last-width h-align))
         (alter y + (align-y *height* @last-height v-align))
         (ref-set last-width *width*)
         (ref-set last-height *height*)
         (ref-set vp-x (+ @x (:x anchor)))
         (ref-set vp-y (+ @y (:y anchor))))
        ;; TODO: notify observers when size changes.
        (draw! content (- @vp-x) (- @vp-y)))
      (:mouse-pressed e
       (dosync
        (ref-set fix-x (:x-on-screen e))
        (ref-set fix-y (:y-on-screen e)))
       (when *target*
         (->> Cursor/MOVE_CURSOR Cursor. (.setCursor *target*))))
      (:mouse-released e
       (when *target*
         (->> Cursor/DEFAULT_CURSOR Cursor. (.setCursor *target*))))
      (:mouse-dragged e
       (dosync
        (alter x + (- @fix-x (:x-on-screen e)))
        (alter y + (- @fix-y (:y-on-screen e)))
        (ref-set fix-x (:x-on-screen e))
        (ref-set fix-y (:y-on-screen e)))
       (update layer))))
  (layer-size [layer]
    (layer-size content)))

(defn viewport
  "Creates scrollable viewport layer."
  ([content] (viewport content :left :top))
  ([content h-align v-align]
     (Viewport. content h-align v-align
                (ref 0) (ref 0)    ; x y
                (ref 0) (ref 0)    ; fix-x fix-y
                (ref 0) (ref 0)    ; last-width last-height
                (ref 0) (ref 0)))) ; vp-x vp-y

(defn- viewport-visible-bounds
  [vp]
  (dosync
   [@(:vp-x vp) @(:vp-y vp)
    @(:last-width vp) @(:last-height vp)]))

(defn viewport-miniature
  "Creates miniature view of the viewport's contents."
  [viewport width height]
  (miniature
   (decorate-layer (:content viewport) [_]
     (repaint-on-update viewport)
     (let [[x y w h] (viewport-visible-bounds viewport)]
       (with-color :alt-back-color
         (.fillRect *graphics* 0 0 *width* *height*))
       (with-color :back-color
         (.fillRect *graphics* x y w h))
       (draw! (:content viewport))
       (with-color :border-color
         (.drawRect *graphics* x y w h))))
   width height))

;;
;; Layer context decorators.
;;

(defmacro handler [layer & handlers]
  "Decorate layer to handle events."
  `(let [layer# ~layer]
     (decorate-layer layer# [t#]
       (with-handlers t#
         (render! layer#)
         ~@handlers))))

(defn theme [layer & map-or-keyvals]
  (let [theme (if (== (count map-or-keyvals) 1)
                map-or-keyvals
                (apply array-map map-or-keyvals))]
    (reify
     Layer
     (render! [t]
       (with-theme theme
         (render! layer)))
     (layer-size [t]
       (with-theme theme
         (layer-size layer)))
     Anchored
     (anchor [t xa ya]
       (with-theme theme
         (anchor layer xa ya))))))

;;
;; Measuring time
;;

(def *interval*)

(defn interval-layer
  "Creates layer that measures time between repaints ant draws it's
   content with the *interval* var bound to the measured time."
  [content]
  (let [last-time (atom nil)]
    (decorate-layer content [_]
      (compare-and-set! last-time nil *time*)
      (let [lt @last-time]
        (binding [*interval* (if (compare-and-set! last-time lt *time*)
                               (- *time* lt)
                               0)] ; already measured on parallel thread
          (render! content))))))

(defn- fps-label [text]
  (padding (label text :right :bottom) 5))

(defn fps-layer
  "Creates layer that draws content and displays
   the frames per seconds rate." 
  [content]
  (let [update-interval 2E8 ; 0.2 s in nanoseconds
        frames (ref 0)
        prev-time (ref nil)
        display (ref (fps-label "fps n/a"))]
    (decorate-layer content [_]
      (draw! content)
      (draw!
       (dosync
        (alter frames inc)
        (if @prev-time
          (let [elapsed (- *time* @prev-time)]
            (when (> elapsed update-interval)
              (let [fps (/ @frames (/ elapsed 1E9))]
                (ref-set display (fps-label (format "%.1f" fps)))
                (ref-set frames 0)
                (ref-set prev-time *time*))))
          (ref-set prev-time *time*))
        @display)))))