1.1 --- a/src/net/kryshen/indyvon/core.clj	Mon Jan 07 19:40:20 2013 +0400
     1.2 +++ b/src/net/kryshen/indyvon/core.clj	Mon Jan 07 19:51:21 2013 +0400
     1.3 @@ -399,13 +399,14 @@
     1.4  
     1.5  (defn with-bounds*
     1.6    [x y w h f & args]
     1.7 -  (let [x (long x)
     1.8 -        y (long y)
     1.9 -        w (long w)
    1.10 -        h (long h)]
    1.11 -    (when-let [clip (clip (Rectangle. x y w h))]
    1.12 -      (let [^Graphics2D graphics (create-graphics x y w h)]
    1.13 +  (let [x (double x)
    1.14 +        y (double y)
    1.15 +        bounds (Rectangle2D$Double. x y w h)]
    1.16 +    (when-let [clip (clip bounds)]
    1.17 +      (let [^Graphics2D graphics (create-graphics)]
    1.18          (try
    1.19 +          (.clip graphics bounds)
    1.20 +          (.translate graphics x y)
    1.21            (binding [*width* w
    1.22                      *height* h
    1.23                      *clip* clip
    1.24 @@ -447,21 +448,20 @@
    1.25         (finally
    1.26          (.setStroke g# old-stroke#)))))
    1.27  
    1.28 -(defn with-hints*
    1.29 -  [hints f & args]
    1.30 -  (if hints
    1.31 -    (let [g *graphics*
    1.32 -          old (.getRenderingHints g)]
    1.33 -      (try
    1.34 -        (.addRenderingHints g hints)
    1.35 -        (apply f args)
    1.36 -        (finally
    1.37 -         (.setRenderingHints g old))))
    1.38 -    (apply f args)))
    1.39 -
    1.40  (defmacro with-hints
    1.41    [hints & body]
    1.42 -  `(with-hints ~hints (fn [] ~@body)))
    1.43 +  `(let [h# ~hints
    1.44 +         g# *graphics*
    1.45 +         old# (.getRenderingHints g#)]
    1.46 +     (try
    1.47 +       (.addRenderingHints g# h#)
    1.48 +       ~@body
    1.49 +       (finally
    1.50 +        (.setRenderingHints g# old#)))))
    1.51 +
    1.52 +(defn with-hints* [hints f & args]
    1.53 +  (with-hints hints
    1.54 +    (apply f args)))
    1.55  
    1.56  ;; TODO: constructor for AffineTransform.
    1.57  ;; (transform :scale 0.3 0.5
    1.58 @@ -581,9 +581,11 @@
    1.59      (handle-picked? [_ _])
    1.60      (handle-hovered? [_ _])))
    1.61  
    1.62 -(defrecord DispatcherNode [handle handlers parent
    1.63 -                           ^Shape clip ^AffineTransform transform
    1.64 -                           bindings]
    1.65 +;; Not using defrecord to avoid unacceptable overhead of recursive
    1.66 +;; hash code calculation.
    1.67 +(deftype DispatcherNode [handle handlers parent
    1.68 +                         ^Shape clip ^AffineTransform transform
    1.69 +                         bindings]
    1.70    EventDispatcher
    1.71    (listen! [this component]
    1.72      (listen! parent component))
    1.73 @@ -607,8 +609,8 @@
    1.74                       (relative-transform)
    1.75                       bindings)))
    1.76  
    1.77 -(defn- add-node [tree node]
    1.78 -  (assoc-cons tree (:parent node) node))
    1.79 +(defn- add-node [tree ^DispatcherNode node]
    1.80 +  (assoc-cons tree (.parent node) node))
    1.81  
    1.82  (defn- nodes [tree]
    1.83    (apply concat (vals tree)))
    1.84 @@ -616,9 +618,9 @@
    1.85  (defn- under-cursor
    1.86    "Returns a vector of child nodes under cursor."
    1.87    [node tree ^long x ^long y]
    1.88 -  (some #(if (and (:clip %)
    1.89 -                  (.contains ^Shape (:clip %) x y))
    1.90 -           (conj (vec (under-cursor % tree x y)) %))
    1.91 +  (some (fn [^DispatcherNode n]
    1.92 +          (if (and (.clip n) (.contains ^Shape (.clip n) x y))
    1.93 +            (conj (vec (under-cursor n tree x y)) n)))
    1.94          (get tree node)))
    1.95  
    1.96  (defn- translate-mouse-event [^java.awt.event.MouseEvent event
    1.97 @@ -639,14 +641,14 @@
    1.98       (translate-and-dispatch nodes first-only
    1.99                               event (awt-events (.getID event))))
   1.100    ([nodes first-only event id]
   1.101 -     (if-let [node (first nodes)]
   1.102 -       (let [handlers (:handlers node)
   1.103 +     (if-let [^DispatcherNode node (first nodes)]
   1.104 +       (let [handlers (.handlers node)
   1.105               handler (get handlers id)]
   1.106           (if handler
   1.107             (do
   1.108 -             (with-bindings* (:bindings node)
   1.109 +             (with-bindings* (.bindings node)
   1.110                 handler
   1.111 -               (translate-mouse-event event (:transform node) id))
   1.112 +               (translate-mouse-event event (.transform node) id))
   1.113               (when-not first-only
   1.114                 (recur (rest nodes) false event id)))
   1.115             (when-not (and (= id :mouse-dragged)
   1.116 @@ -687,7 +689,7 @@
   1.117                                picked)
   1.118                     :else active)
   1.119              picked (seq @picked-ref)
   1.120 -            pred #(= (:handle %1) (:handle %2))
   1.121 +            pred #(= (.handle ^DispatcherNode %1) (.handle ^DispatcherNode %2))
   1.122              hovered (if picked
   1.123                        (filter #(some (partial pred %) picked) active)
   1.124                        active)
   1.125 @@ -747,9 +749,9 @@
   1.126        (translate-and-dispatch exited false event :mouse-exited)
   1.127        (translate-and-dispatch entered false event :mouse-entered)))
   1.128    (handle-picked? [dispatcher handle]
   1.129 -    (some #(= handle (:handle %)) @picked))
   1.130 +    (some #(= handle (.handle ^DispatcherNode %)) @picked))
   1.131    (handle-hovered? [dispatcher handle]
   1.132 -    (some #(= handle (:handle %)) @hovered))
   1.133 +    (some #(= handle (.handle ^DispatcherNode %)) @hovered))
   1.134    MouseListener
   1.135    (mouseEntered [dispatcher event]
   1.136      (dispatch-mouse-event dispatcher event false))