(ns indyvon.core
  (:require (clojure [set :as s]))
  (:import (java.awt Dimension Point Component Graphics2D Color AWTEvent)
           (java.awt.event MouseEvent MouseAdapter MouseMotionAdapter
                           MouseListener MouseMotionListener)))

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

(defrecord LayerContext [layer parent x y width height update-fn dispatcher])

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

(defmacro reify-layer [& fns]
  (let [method-map {'size [['_ '_] [0 0]]
                    'anchor [['_ '_] [0 0]]}
        method-map (loop [fns fns
                          mm method-map]
                     (if-let [form (first fns)]
                       (recur (next fns)
                              (conj mm [(first form) (next form)]))
                       mm))
        methods (for [m method-map]
                  (cons (first m) (second m)))]
    `(reify Layer ~@methods)))

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

(defn render-layer!
  "Render layer in a new graphics context."
  ([context layer graphics]
     (render-layer! context layer graphics
                    0 0 (:width context) (:height context)))
  ([context layer graphics x y]
     (render-layer! context layer graphics x y true))
  ([context layer graphics x y clip]
     (let [s (size layer context)]
       (render-layer! context layer graphics
                      x y (s 0) (s 1) clip)))
  ([context layer graphics x y w h]
     (render-layer! 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)]
       (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))))))

;;
;; Event handling
;;

(defmulti handle-layer-event 
  (fn [layer context event]
    [layer (.getID event)]))

(defmethod handle-layer-event :default [layer context event])

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

(defn- assoc-conj [vmap key val]
  "Add val to the sequence associated with key in vmap."
  (assoc vmap key (conj (get vmap key) val)))

(defn- registered-parent
  "Returns first context parent registered for event processing."
  [context-tree context]
  (let [parent (:parent context)]
    (cond
     (nil? parent) nil
     (contains? context-tree parent) parent
     :default (recur context-tree parent))))

(defn- register-context
  [context-tree context]
  (assoc-conj
   context-tree (registered-parent context-tree context) context))

(defn- inside?
  ([x y context]
     (inside? x y (:x context) (:y context)
              (:width context) (:height context)))
  ([px py x y w h]
     (and (>= px x)
          (>= py y)
          (< px (+ x w))
          (< py (+ y h)))))

(defn- under-cursor
  "Returns a sequence of contexts under cursor."
  ([context-tree x y]
     (under-cursor context-tree x y nil))
  ([context-tree x y context]
     (some #(if (inside? x y %)
              (conj (under-cursor context-tree x y %) %))
           (context-tree context))))

(defn- remove-all [coll1 coll2 pred]
  (filter #(not (some (partial pred %) coll2)) coll1))

(defn- translate-mouse-event
  [#^MouseEvent event x y id]
  (proxy [MouseEvent] [(.getComponent event)
                       id
                       (.getWhen event)
                       (.getModifiers event)
                       (- (.getX event) x)
                       (- (.getY event) y)
                       (.getClickCount event)
                       (.isPopupTrigger event)]
    (getXOnScreen []
                  (.getXOnScreen event))
    (getYOnScreen []
                  (.getYOnScreen event))))

(defn- translate-and-dispatch
  ([contexts event]
     (translate-and-dispatch contexts event (.getID event)))
  ([contexts event id]
  (doseq [c contexts]
    (handle-layer-event
     (:layer c)
     c
     (translate-mouse-event event (:x c) (:y c) id)))))

(defn- dispatch-mouse-motion*
  "Dispatches mouse motion events. Returns a new set of contexts which
  currently are under cursor."
  [hovered context-tree #^MouseEvent event]
  (let [x (.getX event)
        y (.getY event)
        hovered2 (under-cursor context-tree x y)
        pred #(= (:layer %1) (:layer %2))
        exited (remove-all hovered hovered2 pred)
        entered (remove-all hovered2 hovered pred)
        moved (remove-all hovered2 entered pred)]
    (translate-and-dispatch exited event MouseEvent/MOUSE_EXITED)
    (translate-and-dispatch entered event MouseEvent/MOUSE_ENTERED)
    (translate-and-dispatch moved event MouseEvent/MOUSE_MOVED)
    hovered2))

(defn- dispatch-mouse-motion
  [hovered-ref context-tree #^MouseEvent event]
  (dosync
   (alter hovered-ref dispatch-mouse-motion* context-tree event)))

(defn make-event-dispatcher []
  (let [context-tree-r (ref {}) ; register
        context-tree (ref {})   ; dispatch
        hovered (ref '())
        picked (ref '())]
    (reify
     EventDispatcher
     (register [this context]
               (dosync (alter context-tree-r register-context context)))
     (commit [this]
             (dosync (ref-set context-tree @context-tree-r)
                     (ref-set context-tree-r {})))
     (picked? [this layer] false)
     (hovered? [this layer] false)
     MouseListener
     (mouseClicked [this event])
     (mouseEntered [this event]
                   (dispatch-mouse-motion hovered context-tree event))
     (mouseExited [this event]
                  (dispatch-mouse-motion hovered context-tree event))
     (mousePressed [this event])
     (mouseReleased [this event])
     MouseMotionListener
     (mouseDragged [this event]
                   (translate-and-dispatch @picked event))
     (mouseMoved [this event]
                 (dispatch-mouse-motion hovered context-tree event)))))

;;
;; Connection to AWT.
;;

(defn- make-update-fn [component]
  (fn [] (.repaint component)))

(defn make-component
  ([layer]
     (make-component layer (make-event-dispatcher)))
  ([layer event-dispatcher]
     (doto
         (proxy [Component] []
           (update [g] (.paint this g))
           (paint [g]
                  (let [size (.getSize this)
                        width (.width size)
                        height (.height size)
                        context (assoc (default-context)
                                  :dispatcher event-dispatcher
                                  :update-fn (make-update-fn this))]
                    (render-layer! context layer g 0 0 width height false))
                  (commit event-dispatcher))
           (getPreferredSize []
                             (let [s (size layer nil)] ;; TODO: supply context
                               (Dimension. (s 0) (s 1)))))
       (.addMouseListener event-dispatcher)
       (.addMouseMotionListener event-dispatcher))))

(comment
  (do 
    (def frame (java.awt.Frame. "Test"))
    (def layer1
         (reify-layer
          (render! [this context g]
                   (register (:dispatcher context) context)
                   (.setColor g Color/BLUE)
                   (.fillRect g 0 0 50 30))
          (size [this context] [50 30])))
    (def layer
         (reify-layer
          (render! [this context g]
                   (register (:dispatcher context) context)
                   (.drawLine g 0 0 (:width context) (:height context))
                   (render-layer! context layer1 g 15 20))
          (size [this context] [100 100])))
    (doto frame
      (.addWindowListener
       (proxy [java.awt.event.WindowAdapter] []
         (windowClosing [event] (.dispose frame))))
      (.add (make-component layer))
      (.pack)
      (.setVisible true))

    (defmethod handle-layer-event [layer1 MouseEvent/MOUSE_ENTERED]
      [layer context event]
      (println "ENTERED"))
    (defmethod handle-layer-event [layer1 MouseEvent/MOUSE_EXITED]
      [layer context event]
      (println "EXITED"))
    (defmethod handle-layer-event [layer1 MouseEvent/MOUSE_MOVED]
      [layer context event]
      (println "MOVED")) 
    )
  )