1.1 --- a/src/indyvon/component.clj	Wed Jul 07 05:57:49 2010 +0400
     1.2 +++ b/src/indyvon/component.clj	Wed Jul 07 07:17:08 2010 +0400
     1.3 @@ -19,11 +19,17 @@
     1.4          width (.width size)
     1.5          height (.height size)
     1.6          context (assoc context
     1.7 +                  :x 0
     1.8 +                  :y 0
     1.9 +                  :width width
    1.10 +                  :height height
    1.11 +                  :clip (indyvon.core.Bounds. 0 0 width height)
    1.12                    :target component
    1.13 +                  :graphics graphics
    1.14                    :font-context (.getFontRenderContext graphics)
    1.15                    :update-fn #(.repaint component))]
    1.16      (.clearRect graphics 0 0 width height)
    1.17 -    (draw! layer context graphics 0 0 width height false))
    1.18 +    (draw! layer context))
    1.19    (commit (:event-dispatcher context)))
    1.20  
    1.21  (defn preferred-size [component layer context]
    1.22 @@ -56,9 +62,14 @@
    1.23      (def layer1
    1.24           (reify
    1.25            Layer
    1.26 -          (render! [this context g]
    1.27 -             (.setColor g Color/RED)
    1.28 -             (.fillRect g 0 0 (:width context) (:height context)))
    1.29 +          (render! [this context]
    1.30 +             (let-handlers this [context]
    1.31 +               (doto (graphics context)
    1.32 +                 (.setColor Color/RED)
    1.33 +                 (.fillRect 0 0 (:width context) (:height context)))
    1.34 +               (:mouse-entered e (println e))
    1.35 +               (:mouse-exited e (println e))
    1.36 +               (:mouse-moved e (println e))))
    1.37            (size [this context] (Size. 30 20))))
    1.38      
    1.39      (def layer1b (border-layer layer1 2 3))
    1.40 @@ -66,11 +77,12 @@
    1.41      (def layer2
    1.42           (reify
    1.43            Layer
    1.44 -          (render! [this context g]
    1.45 -             (.setColor g Color/YELLOW)
    1.46 -             (.fillRect g 0 0 (:width context) (:height context))
    1.47 -             (draw! layer1b context g 10 5)
    1.48 -             (draw! layer1 context g 55 5))
    1.49 +          (render! [this context]
    1.50 +             (doto (graphics context)
    1.51 +               (.setColor Color/YELLOW)
    1.52 +               (.fillRect 0 0 (:width context) (:height context)))
    1.53 +             (draw! layer1b context 10 5)
    1.54 +             (draw! layer1 context 55 5))
    1.55            (size [this context] (Size. 70 65))))
    1.56      
    1.57      (def layer3
    1.58 @@ -86,8 +98,8 @@
    1.59                 fl (ref (fps-layer 0.0))]
    1.60             (reify
    1.61              Layer
    1.62 -            (render! [this c g]
    1.63 -               (draw! @fl c g)
    1.64 +            (render! [this c]
    1.65 +               (draw! @fl c)
    1.66                 (dosync
    1.67                  (alter frames + 1)
    1.68                  (let [time (System/currentTimeMillis)
    1.69 @@ -100,13 +112,14 @@
    1.70      
    1.71      (def layer
    1.72           (reify Layer
    1.73 -           (render! [this context g]
    1.74 +           (render! [this context]
    1.75               (update context)
    1.76 -             (.setColor g (rand-nth [Color/BLACK Color/BLUE Color/RED]))       
    1.77 -             (.drawLine g 0 0 (:width context) (:height context))
    1.78 -             (draw! layer2 context g 15 20)
    1.79 -             (draw! layer3 context g 100 100 80 50)
    1.80 -             (draw! fps context g))
    1.81 +             (doto (graphics context)       
    1.82 +               (.setColor (rand-nth [Color/BLACK Color/BLUE Color/RED]))
    1.83 +               (.drawLine 0 0 (:width context) (:height context)))
    1.84 +             (draw! layer2 context 15 20)
    1.85 +             (draw! layer3 context 100 100 80 50)
    1.86 +             (draw! fps context))
    1.87             (size [this context] (Size. 400 300))))
    1.88      
    1.89      (doto frame

     2.1 --- a/src/indyvon/core.clj	Wed Jul 07 05:57:49 2010 +0400
     2.2 +++ b/src/indyvon/core.clj	Wed Jul 07 07:17:08 2010 +0400
     2.3 @@ -5,16 +5,17 @@
     2.4  ;;
     2.5  
     2.6  (ns indyvon.core
     2.7 -  (:import (java.awt Graphics Component Color Font)
     2.8 +  (:import (java.awt Graphics2D Component Color Font)
     2.9             (java.awt.event MouseListener MouseMotionListener)))
    2.10  
    2.11  (defprotocol Layer
    2.12    "Basic UI element."
    2.13 -  (render! [this context graphics])
    2.14 +  (render! [this context])
    2.15    (size [this context]))
    2.16  
    2.17  (defrecord Location [x y])
    2.18  (defrecord Size [width height])
    2.19 +(defrecord Bounds [x y width height])
    2.20  
    2.21  ;; TODO: modifiers
    2.22  (defrecord MouseEvent [id when x y x-on-screen y-on-screen button])
    2.23 @@ -58,53 +59,68 @@
    2.24  (defn default-theme []
    2.25    (Theme. Color/BLACK Color/WHITE Color/BLUE (Font. "Sans" Font/PLAIN 12)))
    2.26    
    2.27 -(defrecord LayerContext [x y width height update-fn font-context
    2.28 -                         theme target event-dispatcher])
    2.29 +(defrecord LayerContext [x y width height clip
    2.30 +                         update-fn font-context theme
    2.31 +                         target event-dispatcher])
    2.32  
    2.33  (defn default-context []
    2.34 -  (LayerContext. 0 0 0 0 nil nil (default-theme) nil nil))
    2.35 +  (LayerContext. 0 0 0 0 nil nil nil (default-theme) nil nil))
    2.36  
    2.37  (defn update [context]
    2.38    ((:update-fn context)))
    2.39  
    2.40 -(defn- ^Graphics make-graphics [^Graphics graphics x y w h clip]
    2.41 -  (if clip
    2.42 -    (.create graphics x y w h)
    2.43 -    (doto (.create graphics)
    2.44 -      (.translate x y))))
    2.45 +(defn ^Graphics2D graphics
    2.46 +  "Get AWT Graphics2D from context."
    2.47 +  [context]
    2.48 +  (:graphics context))
    2.49  
    2.50 -(defn- ^Graphics apply-theme [^Graphics graphics theme]
    2.51 +(defn- ^Graphics2D make-graphics [^Graphics2D graphics x y w h]
    2.52 +  (.create graphics x y w h))
    2.53 +
    2.54 +(defn- ^Graphics2D apply-theme [^Graphics2D graphics theme]
    2.55    (doto graphics
    2.56      (.setColor (:fore-color theme))
    2.57      (.setFont (:font theme))))
    2.58  
    2.59 +(defn intersect [bounds x y w h]
    2.60 +  (let [x12 (+ x w)
    2.61 +        y12 (+ y h)
    2.62 +        x21 (:x bounds)
    2.63 +        y21 (:y bounds)
    2.64 +        x22 (+ x21 (:width bounds))
    2.65 +        y22 (+ y21 (:height bounds))
    2.66 +        x1 (max x x21)
    2.67 +        y1 (max y y21)
    2.68 +        x2 (min x12 x22)
    2.69 +        y2 (min y12 y22)]
    2.70 +    (Bounds. x1 y1 (- x2 x1) (- y2 y1))))
    2.71 +
    2.72 +(defn translate [context x y w h]
    2.73 +  (let [ax (+ (:x context) x)
    2.74 +        ay (+ (:y context) y)]
    2.75 +    (assoc context
    2.76 +      :x (+ (:x context) x)
    2.77 +      :y (+ (:y context) y)
    2.78 +      :width w
    2.79 +      :height h
    2.80 +      :clip (intersect (:clip context) ax ay w h)
    2.81 +      :graphics (apply-theme
    2.82 +                 (make-graphics (:graphics context) x y w h)
    2.83 +                 (:theme context)))))
    2.84 +
    2.85  (defn draw!
    2.86    "Render layer in a new graphics context."
    2.87 -  ([layer context graphics]
    2.88 -     (render! layer context graphics))
    2.89 -  ([layer context graphics x y]
    2.90 -     (draw! layer context graphics x y true))
    2.91 -  ([layer context graphics x y clip]
    2.92 +  ([layer context]
    2.93 +     (render! layer context))
    2.94 +  ([layer context x y]
    2.95       (let [s (size layer context)]
    2.96 -       (draw! layer context graphics
    2.97 -              x y (:width s) (:height s) clip)))
    2.98 -  ([layer context graphics x y w h]
    2.99 -     (draw! layer context graphics
   2.100 -            x y w h true))
   2.101 -  ([layer context graphics x y w h clip]
   2.102 -     (let [context (assoc context
   2.103 -                     :layer layer
   2.104 -                     :parent context
   2.105 -                     :x (+ (:x context) x)
   2.106 -                     :y (+ (:y context) y)
   2.107 -                     :width w
   2.108 -                     :height h)
   2.109 -           graphics (make-graphics graphics x y w h clip)
   2.110 -           graphics (apply-theme graphics (:theme context))]
   2.111 +       (draw! layer context x y (:width s) (:height s))))
   2.112 +  ([layer context x y w h]
   2.113 +     (let [context (translate context x y w h)]
   2.114         (try
   2.115 -         (render! layer context graphics)
   2.116 +         (render! layer context)
   2.117           (finally
   2.118 -          (.dispose graphics))))))
   2.119 +          (.dispose (:graphics context)))))))
   2.120  
   2.121  (defn add-handlers [context handle handlers]
   2.122    "Returns new context with the specified event handlers."
   2.123 @@ -113,9 +129,9 @@
   2.124      (create-dispatcher (:event-dispatcher context) context
   2.125                         handle handlers)))
   2.126  
   2.127 -(defmacro let-handlers [handle bindings & specs]
   2.128 +(defmacro let-handlers [handle bindings form & specs]
   2.129    "bindings => [binding-form context] or [context-symbol]
   2.130 -   specs => (:event-id name & handler-body)* form
   2.131 +   specs => (:event-id name & handler-body)*
   2.132  
   2.133    Execute form with the specified event handlers."
   2.134    (let [[binding context] bindings
   2.135 @@ -127,8 +143,8 @@
   2.136                          (assoc m (first spec)
   2.137                                 `(fn [~(second spec)]
   2.138                                    ~@(nnext spec)))) {}
   2.139 -                                  (butlast specs)))]
   2.140 -           ~(last specs))))
   2.141 +                                  specs))]
   2.142 +           ~form)))
   2.143  
   2.144  ;;
   2.145  ;; EventDispatcher implementation
   2.146 @@ -143,7 +159,7 @@
   2.147        java.awt.event.MouseEvent/MOUSE_PRESSED  :mouse-pressed
   2.148        java.awt.event.MouseEvent/MOUSE_RELEASED :mouse-released})
   2.149  
   2.150 -(defrecord DispatcherNode [handle handlers parent x y width height]
   2.151 +(defrecord DispatcherNode [handle handlers parent bounds]
   2.152    EventDispatcher
   2.153    (listen! [this component]
   2.154       (listen! parent component))
   2.155 @@ -153,8 +169,7 @@
   2.156       (commit parent)))
   2.157  
   2.158  (defn- make-node [c handle handlers]
   2.159 -  (DispatcherNode. handle handlers (:event-dispatcher c)
   2.160 -                   (:x c) (:y c) (:width c) (:height c)))
   2.161 +  (DispatcherNode. handle handlers (:event-dispatcher c) (:clip c)))
   2.162  
   2.163  (defn- assoc-cons [m key val]
   2.164    (assoc m key (cons val (get m key))))
   2.165 @@ -163,9 +178,9 @@
   2.166    (assoc-cons tree (:parent node) node))
   2.167  
   2.168  (defn- inside?
   2.169 -  ([x y node]
   2.170 -     (inside? x y (:x node) (:y node)
   2.171 -              (:width node) (:height node)))
   2.172 +  ([x y bounds]
   2.173 +     (inside? x y (:x bounds) (:y bounds)
   2.174 +              (:width bounds) (:height bounds)))
   2.175    ([px py x y w h]
   2.176       (and (>= px x)
   2.177            (>= py y)
   2.178 @@ -175,7 +190,7 @@
   2.179  (defn- under-cursor
   2.180    "Returns a sequence of child nodes under cursor."
   2.181    [x y tree node]
   2.182 -  (some #(if (inside? x y %)
   2.183 +  (some #(if (inside? x y (:bounds %))
   2.184             (conj (under-cursor x y tree %) %))
   2.185          (get tree node)))
   2.186  
   2.187 @@ -195,7 +210,8 @@
   2.188       (doseq [node nodes]
   2.189         (when-let [handler (get (:handlers node) id)]
   2.190           (handler
   2.191 -          (translate-mouse-event event (:x node) (:y node) id))))
   2.192 +          (translate-mouse-event event
   2.193 +            (-> node :bounds :x) (-> node :bounds :y) id))))
   2.194       id))
   2.195  
   2.196  (defn- dispatch-mouse-motion*

     3.1 --- a/src/indyvon/layers.clj	Wed Jul 07 05:57:49 2010 +0400
     3.2 +++ b/src/indyvon/layers.clj	Wed Jul 07 07:17:08 2010 +0400
     3.3 @@ -33,13 +33,13 @@
     3.4    ([content width gap]
     3.5       (let [offset (+ width gap)]
     3.6         (reify Layer
     3.7 -        (render! [l c g]
     3.8 +        (render! [l c]
     3.9             (let [w (:width c)
    3.10                   h (:height c)]
    3.11 -             (.setColor g (-> c :theme :border-color))
    3.12 +             (.setColor (graphics c) (-> c :theme :border-color))
    3.13               (doseq [i (range 0 width)]
    3.14 -               (.drawRect g i i (- w 1 i i) (- h 1 i i)))
    3.15 -             (draw! content c g offset offset (- w offset offset)
    3.16 +               (.drawRect (graphics c) i i (- w 1 i i) (- h 1 i i)))
    3.17 +             (draw! content c offset offset (- w offset offset)
    3.18                      (- h offset offset))))
    3.19          (size [l c]
    3.20             (let [s (size content c)]
    3.21 @@ -66,10 +66,10 @@
    3.22    ([text h-align v-align]
    3.23       (let [lines (re-split #"\r\n|\n|\r|\u0085|\u2028|\u2029" text)]
    3.24         (reify Layer
    3.25 -        (render! [l c g]
    3.26 +        (render! [l c]
    3.27             (let [w (:width c)
    3.28                   h (:height c)
    3.29 -                 font (.getFont g)
    3.30 +                 font (.getFont (graphics c))
    3.31                   font-context (:font-context c)
    3.32                   layouts (layout-text lines font font-context)
    3.33                   y (align-y (text-height layouts) h v-align)]
    3.34 @@ -78,7 +78,7 @@
    3.35                   (let [ascent (.getAscent layout)
    3.36                         lh (+ ascent (.getDescent layout) (.getLeading layout))
    3.37                         x (align-x (.getAdvance layout) w h-align)]
    3.38 -                   (.draw layout g x (+ y ascent))
    3.39 +                   (.draw layout (graphics c) x (+ y ascent))
    3.40                     (recur (next layouts) (+ y lh)))))))
    3.41          (size [l c]
    3.42             (let [layouts (layout-text lines
    3.43 @@ -100,8 +100,19 @@
    3.44          last-height (ref 0)]
    3.45      (reify
    3.46       Layer
    3.47 -     (render! [layer c g]
    3.48 +     (render! [layer c]
    3.49          (let-handlers layer [c]
    3.50 +         (let [anchor (anchor content c h-align v-align)
    3.51 +               width (:width c)
    3.52 +               height (:height c)]
    3.53 +           (dosync
    3.54 +            (alter x + (align-x width @last-width h-align))
    3.55 +            (alter y + (align-y height @last-height v-align))
    3.56 +            (ref-set last-width width)
    3.57 +            (ref-set last-height height))
    3.58 +           (draw! content c
    3.59 +                  (- 0 @x (:x anchor))
    3.60 +                  (- 0 @y (:y anchor))))
    3.61           (:mouse-pressed e
    3.62            (dosync
    3.63             (ref-set fix-x (:x-on-screen e))
    3.64 @@ -115,16 +126,5 @@
    3.65             (alter y + (- @fix-y (:y-on-screen e)))
    3.66             (ref-set fix-x (:x-on-screen e))
    3.67             (ref-set fix-y (:y-on-screen e)))
    3.68 -          (update c))
    3.69 -         (let [anchor (anchor content c h-align v-align)
    3.70 -               width (:width c)
    3.71 -               height (:height c)]
    3.72 -           (dosync
    3.73 -            (alter x + (align-x width @last-width h-align))
    3.74 -            (alter y + (align-y height @last-height v-align))
    3.75 -            (ref-set last-width width)
    3.76 -            (ref-set last-height height))
    3.77 -           (draw! content c g
    3.78 -                  (- 0 @x (:x anchor))
    3.79 -                  (- 0 @y (:y anchor))))))
    3.80 +          (update c))))
    3.81       (size [layer c] (size content c))))))