;;
;; Copyright 2010-2015 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 indyvon.viewport
  "Scrollable viewport and miniature."
  (:use
   (indyvon core async views))
  (: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* (Math/sqrt (/ 1.0 2.0)))
(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]
  View
  (render! [view]
    (repaint-on-update! view)
    (with-handlers view
      (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* view
                  *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))))
       (notify! view)]
      [:mouse-wheel e
       (scale-viewport!
        view
        (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 view."
  ([content]
     (viewport :left :top content))
  ([h-align v-align content]
     (->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)
     (notify! viewport)))

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

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

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

(def ^:dynamic *miniature-thread-priority* 2)

(defn miniature
  "Creates a view that asynchronously renders the content view scaled to
  the specified size."
  [mw mh content]
  (->> content
       (decorator (fn [_ content]
                    (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)))
                  (fn [_ _]
                    (->Size mw mh)))  
       (async-view mw mh *miniature-thread-priority*)))

(defn viewport-miniature
  "Creates miniature view of the viewport's contents."
  [m-width m-height viewport]
  (->> (:content viewport)
       (miniature m-width m-height)
       (decorator
        (fn [v m]
          (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)
                           (notify! 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 v
              (draw! m)
              [: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))))))))