;;
;; Copyright 2010, 2011, 2012, 2013 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.viewport
  "Scrollable viewport and miniature."
  (:use
   (net.kryshen.indyvon core async layers))
  (:import
   java.awt.Cursor
   java.awt.geom.AffineTransform))
  
;;(defn- translate [^AffineTransform transform ^double x ^double y]
;;  (doto ^AffineTransform (.clone transform)
;;        (.translate x y)))

(defn- scale [^AffineTransform transform ^double sx ^double sy]
    (doto ^AffineTransform (.clone transform)
        (.scale sx sy)))

(defn- pre-translate [^AffineTransform transform ^double x ^double y]
  (if (== 0.0 x y)
    transform
    (doto (AffineTransform/getTranslateInstance x y)
      (.concatenate transform))))

(def ^:dynamic *viewport-scaling-step* (double 3/4))
(def ^:dynamic *viewport-min-scale* 1E-6)
(def ^:dynamic *viewport-max-scale* 1E6)

(def ^:dynamic *viewport* nil)
(def ^:dynamic ^AffineTransform *viewport-transform*)

(declare scale-viewport!)

(defrecord ViewportState [transform
                          fix-x fix-y
                          last-width last-height
                          last-anchor-x last-anchor-y])

(defn- update-viewport [state content-geom h-align v-align]
  (let [w *width*
        h *height*
        cw (width content-geom)
        ch (height content-geom)
        ax (anchor-x content-geom h-align cw)
        ay (anchor-y content-geom v-align ch)
        ax1 (align-x h-align (:last-width state) w)
        ay1 (align-y v-align (:last-height state) h)
        ax2 (- (:last-anchor-x state) ax)
        ay2 (- (:last-anchor-y state) ay)
        transform (:transform state)
        transform (if (and (zero? ax1) (zero? ay1)
                           (zero? ax2) (zero? ay2))
                    transform
                    (doto
                        (AffineTransform/getTranslateInstance ax1 ay1)
                      (.concatenate transform)
                      (.translate ax2 ay2)))]
    (assoc state
      :last-width w
      :last-height h
      :last-anchor-x ax
      :last-anchor-y ay
      :transform transform)))

(defrecord Viewport [content h-align v-align state]
  Layer
  (render! [layer]
    (repaint-on-update layer)
    (with-handlers layer
      (let [geom (geometry content)
            new-state (swap! state update-viewport geom h-align v-align)
            transform (:transform new-state)]
        ;; TODO: notify observers when size changes.
        (binding [*viewport* layer
                  *viewport-transform* transform]
          (with-transform transform
            (draw! content 0 0 (width geom) (height geom) false))))
      (:mouse-pressed e
       (swap! state assoc
              :fix-x (:x-on-screen e)
              :fix-y (:y-on-screen e))
       (set-cursor! (Cursor. Cursor/MOVE_CURSOR)))
      (:mouse-released e
       (set-cursor! (Cursor. Cursor/DEFAULT_CURSOR)))
      (:mouse-dragged e
       (swap! state
              (fn [s]
                (assoc s
                  :transform (pre-translate
                              (:transform s)
                              (- (:x-on-screen e) (:fix-x s))
                              (- (:y-on-screen e) (:fix-y s)))
                  :fix-x (:x-on-screen e)
                  :fix-y (:y-on-screen e))))
       (update layer))
      (:mouse-wheel e
       (scale-viewport!
        layer
        (Math/pow *viewport-scaling-step* (:wheel-rotation e))
        true (:x e) (:y e)))))
  (geometry [_]
    (geometry content)))

(def ^:private viewport-initial-state
  (->ViewportState
   (AffineTransform.) ; transform
   0 0                ; fix-x fix-y
   0 0                ; last-width last-height
   0 0))

(defn viewport
  "Creates scrollable viewport layer."
  ([content]
     (viewport content :left :top))
  ([content h-align v-align]
     (->Viewport content h-align v-align (atom viewport-initial-state))))

(defn- scale-viewport [state vp s relative? x y]
  (let [^AffineTransform tr (:transform state)
        sx (if relative? s (/ s (.getScaleX tr)))
        sy (if relative? s (/ s (.getScaleY tr)))
        x (or x (align-x (:h-align vp) (:last-width state)))
        y (or y (align-y (:v-align vp) (:last-height state)))
        x (- x (* x sx))
        y (- y (* y sy))
        scaled (doto (AffineTransform/getTranslateInstance x y)
                 (.scale sx sy)
                 (.concatenate tr))
        sx (.getScaleX scaled)
        sy (.getScaleY scaled)]
    (if (<= *viewport-min-scale*
            (min sx sy)
            (max sx sy)
            *viewport-max-scale*)
      (assoc state
        :transform scaled)
      state)))

(defn scale-viewport!
  ([viewport s]
     (scale-viewport! viewport s true))
  ([viewport s relative?]
     (scale-viewport! viewport s relative? nil nil))
  ([viewport s relative? x y]
     (swap! (:state viewport) scale-viewport viewport s relative? x y)
     (update viewport)))

(defn reset-viewport! [viewport]
  (reset! (:state viewport) viewport-initial-state)
  (update viewport))

(defn ^AffineTransform viewport-transform [viewport]
  (:transform @(:state viewport)))

(defn- scaling
  [width height max-width max-height]
  (min (/ max-width width)
       (/ max-height height)))

(defn miniature
  "Creates layer that asynchronously renders view of the content
  scaled to the specified size."
  [content mw mh]
  (async-layer
   (reify
    Layer
    (render! [this]
      (let [geom (geometry content)
            cw (width geom)
            ch (height geom)
            s (scaling cw ch mw mh)]
        (.scale *graphics* s s)
        (draw! content
               (align-x :center cw (/ mw s))
               (align-y :center ch (/ mh s))
               cw ch)))
    (geometry [_]
      (->Size mw mh)))
   mw mh *miniature-thread-priority*))

(defn viewport-miniature
  "Creates miniature view of the viewport's contents."
  [viewport m-width m-height]
  (let [miniature (miniature (:content viewport) m-width m-height)]
    (decorate-layer miniature [l]
      (repaint-on-update viewport)
      (let [geom (geometry (:content viewport))
            s (scaling (width geom) (height geom) m-width m-height)
            vp-state @(:state viewport)
            {:keys [transform last-width last-height]} @(:state viewport)
            ox (align-x :center (width geom) (/ m-width s))
            oy (align-y :center (height geom) (/ m-height s))
            inverse (.createInverse ^AffineTransform transform)
            transform (doto (AffineTransform.)
                        (.scale s s)
                        (.translate ox oy)
                        (.concatenate inverse))
            move-vp (fn [state x y]
                      (let [x (- (/ x s) ox)
                            y (- (/ y s) oy)
                            tr (:transform state)
                            [x y] (transform-point tr x y)
                            x (- x (/ (:last-width state) 2))
                            y (- y (/ (:last-height state) 2))]
                        (assoc state
                          :transform (pre-translate tr (- x) (- y)))))
            move-vp! (fn [x y]
                       (swap! (:state viewport) move-vp x y)
                       (update viewport))]
        (with-color :alt-back-color
          (.fillRect *graphics* 0 0 *width* *height*))
        (with-transform transform
          (with-color :back-color
            (.fillRect *graphics* 0 0 last-width last-height)))
        (with-handlers l
          (draw! miniature)
          (:mouse-pressed e (move-vp! (:x e) (:y e)))
          (:mouse-dragged e (move-vp! (:x e) (:y e))))
        (with-transform transform
          (with-color :border-color
            (.drawRect *graphics* 0 0 last-width last-height)))))))