view src/indyvon/core.clj @ 5:74f1f265c3d9

Context record replaced bindings.
author Mikhail Kryshen <mikhail@kryshen.net>
date Thu, 10 Jun 2010 05:35:56 +0400
parents 0771180bf7c2
children 5a858158cd9e
line wrap: on
line source

(ns indyvon.core
  (:import (java.awt Dimension Point Component Graphics2D AWTEvent)
           (java.awt.event MouseAdapter MouseMotionAdapter
                           MouseListener MouseMotionListener)))

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

(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]
     (render-layer! context layer 0 0 *width* *height*))
  ([context layer x y]
     (render-layer! context layer x y true))
  ([context layer x y clip]
     (let [s (size layer context)]
       (render-layer! context layer x y (.width s) (.height s) clip)))
  ([context layer x y w h]
     (render-layer! context layer x y w h true))
  ([context layer x y w h clip]
     (render! layer
              (assoc context
                :prev context
                :graphics (make-graphics (:graphics context)
                                         x y w h clip)
                :rx (+ (:rx context) x)
                :ry (+ (:ry context) y)
                :width w
                :height h))))

;;
;; Event handling
;;
;; LayerContext сам реализует EventDispatcher.
;; Дерево диспетчеров-контекстов.
;; Передача события от корня.
;;

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

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

(defprotocol EventDispatcher
  (register [this layer])
  (commit [this]))

(defrecord LayerContext [prev rx ry width height update-fn dispatcher])

(defn make-event-dispatcher []
  (let [tree (ref {})]
    (reify
     EventDispatcher
       (register [this layer])
       (commit [this]))))
     
;; (defn make-event-dispatcher []
;;   (let [contexts-r (ref []) ; register
;;         contexts (ref [])   ; dispatch
;;         hovered (ref [])
;;         picked (ref [])]
;;     (reify
;;      EventDispatcher
;;      (register [this layer]
;;                (dosync
;;                 (alter contexts-r conj
;;                        (LayerContext. layer *rx* *ry*
;;                                       *width* *height*
;;                                       *update-fn*))))
;;      (commit [this]
;;              (dosync (ref-set contexts @contexts-r)
;;                      (ref-set contexts-r [])))
;;      (dispatch [this event]
;;                (println "dispatch" this event)
;;                ;; TODO
;;                )
;;      MouseListener
;;      (mouseClicked [this event])
;;      (mouseEntered [this event])
;;      (mouseExited [this event])
;;      (mousePressed [this event])
;;      (mouseReleased [this event])
;;      MouseMotionListener
;;      (mouseDragged [this event])
;;      (mouseMoved [this event]))))

;;
;; Connection to AWT.
;;

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

;; (defn make-component [layer]
;;   (proxy [Component] []
;;     (update [g] (.paint this g))
;;     (paint [g]
;;            (let [insets (.getInsets this)
;;                  top (.top insets)
;;                  left (.left insets)
;;                  bottom (.bottom insets)
;;                  right (.right insets)
;;                  size (.getSize this)
;;                  width (- (.width size) left right)
;;                  height (- (.height size) top bottom)]
;;              (binding [*graphics* g
;;                        *update-fn* (make-update-fn this)]
;;                (render-layer! layer top left width height false))))
;;     (getPreferredSize []
;;                       (size layer))))

(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)]
                    (binding [*graphics* g
                              *update-fn* (make-update-fn this)]
                      (render-layer! layer 0 0 width height false))))
           (getPreferredSize []
                             (let [s (size layer)]
                               (Dimension. (s 0) (s 1))))
           (processEvent [event]))
       ;; No way to call protected final evenbleEvents even in gen-class,
       ;; have to use the following hack:
       (.addMouseListener (proxy [MouseAdapter] []))
       (.addMouseMotionListener (proxy [MouseMotionAdapter] [])))))

(comment
  (do 
    (def frame (java.awt.Frame. "Test"))
    (def layer
         (reify-layer
          (render! [this]
                   (.fillRect *graphics* 10 10 40 40))
          (size [this] [100 100])))
    (doto frame
      (.addWindowListener
       (proxy [java.awt.event.WindowAdapter] []
         (windowClosing [event] (.dispose frame))))
      (.add (make-component layer))
      (.pack)
      (.setVisible true))
    )
  )