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

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

(defprotocol Layer
  (render! [this context graphics])
  (size [this context])
  (anchor [this context]))

(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])

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

(defn- spec-map
  ([specs]
     (spec-map {} specs))
  ([mm specs]
     (if-let [form (first specs)]
       (recur (conj mm [(first form) (next form)])
              (next specs))
       mm)))

(defn- merge-specs [s1 s2]
  (for [spec (spec-map (spec-map s1) s2)]
    (cons (first spec) (second spec))))
     
(defmacro reify-layer [& specs]
  `(reify Layer ~@(merge-specs
                   '((size [_ _] [0 0])
                     (anchor [_ _] [0 0]))
                   specs)))

(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 [graphics (make-graphics graphics x y w h clip)
           graphics (apply-theme graphics (:theme context))]
       (try
         (render! layer
                  (assoc context
                    :layer layer
                    :parent context
                    :x (+ (:x context) x)
                    :y (+ (:y context) y)
                    :width w
                    :height h)
                  graphics)
         (finally
          (.dispose graphics))))))

(defmacro decorate-layer [layer & specs]
  `(let [layer# ~layer]
     (reify Layer ~@(merge-specs
                     `((~'render! [l# c# g#] (draw! c# layer# g#))
                       (~'size [l# c#] (size layer# c#))
                       (~'anchor [l# c#] (anchor layer# c#)))
                     specs))))

;;
;; 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)]))
        (anchor [l c]
           (let [a (anchor content c)]
             [(+ (a 0) offset)
              (+ (a 1) offset)]))))))

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

(defn- text-size [lines font font-context]
  (loop [lines lines
         width 0
         height 0]
    (if-let [line (first lines)]
      (let [layout (TextLayout. line font font-context)]
        (recur (next lines)
               (max width (.getAdvance layout))
               (+ height
                  (.getAscent layout)
                  (.getDescent layout)
                  (.getLeading layout))))
      [width height])))

(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)
                 y (case v-align
                     :top 0
                     :center (/ (- h ((text-size
                                       lines font font-context) 1))
                                2)
                     :bottom (- h ((text-size
                                    lines font font-context) 1)))]
             (loop [lines lines, y y]
               (when-first [line lines]
                 (let [layout (TextLayout. line font font-context)
                       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 lines) (+ y lh)))))))
        (size [l c]
           (text-size lines (-> c :theme :font) (:font-context c)))))))