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

(ns indyvon.core
  (:import (java.awt Color Font Cursor)
           (java.awt.font FontRenderContext TextLayout)
           (java.awt.event MouseEvent)))

(defprotocol Layer
  "Basic UI element."
  (render! [this context graphics])
  (size [this context]))

(defprotocol MouseHandler
  "Layers that also satisfy this protocol will recieve mouse events."
  (handle-mouse [this context event]))

(defprotocol EventDispatcher
  (listen! [this component])
  (register [this context])
  (commit [this])
  (hovered? [this layer])
  (picked? [this layer]))

(defrecord Theme [fore-color back-color border-color font])

(defn default-theme []
  (Theme. Color/BLACK Color/WHITE Color/BLUE (Font. "Sans" Font/PLAIN 12)))
  
(defrecord LayerContext [layer parent x y width height update-fn
  dispatcher font-context theme target])

(defn default-context []
  (LayerContext. nil nil 0 0 0 0 nil nil nil (default-theme) nil))

(defn update [context]
  ((:update-fn context)))

(defn- make-graphics [graphics x y w h clip]
  (if clip
    (.create graphics x y w h)
    (doto (.create graphics)
      (.translate x y))))

(defn- apply-theme [graphics theme]
  (doto graphics
    (.setColor (:fore-color theme))
    (.setFont (:font theme))))

(defn draw!
  "Render layer in a new graphics context."
  ([context layer graphics]
     (draw! context layer graphics
                    0 0 (:width context) (:height context)))
  ([context layer graphics x y]
     (draw! context layer graphics x y true))
  ([context layer graphics x y clip]
     (let [s (size layer context)]
       (draw! context layer graphics
              x y (s 0) (s 1) clip)))
  ([context layer graphics x y w h]
     (draw! context layer graphics
            x y w h true))
  ([context layer graphics x y w h clip]
     (let [context (assoc context
                     :layer layer
                     :parent context
                     :x (+ (:x context) x)
                     :y (+ (:y context) y)
                     :width w
                     :height h)
           graphics (make-graphics graphics x y w h clip)
           graphics (apply-theme graphics (:theme context))]
       (try
         (register (:dispatcher context) context)
         (render! layer context graphics)
         (finally
          (.dispose graphics))))))

;;
;; Layer implementations.
;;

(defn border-layer
  "Decorate layer with a border."
  ([content]
     (border-layer content 1))
  ([content width]
     (border-layer content width 0))
  ([content width gap]
     (let [offset (+ width gap)]
       (reify Layer
        (render! [l c g]
           (let [w (:width c)
                 h (:height c)]
             (.setColor g (-> c :theme :border-color))
             (doseq [i (range 0 width)]
               (.drawRect g i i (- w 1 i i) (- h 1 i i)))
             (draw! c content g offset offset (- w offset offset)
                    (- h offset offset))))
        (size [l c]
           (let [s (size content c)]
             [(+ (s 0) offset offset)
              (+ (s 1) offset offset)]))))))

(defn- re-split [re s]
  (seq (.split re s)))

(defn- layout-text [lines font font-context]
  (map #(TextLayout. % font font-context) lines))

(defn- text-width [layouts]
  (reduce #(max %1 (.getAdvance %2)) 0 layouts))

(defn- text-height [layouts]
  (reduce #(+ %1 (.getAscent %2) (.getDescent %2) (.getLeading %2))
          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! [l c g]
           (let [w (:width c)
                 h (:height c)
                 font (.getFont g)
                 font-context (:font-context c)
                 layouts (layout-text lines font font-context)
                 y (case v-align
                     :top 0
                     :center (/ (- h (text-height layouts)) 2)
                     :bottom (- h (text-height layouts)))]
             (loop [layouts layouts, y y]
               (when-first [layout layouts]
                 (let [ascent (.getAscent layout)
                       lh (+ ascent (.getDescent layout) (.getLeading layout))
                       x (case h-align
                           :left 0
                           :center (/ (- w (.getAdvance layout)) 2)
                           :right (- w (.getAdvance layout)))]
                   (.draw layout g x (+ y ascent))
                   (recur (next layouts) (+ y lh)))))))
        (size [l c]
           (let [layouts (layout-text lines
                                      (-> c :theme :font)
                                      (:font-context c))
                 width (text-width layouts)
                 height (text-height layouts)]
             [width height]))))))

(defprotocol Anchored
  "Provide anchor point for Layers. Used by viewport."
  (anchor [this context] "Anchor point: [x y]"))

;; Default implementation of Anchored for any Layer.
(extend-protocol Anchored
  indyvon.core.Layer
  (anchor [this context] [0 0]))

(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 c g]
        (let [anchor (anchor content c)
              width (:width c)
              height (:height c)]
          (dosync
           (case h-align
                 :left nil
                 :center (alter x + (/ (- @last-width width) 2))
                 :right (alter x + (- @last-width width)))
           (case v-align
                 :top nil
                 :center (alter y + (/ (- @last-height height) 2))
                 :bottom (alter y + (- @last-height height)))
           (ref-set last-width width)
           (ref-set last-height height))
          (draw! c content g
                 (- 0 @x (anchor 0))
                 (- 0 @y (anchor 1)))))
     (size [layer c] (size content c))
     MouseHandler
     (handle-mouse [layer c e]
        (when (= (.getID e) MouseEvent/MOUSE_PRESSED)
          (dosync
           (ref-set fix-x (.getXOnScreen e))
           (ref-set fix-y (.getYOnScreen e)))
          (->> Cursor/MOVE_CURSOR Cursor. (.setCursor (:target c))))
        (when (= (.getID e) MouseEvent/MOUSE_RELEASED)
          (->> Cursor/DEFAULT_CURSOR Cursor. (.setCursor (:target c))))
        (when (= (.getID e) MouseEvent/MOUSE_DRAGGED)
          (dosync
           (alter x + (- @fix-x (.getXOnScreen e)))
           (alter y + (- @fix-y (.getYOnScreen e)))
           (ref-set fix-x (.getXOnScreen e))
           (ref-set fix-y (.getYOnScreen e)))
          (update c)))))))