changeset 138:e3eeb1478df1

Performance improvements.
author Mikhail Kryshen <mikhail@kryshen.net>
date Mon, 07 Jan 2013 19:51:21 +0400
parents 748f4eba4f58
children 173616375eb5
files src/net/kryshen/indyvon/core.clj
diffstat 1 files changed, 36 insertions(+), 34 deletions(-) [+]
line wrap: on
line diff
--- a/src/net/kryshen/indyvon/core.clj	Mon Jan 07 19:40:20 2013 +0400
+++ b/src/net/kryshen/indyvon/core.clj	Mon Jan 07 19:51:21 2013 +0400
@@ -399,13 +399,14 @@
 
 (defn with-bounds*
   [x y w h f & args]
-  (let [x (long x)
-        y (long y)
-        w (long w)
-        h (long h)]
-    (when-let [clip (clip (Rectangle. x y w h))]
-      (let [^Graphics2D graphics (create-graphics x y w h)]
+  (let [x (double x)
+        y (double y)
+        bounds (Rectangle2D$Double. x y w h)]
+    (when-let [clip (clip bounds)]
+      (let [^Graphics2D graphics (create-graphics)]
         (try
+          (.clip graphics bounds)
+          (.translate graphics x y)
           (binding [*width* w
                     *height* h
                     *clip* clip
@@ -447,21 +448,20 @@
        (finally
         (.setStroke g# old-stroke#)))))
 
-(defn with-hints*
-  [hints f & args]
-  (if hints
-    (let [g *graphics*
-          old (.getRenderingHints g)]
-      (try
-        (.addRenderingHints g hints)
-        (apply f args)
-        (finally
-         (.setRenderingHints g old))))
-    (apply f args)))
-
 (defmacro with-hints
   [hints & body]
-  `(with-hints ~hints (fn [] ~@body)))
+  `(let [h# ~hints
+         g# *graphics*
+         old# (.getRenderingHints g#)]
+     (try
+       (.addRenderingHints g# h#)
+       ~@body
+       (finally
+        (.setRenderingHints g# old#)))))
+
+(defn with-hints* [hints f & args]
+  (with-hints hints
+    (apply f args)))
 
 ;; TODO: constructor for AffineTransform.
 ;; (transform :scale 0.3 0.5
@@ -581,9 +581,11 @@
     (handle-picked? [_ _])
     (handle-hovered? [_ _])))
 
-(defrecord DispatcherNode [handle handlers parent
-                           ^Shape clip ^AffineTransform transform
-                           bindings]
+;; Not using defrecord to avoid unacceptable overhead of recursive
+;; hash code calculation.
+(deftype DispatcherNode [handle handlers parent
+                         ^Shape clip ^AffineTransform transform
+                         bindings]
   EventDispatcher
   (listen! [this component]
     (listen! parent component))
@@ -607,8 +609,8 @@
                      (relative-transform)
                      bindings)))
 
-(defn- add-node [tree node]
-  (assoc-cons tree (:parent node) node))
+(defn- add-node [tree ^DispatcherNode node]
+  (assoc-cons tree (.parent node) node))
 
 (defn- nodes [tree]
   (apply concat (vals tree)))
@@ -616,9 +618,9 @@
 (defn- under-cursor
   "Returns a vector of child nodes under cursor."
   [node tree ^long x ^long y]
-  (some #(if (and (:clip %)
-                  (.contains ^Shape (:clip %) x y))
-           (conj (vec (under-cursor % tree x y)) %))
+  (some (fn [^DispatcherNode n]
+          (if (and (.clip n) (.contains ^Shape (.clip n) x y))
+            (conj (vec (under-cursor n tree x y)) n)))
         (get tree node)))
 
 (defn- translate-mouse-event [^java.awt.event.MouseEvent event
@@ -639,14 +641,14 @@
      (translate-and-dispatch nodes first-only
                              event (awt-events (.getID event))))
   ([nodes first-only event id]
-     (if-let [node (first nodes)]
-       (let [handlers (:handlers node)
+     (if-let [^DispatcherNode node (first nodes)]
+       (let [handlers (.handlers node)
              handler (get handlers id)]
          (if handler
            (do
-             (with-bindings* (:bindings node)
+             (with-bindings* (.bindings node)
                handler
-               (translate-mouse-event event (:transform node) id))
+               (translate-mouse-event event (.transform node) id))
              (when-not first-only
                (recur (rest nodes) false event id)))
            (when-not (and (= id :mouse-dragged)
@@ -687,7 +689,7 @@
                               picked)
                    :else active)
             picked (seq @picked-ref)
-            pred #(= (:handle %1) (:handle %2))
+            pred #(= (.handle ^DispatcherNode %1) (.handle ^DispatcherNode %2))
             hovered (if picked
                       (filter #(some (partial pred %) picked) active)
                       active)
@@ -747,9 +749,9 @@
       (translate-and-dispatch exited false event :mouse-exited)
       (translate-and-dispatch entered false event :mouse-entered)))
   (handle-picked? [dispatcher handle]
-    (some #(= handle (:handle %)) @picked))
+    (some #(= handle (.handle ^DispatcherNode %)) @picked))
   (handle-hovered? [dispatcher handle]
-    (some #(= handle (:handle %)) @hovered))
+    (some #(= handle (.handle ^DispatcherNode %)) @hovered))
   MouseListener
   (mouseEntered [dispatcher event]
     (dispatch-mouse-event dispatcher event false))