1.1 --- a/src/net/kryshen/indyvon/component.clj	Fri Aug 20 03:19:37 2010 +0400
     1.2 +++ b/src/net/kryshen/indyvon/component.clj	Fri Aug 20 21:44:03 2010 +0400
     1.3 @@ -23,6 +23,7 @@
     1.4          width (.width size)
     1.5          height (.height size)]
     1.6      (.clearRect graphics 0 0 width height)
     1.7 +    ;; Setup the root layer context (move to core?).
     1.8      (binding [*graphics* graphics
     1.9                *font-context* (.getFontRenderContext graphics)
    1.10                *initial-transform* (.getTransform graphics)

     2.1 --- a/src/net/kryshen/indyvon/core.clj	Fri Aug 20 03:19:37 2010 +0400
     2.2 +++ b/src/net/kryshen/indyvon/core.clj	Fri Aug 20 21:44:03 2010 +0400
     2.3 @@ -11,20 +11,39 @@
     2.4     (java.awt.event MouseListener MouseMotionListener)
     2.5     (java.awt.font FontRenderContext)))
     2.6  
     2.7 +;;
     2.8 +;; Layer context
     2.9 +;;
    2.10 +
    2.11  (def ^Graphics2D *graphics*)
    2.12 +
    2.13  (def ^FontRenderContext *font-context*)
    2.14 +
    2.15  (def ^Component *target*)
    2.16 +
    2.17  (def *width*)
    2.18 +
    2.19  (def *height*)
    2.20 +
    2.21  (def ^Shape *clip*)
    2.22 -(def *update*)
    2.23 +
    2.24  (def *event-dispatcher*)
    2.25  
    2.26 -(def ^AffineTransform *initial-transform*)
    2.27 -(def ^AffineTransform *inverse-initial-transform*)
    2.28 +(def ^{:doc "Fn to be called in a layer context to request redraw."}
    2.29 +     *update*)
    2.30 +
    2.31 +(def ^{:tag AffineTransform
    2.32 +       :doc "Initial transform associated with the graphics context"}
    2.33 +     *initial-transform*)
    2.34 +
    2.35 +(def ^{:tag AffineTransform
    2.36 +       :doc "Inversion of the initial transform associated with
    2.37 +            the graphics context"}
    2.38 +     *inverse-initial-transform*)
    2.39  
    2.40  (defrecord Theme [fore-color back-color alt-back-color border-color font])
    2.41  
    2.42 +;; REMIND: use system colors, see java.awt.SystemColor.
    2.43  (defn default-theme []
    2.44    (Theme. Color/BLACK Color/LIGHT_GRAY Color/WHITE
    2.45            Color/BLUE (Font. "Sans" Font/PLAIN 12)))
    2.46 @@ -35,6 +54,10 @@
    2.47  (defrecord Size [width height])
    2.48  (defrecord Bounds [x y width height])
    2.49  
    2.50 +;;
    2.51 +;; Core protocols and types
    2.52 +;;
    2.53 +
    2.54  (defprotocol Layer
    2.55    "Basic UI element."
    2.56    (render! [this])
    2.57 @@ -77,46 +100,26 @@
    2.58              :center (/ (:height size) 2)
    2.59              :bottom (:height size)))))))
    2.60  
    2.61 -(defn- ^Graphics2D make-graphics [^Graphics2D graphics x y w h]
    2.62 -  (.create graphics x y w h))
    2.63 -
    2.64 -(defn- ^Graphics2D apply-theme [^Graphics2D graphics theme]
    2.65 -  (doto graphics
    2.66 -    (.setColor (:fore-color theme))
    2.67 -    (.setFont (:font theme))))
    2.68 -
    2.69 -(defn intersect
    2.70 -  "Compute intersection between a pair of rectangles (Bounds)."
    2.71 -  ([b1 b2]
    2.72 -     (let [x1 (:x b1)
    2.73 -           y1 (:y b1)
    2.74 -           x2 (:x b2)
    2.75 -           y2 (:y b2)]
    2.76 -       (intersect x1 y1 (+ x1 (:width b1)) (+ y1 (:height b1))
    2.77 -                  x2 y2 (+ x2 (:width b2)) (+ y2 (:height b2)))))
    2.78 -  ([x11 y11 x12 y12, x21 y21 x22 y22]
    2.79 -     (let [x1 (max x11 x21)
    2.80 -           y1 (max y11 y21)
    2.81 -           x2 (min x12 x22)
    2.82 -           y2 (min y12 y22)]
    2.83 -       (Bounds. x1 y1 (- x2 x1) (- y2 y1)))))
    2.84 +;;
    2.85 +;; Rendering
    2.86 +;;
    2.87  
    2.88  (defn- relative-transform
    2.89 -  "AffineTransform: layer -> absolute -> component."
    2.90 +  "AffineTransform: layer context -> awt component."
    2.91    []
    2.92    (let [tr (.getTransform *graphics*)]
    2.93      (.preConcatenate tr *inverse-initial-transform*)
    2.94      tr))
    2.95  
    2.96  (defn- inverse-relative-transform
    2.97 -  "AffineTransform: component (event) -> absolute -> layer."
    2.98 +  "AffineTransform: awt component -> layer context."
    2.99    []
   2.100    (let [tr (.getTransform *graphics*)]
   2.101      (.invert tr)                          ; absolute -> layer
   2.102      (.concatenate tr *initial-transform*) ; component -> absolute
   2.103      tr))
   2.104  
   2.105 -(defn clip
   2.106 +(defn- clip
   2.107    "Intersect clipping area with the specified shape or bounds.
   2.108     Returns new clip (Shape or nil if empty)."
   2.109    ([x y w h]
   2.110 @@ -130,32 +133,43 @@
   2.111           nil
   2.112           a1))))
   2.113  
   2.114 -(defn ^Graphics2D create-graphics
   2.115 +(defn- ^Graphics2D apply-theme
   2.116 +  "Set graphics' color and font to match theme.
   2.117 +   Modifies and returns the first argument."
   2.118 +  [^Graphics2D graphics theme]
   2.119 +  (doto graphics
   2.120 +    (.setColor (:fore-color theme))
   2.121 +    (.setFont (:font theme))))
   2.122 +
   2.123 +(defn- ^Graphics2D create-graphics
   2.124    ([]
   2.125       (create-graphics 0 0 *width* *height*))
   2.126    ([x y w h]
   2.127       (apply-theme (.create *graphics* x y w h) *theme*)))
   2.128  
   2.129 -(defmacro with-bounds [x y w h & body]
   2.130 -  `(let [x# ~x, y# ~y
   2.131 -         w# ~w, h# ~h
   2.132 -         clip# (clip x# y# w# h#)]
   2.133 -     (when clip#
   2.134 -       (let [graphics# (create-graphics x# y# w# h#)]
   2.135 -         (try
   2.136 -           (binding [*width* w#
   2.137 -                     *height* h#
   2.138 -                     *clip* clip#
   2.139 -                     *graphics* graphics#]
   2.140 -             ~@body)
   2.141 -           (finally
   2.142 -            (.dispose graphics#)))))))
   2.143 +(defn with-bounds*
   2.144 +  [x y w h f & args]
   2.145 +  (when-let [clip (clip x y w h)]
   2.146 +    (let [graphics (create-graphics x y w h)]
   2.147 +      (try
   2.148 +        (binding [*width* w
   2.149 +                  *height* h
   2.150 +                  *clip* clip
   2.151 +                  *graphics* graphics]
   2.152 +          (apply f args))
   2.153 +        (finally
   2.154 +         (.dispose graphics))))))
   2.155  
   2.156 -(defmacro with-handlers* [handle handlers & body]
   2.157 -  `(binding
   2.158 -       [*event-dispatcher*
   2.159 -        (create-dispatcher *event-dispatcher* ~handle ~handlers)]
   2.160 -     ~@body))
   2.161 +(defmacro with-bounds
   2.162 +  [x y w h & body]
   2.163 +  `(with-bounds* ~x ~y ~w ~h (fn [] ~@body)))
   2.164 +
   2.165 +(defn with-handlers*
   2.166 +  [handle handlers f & args]
   2.167 +  (binding
   2.168 +      [*event-dispatcher* (create-dispatcher
   2.169 +                           *event-dispatcher* handle handlers)]
   2.170 +    (apply f args)))
   2.171  
   2.172  (defmacro with-handlers
   2.173    "specs => (:event-id name & handler-body)*
   2.174 @@ -168,17 +182,15 @@
   2.175                         `(fn [~(second spec)]
   2.176                            ~@(nnext spec)))) {}
   2.177                            specs)
   2.178 -     ~form))
   2.179 +     (fn [] ~form)))
   2.180  
   2.181 -(defn with-theme* [theme f & args]
   2.182 -  (apply with-bindings* {#'*theme* (merge *theme* theme)}
   2.183 -         f args))
   2.184 -
   2.185 -(defmacro with-theme [theme & body]
   2.186 +(defmacro with-theme
   2.187 +  [theme & body]
   2.188    `(binding [*theme* (merge *theme* ~theme)]
   2.189       ~@body))
   2.190  
   2.191 -(defmacro with-color [color & body]
   2.192 +(defmacro with-color
   2.193 +  [color & body]
   2.194    `(let [color# (.getColor *graphics*)]
   2.195       (try
   2.196         (.setColor *graphics* ~color)
   2.197 @@ -212,6 +224,7 @@
   2.198      [(:x geometry) (:y geometry) (:width geometry) (:height geometry)]))
   2.199  
   2.200  (defn draw!
   2.201 +  "Draws layer."
   2.202    ([layer]
   2.203       (let [graphics (create-graphics)]
   2.204         (try
   2.205 @@ -223,11 +236,11 @@
   2.206       (let [size (layer-size layer)]
   2.207         (draw! layer x y (:width size) (:height size))))
   2.208    ([layer x y width height]
   2.209 -     (with-bounds x y width height
   2.210 -       (render! layer))))
   2.211 +     (with-bounds* x y width height render! layer)))
   2.212  
   2.213  (defn draw-anchored!
   2.214 -  "Draw with location relative to the anchor point."
   2.215 +  "Draws layer. Location is relative to the layer's anchor point for
   2.216 +   the specified alignment."
   2.217    ([layer h-align v-align x y]
   2.218       (let [anchor (anchor layer h-align v-align)]
   2.219         (draw! layer (- x (:x anchor)) (- y (:y anchor)))))