Mercurial > hg > indyvon
view src/indyvon/core.clj @ 2:0f2a98f71a9c
Beginnings of event dispatching code.
author | Mikhail Kryshen <mikhail@kryshen.net> |
---|---|
date | Mon, 07 Jun 2010 21:13:05 +0400 |
parents | a93cfcf60f27 |
children | 6bc931b1b755 |
line wrap: on
line source
(ns indyvon.core (:import (java.awt Dimension Point Component Graphics2D AWTEvent))) (def ^{:private true} *rx* 0) (def ^{:private true} *ry* 0) (def *graphics*) (def *width*) (def *height*) (def *lag*) (def *update-fn*) (defprotocol Layer (render! [this]) (size [this]) (anchor [this])) (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." ([layer] (render-layer! layer 0 0 *width* *height*)) ([layer x y] (render-layer! layer x y true)) ([layer x y clip] (let [s (size layer)] (render-layer! layer x y (.width s) (.height s) clip))) ([layer x y w h] (render-layer! layer x y w h true)) ([layer x y w h clip] (binding [*graphics* (make-graphics *graphics* x y w h clip) *rx* (+ *rx* x) *ry* (+ *ry* y) *width* w *height* h] (render! layer)))) ;; ;; Event handling ;; (defprotocol EventDispatcher (register [this layer]) (commit [this]) (dispatch [this event])) (defrecord LayerContext [layer rx ry width height update-fn]) (defn make-event-dispatcher [] (let [contexts-r (ref []) contexts-d (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-d @contexts-r) (ref-set contexts-r []))) (dispatch [this event] ;; TODO )))) ;; ;; 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] (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)))))) (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)) ) )