1.1 --- a/src/net/kryshen/indyvon/component.clj	Sat Aug 14 19:03:10 2010 +0400
     1.2 +++ b/src/net/kryshen/indyvon/component.clj	Thu Aug 19 20:20:21 2010 +0400
     1.3 @@ -11,6 +11,7 @@
     1.4    (:import
     1.5     (net.kryshen.indyvon.core Size Bounds)
     1.6     (java.awt Graphics2D Component Dimension Color)
     1.7 +   (java.awt.geom Rectangle2D$Double)
     1.8     (javax.swing JFrame JPanel)))
     1.9  
    1.10  (defn- font-context [^Component component]
    1.11 @@ -25,11 +26,14 @@
    1.12      (let [bounds (Bounds. 0 0 width height)]
    1.13        (binding [*graphics* graphics
    1.14                  *font-context* (.getFontRenderContext graphics)
    1.15 +                *initial-transform* (.getTransform graphics)
    1.16 +                *inverse-initial-transform*
    1.17 +                  (-> graphics .getTransform .createInverse)
    1.18                  *target* component
    1.19                  *event-dispatcher* event-dispatcher
    1.20                  *update* #(.repaint component)
    1.21                  *bounds* bounds
    1.22 -                *clip* bounds]
    1.23 +                *clip* (Rectangle2D$Double. 0 0 width height)]
    1.24          (render! layer)
    1.25          (commit event-dispatcher)))))
    1.26  

     2.1 --- a/src/net/kryshen/indyvon/core.clj	Sat Aug 14 19:03:10 2010 +0400
     2.2 +++ b/src/net/kryshen/indyvon/core.clj	Thu Aug 19 20:20:21 2010 +0400
     2.3 @@ -6,8 +6,8 @@
     2.4  
     2.5  (ns net.kryshen.indyvon.core
     2.6    (:import
     2.7 -   (java.awt Graphics2D Component Color Font AWTEvent)
     2.8 -   (java.awt.geom AffineTransform)
     2.9 +   (java.awt Graphics2D Component Color Font AWTEvent Shape)
    2.10 +   (java.awt.geom AffineTransform Point2D$Double Rectangle2D$Double Area)
    2.11     (java.awt.event MouseListener MouseMotionListener)
    2.12     (java.awt.font FontRenderContext)))
    2.13  
    2.14 @@ -15,10 +15,13 @@
    2.15  (def ^FontRenderContext *font-context*)
    2.16  (def ^Component *target*)
    2.17  (def *bounds*)
    2.18 -(def *clip*)
    2.19 +(def ^Shape *clip*)
    2.20  (def *update*)
    2.21  (def *event-dispatcher*)
    2.22  
    2.23 +(def ^AffineTransform *initial-transform*)
    2.24 +(def ^AffineTransform *inverse-initial-transform*)
    2.25 +
    2.26  (defrecord Theme [fore-color back-color alt-back-color border-color font])
    2.27  
    2.28  (defn default-theme []
    2.29 @@ -97,6 +100,35 @@
    2.30             y2 (min y12 y22)]
    2.31         (Bounds. x1 y1 (- x2 x1) (- y2 y1)))))
    2.32  
    2.33 +(defn- relative-transform
    2.34 +  "AffineTransform: layer -> absolute -> component."
    2.35 +  []
    2.36 +  (let [tr (.getTransform *graphics*)]
    2.37 +    (.preConcatenate tr *inverse-initial-transform*)
    2.38 +    tr))
    2.39 +
    2.40 +(defn- inverse-relative-transform
    2.41 +  "AffineTransform: component (event) -> absolute -> layer."
    2.42 +  []
    2.43 +  (let [tr (.getTransform *graphics*)]
    2.44 +    (.invert tr)                          ; absolute -> layer
    2.45 +    (.concatenate tr *initial-transform*) ; component -> absolute
    2.46 +    tr))
    2.47 +
    2.48 +(defn clip
    2.49 +  "Intersect clipping area with the specified shape or bounds.
    2.50 +   Returns new clip (Shape or nil if empty)."
    2.51 +  ([x y w h]
    2.52 +     (clip (Rectangle2D$Double. x y w h)))
    2.53 +  ([shape]
    2.54 +     (let [a1 (Area. shape)
    2.55 +           a2 (if (instance? Area *clip*) *clip* (Area. *clip*))]
    2.56 +       (.transform a1 (relative-transform))
    2.57 +       (.intersect a1 a2)
    2.58 +       (if (.isEmpty a1)
    2.59 +         nil
    2.60 +         a1))))
    2.61 +
    2.62  (defn ^Graphics2D create-graphics
    2.63    ([]
    2.64       (create-graphics 0 0 (:width *bounds*) (:height *bounds*)))
    2.65 @@ -105,10 +137,9 @@
    2.66  
    2.67  (defmacro with-bounds [x y w h & body]
    2.68    `(let [bounds# (Bounds. (+ ~x (:x *bounds*))
    2.69 -                          (+ ~y (:y *bounds*))
    2.70 -                          ~w ~h)
    2.71 -         clip# (intersect bounds# *clip*)]
    2.72 -     (when (and (pos? (:width clip#)) (pos? (:height clip#)))
    2.73 +                          (+ ~y (:y *bounds*)) ~w ~h)
    2.74 +         clip# (clip ~x ~y ~w ~h)]
    2.75 +     (when clip#
    2.76         (let [graphics# (create-graphics ~x ~y ~w ~h)]
    2.77           (try
    2.78             (binding [*bounds* bounds#
    2.79 @@ -215,7 +246,9 @@
    2.80        java.awt.event.MouseEvent/MOUSE_PRESSED  :mouse-pressed
    2.81        java.awt.event.MouseEvent/MOUSE_RELEASED :mouse-released})
    2.82  
    2.83 -(defrecord DispatcherNode [handle handlers parent bounds bindings]
    2.84 +(defrecord DispatcherNode [handle handlers parent
    2.85 +                           ^Shape clip ^AffineTransform transform
    2.86 +                           bindings]
    2.87    EventDispatcher
    2.88    (listen! [this component]
    2.89       (listen! parent component))
    2.90 @@ -226,6 +259,7 @@
    2.91  
    2.92  (defn- make-node [handle handlers]
    2.93    (DispatcherNode. handle handlers *event-dispatcher* *clip*
    2.94 +                   (inverse-relative-transform)
    2.95                     (get-thread-bindings)))
    2.96  
    2.97  (defn- assoc-cons [m key val]
    2.98 @@ -234,31 +268,27 @@
    2.99  (defn- add-node [tree node]
   2.100    (assoc-cons tree (:parent node) node))
   2.101  
   2.102 -(defn- inside?
   2.103 -  ([x y bounds]
   2.104 -     (inside? x y (:x bounds) (:y bounds)
   2.105 -              (:width bounds) (:height bounds)))
   2.106 -  ([px py x y w h]
   2.107 -     (and (>= px x)
   2.108 -          (>= py y)
   2.109 -          (< px (+ x w))
   2.110 -          (< py (+ y h)))))
   2.111 -
   2.112  (defn- under-cursor
   2.113    "Returns a vector of child nodes under cursor."
   2.114    [x y tree node]
   2.115 -  (some #(if (inside? x y (:bounds %))
   2.116 +  (some #(if (.contains (:clip %) x y)
   2.117             (conj (vec (under-cursor x y tree %)) %))
   2.118          (get tree node)))
   2.119  
   2.120  (defn- remove-all [coll1 coll2 pred]
   2.121    (filter #(not (some (partial pred %) coll2)) coll1))
   2.122  
   2.123 -(defn- translate-mouse-event [^java.awt.event.MouseEvent event x y id]
   2.124 -  (MouseEvent. id (.getWhen event)
   2.125 -               (- (.getX event) x) (- (.getY event) y)
   2.126 -               (.getXOnScreen event) (.getYOnScreen event)
   2.127 -               (.getButton event)))
   2.128 +(defn- transform [^AffineTransform tr x y]
   2.129 +  (let [p (Point2D$Double. x y)]
   2.130 +    (.transform tr p p)
   2.131 +    [(.x p) (.y p)]))
   2.132 +
   2.133 +(defn- translate-mouse-event [^java.awt.event.MouseEvent event
   2.134 +                              ^AffineTransform tr id]
   2.135 +  (let [[x y] (transform tr (.getX event) (.getY event))]
   2.136 +    (MouseEvent. id (.getWhen event) x y
   2.137 +                 (.getXOnScreen event) (.getYOnScreen event)
   2.138 +                 (.getButton event))))
   2.139  
   2.140  (defn- translate-and-dispatch
   2.141    ([nodes first-only ^java.awt.event.MouseEvent event]
   2.142 @@ -270,8 +300,7 @@
   2.143           (do
   2.144             (with-bindings* (:bindings node)
   2.145               handler
   2.146 -             (translate-mouse-event event
   2.147 -               (-> node :bounds :x) (-> node :bounds :y) id))
   2.148 +             (translate-mouse-event event (:transform node) id))
   2.149             (if-not first-only
   2.150               (recur (rest nodes) false event id)))
   2.151           (recur (rest nodes) first-only event id)))))

     3.1 --- a/src/net/kryshen/indyvon/demo.clj	Sat Aug 14 19:03:10 2010 +0400
     3.2 +++ b/src/net/kryshen/indyvon/demo.clj	Thu Aug 19 20:20:21 2010 +0400
     3.3 @@ -71,7 +71,7 @@
     3.4       (reify
     3.5        Layer
     3.6        (render! [layer]
     3.7 -         (*update*)
     3.8 +         ;;(*update*)
     3.9           (doto *graphics*
    3.10             (.setColor (rand-nth [Color/BLACK Color/BLUE Color/RED]))
    3.11             (.drawLine 0 0 (:width *bounds*) (:height *bounds*)))