;;
;; Copyright (C) 2010 Mikhail Kryshen <mikhail@kryshen.net>
;;
;; This file is part of Indyvon.
;;

(ns kryshen.indyvon.layers
  (:use kryshen.indyvon.core)
  (:import (kryshen.indyvon.core Size Location)
           (java.awt Font Cursor)
           (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 [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
  ([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 *bounds*) left right)
                  (- (:height *bounds*) 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 [_]
         (let [w (:width *bounds*)
               h (:height *bounds*)]
           (with-color (:border-color *theme*)
             (doseq [i (range 0 width)]
               (.drawRect *graphics* i i (- w 1 i i) (- h 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 *theme*)
           (.fillRect *graphics* 0 0
                      (:width *bounds*) (:height *bounds*)))
         (render! layer)))))

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

(defn- layout-text [lines ^Font font ^FontRenderContext font-context]
  (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 text-layer
  "Creates a layer to display multiline text."
  ([text]
     (text-layer 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 *bounds*)
                 h (:height *bounds*)
                 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 viewport
  "Creates scrollable viewport layer."
  ([content] (viewport content :left :top))
  ([content h-align v-align]
  (let [x (ref 0)
        y (ref 0)
        fix-x (ref 0)
        fix-y (ref 0)
        last-width (ref 0)
        last-height (ref 0)]
    (reify
     Layer
     (render! [layer]
        (with-handlers layer
         (let [anchor (anchor content h-align v-align)
               width (:width *bounds*)
               height (:height *bounds*)]
           (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))
           (draw! content (- 0 @x (:x anchor)) (- 0 @y (:y anchor))))
         (:mouse-pressed e
          (dosync
           (ref-set fix-x (:x-on-screen e))
           (ref-set fix-y (:y-on-screen e)))
          (->> Cursor/MOVE_CURSOR Cursor. (.setCursor *target*)))
         (:mouse-released e
          (->> 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-size [layer] (layer-size content))))))

;;
;; Layer context decorators.
;;

(defmacro handler [layer & handlers]
  `(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)))))