1.1 --- a/src/kryshen/indyvon/core.clj	Mon Jul 12 03:52:21 2010 +0400
     1.2 +++ b/src/kryshen/indyvon/core.clj	Mon Jul 19 15:36:08 2010 +0400
     1.3 @@ -95,33 +95,32 @@
     1.4             y2 (min y12 y22)]
     1.5         (Bounds. x1 y1 (- x2 x1) (- y2 y1)))))
     1.6  
     1.7 -(defn- ^Graphics2D create-graphics
     1.8 +(defn ^Graphics2D create-graphics
     1.9    ([]
    1.10       (create-graphics 0 0 (:width *bounds*) (:height *bounds*)))
    1.11    ([x y w h]
    1.12       (apply-theme (.create *graphics* x y w h) *theme*)))
    1.13  
    1.14 -(defn with-bounds* [x y w h f & args]
    1.15 -  (let [graphics (create-graphics x y w h)
    1.16 -        bounds (Bounds. (+ x (:x *bounds*))
    1.17 -                        (+ y (:y *bounds*))
    1.18 -                        w h)]
    1.19 -    (try
    1.20 -      (apply with-bindings* {#'*bounds* bounds
    1.21 -                             #'*clip* (intersect bounds *clip*)
    1.22 -                             #'*graphics* graphics}
    1.23 -             f args)
    1.24 -      (finally
    1.25 -       (.dispose graphics)))))
    1.26 +(defmacro with-bounds [x y w h & body]
    1.27 +  `(let [bounds# (Bounds. (+ ~x (:x *bounds*))
    1.28 +                          (+ ~y (:y *bounds*))
    1.29 +                          ~w ~h)
    1.30 +         clip# (intersect bounds# *clip*)]
    1.31 +     (when (and (pos? (:width clip#)) (pos? (:height clip#)))
    1.32 +       (let [graphics# (create-graphics ~x ~y ~w ~h)]
    1.33 +         (try
    1.34 +           (binding [*bounds* bounds#
    1.35 +                     *clip* clip#
    1.36 +                     *graphics* graphics#]
    1.37 +             ~@body)
    1.38 +           (finally
    1.39 +            (.dispose graphics#)))))))
    1.40  
    1.41 -(defmacro with-bounds [x y w h & body]
    1.42 -  `(with-bounds* ~x ~y ~w ~h (fn [] ~@body)))
    1.43 -
    1.44 -(defn with-handlers* [handle handlers f & args]
    1.45 -  (apply with-bindings*
    1.46 -         {#'*event-dispatcher*
    1.47 -          (create-dispatcher *event-dispatcher* handle handlers)}
    1.48 -         f args))
    1.49 +(defmacro with-handlers* [handle handlers & body]
    1.50 +  `(binding
    1.51 +       [*event-dispatcher*
    1.52 +        (create-dispatcher *event-dispatcher* ~handle ~handlers)]
    1.53 +     ~@body))
    1.54  
    1.55  (defmacro with-handlers
    1.56    "specs => (:event-id name & handler-body)*
    1.57 @@ -134,14 +133,15 @@
    1.58                         `(fn [~(second spec)]
    1.59                            ~@(nnext spec)))) {}
    1.60                            specs)
    1.61 -     (fn [] ~form)))
    1.62 +     ~form))
    1.63  
    1.64  (defn with-theme* [theme f & args]
    1.65    (apply with-bindings* {#'*theme* (merge *theme* theme)}
    1.66           f args))
    1.67  
    1.68  (defmacro with-theme [theme & body]
    1.69 -  `(with-theme* ~theme (fn [] ~@body)))
    1.70 +  `(binding [*theme* (merge *theme* ~theme)]
    1.71 +     ~@body))
    1.72  
    1.73  (defmacro with-color [color & body]
    1.74    `(let [color# (.getColor *graphics*)]
    1.75 @@ -160,14 +160,16 @@
    1.76    ([layer]
    1.77       (let [graphics (create-graphics)]
    1.78         (try
    1.79 -         (with-bindings* {#'*graphics* graphics} render! layer)
    1.80 +         (binding [*graphics* graphics]
    1.81 +           (render! layer))
    1.82           (finally
    1.83            (.dispose graphics)))))
    1.84    ([layer x y]
    1.85       (let [size (layer-size layer)]
    1.86         (draw! layer x y (:width size) (:height size))))
    1.87    ([layer x y width height]
    1.88 -     (with-bounds* x y width height render! layer)))
    1.89 +     (with-bounds x y width height
    1.90 +       (render! layer))))
    1.91  
    1.92  (defn draw-anchored!
    1.93    "Draw with location relative to the anchor point."
    1.94 @@ -305,7 +307,8 @@
    1.95       (mousePressed [this event]
    1.96          (dispatch-mouse-button picked hovered event))
    1.97       (mouseReleased [this event]
    1.98 -        (dispatch-mouse-button picked hovered event))
    1.99 +        (translate-and-dispatch @picked true event))
   1.100 +        ;;(dispatch-mouse-button picked hovered event))
   1.101       MouseMotionListener
   1.102       (mouseDragged [this event]
   1.103          (translate-and-dispatch @picked true event))

     2.1 --- a/src/kryshen/indyvon/graph.clj	Mon Jul 12 03:52:21 2010 +0400
     2.2 +++ b/src/kryshen/indyvon/graph.clj	Mon Jul 19 15:36:08 2010 +0400
     2.3 @@ -76,29 +76,29 @@
     2.4      (.draw *graphics* path)))
     2.5    (.translate *graphics* (- x) (- y)))
     2.6  
     2.7 -(defrecord GraphLayer [graph-layout movable dragged fix-x fix-y]
     2.8 +(defrecord GraphLayer [layout movable dragged fix-x fix-y]
     2.9    Layer
    2.10    (render! [layer]
    2.11 -     (let [bounds (.getBounds graph-layout)
    2.12 +     (let [bounds (.getBounds layout)
    2.13             x (- (.getX bounds))
    2.14             y (- (.getY bounds))]
    2.15 -       (draw-edges! graph-layout x y)
    2.16 +       (draw-edges! layout x y)
    2.17         (if movable
    2.18 -         (draw-movable-vertices! graph-layout x y dragged fix-x fix-y)
    2.19 -         (draw-vertices! graph-layout x y))))
    2.20 +         (draw-movable-vertices! layout x y dragged fix-x fix-y)
    2.21 +         (draw-vertices! layout x y))))
    2.22    (layer-size [layer]
    2.23 -     (let [bounds (.getBounds graph-layout)]
    2.24 +     (let [bounds (.getBounds layout)]
    2.25         (Size. (.getWidth bounds) (.getHeight bounds))))
    2.26    Anchored
    2.27    (anchor [layer x-align y-align]
    2.28 -          (let [bounds (.getBounds graph-layout)]
    2.29 +          (let [bounds (.getBounds layout)]
    2.30              (Location. (- (.getX bounds))
    2.31                         (- (.getY bounds))))))
    2.32  
    2.33  (defn graph-layer
    2.34    ([graph-layout]
    2.35       (graph-layer graph-layout false))
    2.36 -  ([^GraphGraph-Layout graph-layout movable]
    2.37 +  ([^GraphLayout graph-layout movable]
    2.38       (GraphLayer. graph-layout movable (ref nil) (ref 0) (ref 0))))
    2.39  
    2.40  (defn build-graph

     3.1 --- a/src/kryshen/indyvon/layers.clj	Mon Jul 12 03:52:21 2010 +0400
     3.2 +++ b/src/kryshen/indyvon/layers.clj	Mon Jul 19 15:36:08 2010 +0400
     3.3 @@ -7,7 +7,9 @@
     3.4  (ns kryshen.indyvon.layers
     3.5    (:use kryshen.indyvon.core)
     3.6    (:import (kryshen.indyvon.core Size Location)
     3.7 -           (java.awt Font Cursor)
     3.8 +           (java.lang.ref SoftReference)
     3.9 +           (java.awt Font Cursor Image Toolkit)
    3.10 +           (java.awt.image ImageObserver)
    3.11             (java.awt.font FontRenderContext TextLayout)))
    3.12  
    3.13  ;; Define as macro to avoid unnecessary calculation of inner and outer
    3.14 @@ -25,12 +27,13 @@
    3.15    `(align-xy ~inner ~outer ~align :top :center :bottom))
    3.16  
    3.17  (defmacro decorate-layer [layer & render-tail]
    3.18 -  `(reify
    3.19 -    Layer
    3.20 -    (render! ~@render-tail)
    3.21 -    (layer-size [t#] (layer-size ~layer))
    3.22 -    Anchored
    3.23 -    (anchor [t# xa# ya#] (anchor ~layer xa# ya#))))
    3.24 +  `(let [layer# ~layer]
    3.25 +     (reify
    3.26 +      Layer
    3.27 +      (render! ~@render-tail)
    3.28 +      (layer-size [t#] (layer-size layer#))
    3.29 +      Anchored
    3.30 +      (anchor [t# xa# ya#] (anchor layer# xa# ya#)))))
    3.31  
    3.32  (defn padding
    3.33    ([content pad]
    3.34 @@ -81,8 +84,24 @@
    3.35  (defn- re-split [^java.util.regex.Pattern re s]
    3.36    (seq (.split re s)))
    3.37  
    3.38 -(defn- layout-text [lines ^Font font ^FontRenderContext font-context]
    3.39 -  (map #(TextLayout. ^String % font font-context) lines))
    3.40 +(def text-layout-cache (atom {}))
    3.41 +
    3.42 +(defn- get-text-layout
    3.43 +  [^String line ^Font font ^FontRenderContext font-context]
    3.44 +  (let [key [line font font-context]]
    3.45 +    (or (if-let [softref (@text-layout-cache key)]
    3.46 +          (.get softref)
    3.47 +          (do (swap! text-layout-cache dissoc key)
    3.48 +              false))
    3.49 +        (let [layout (TextLayout. line font font-context)]
    3.50 +          (println "text-layout-cache miss" line)
    3.51 +          (swap! text-layout-cache assoc key (SoftReference. layout))
    3.52 +          layout))))
    3.53 +
    3.54 +(defn- layout-text
    3.55 +  [lines ^Font font ^FontRenderContext font-context]
    3.56 +  (map #(get-text-layout % font font-context) lines))
    3.57 +  ;;(map #(TextLayout. ^String % font font-context) lines))
    3.58  
    3.59  (defn- text-width [layouts]
    3.60    (reduce (fn [w ^TextLayout tl] (max w (.getAdvance tl))) 0 layouts))
    3.61 @@ -119,6 +138,34 @@
    3.62                   height (text-height layouts)]
    3.63               (Size. width height)))))))
    3.64  
    3.65 +(defn- image-observer [update-fn]
    3.66 +  (reify
    3.67 +   ImageObserver
    3.68 +   (imageUpdate [this img infoflags x y width height]
    3.69 +      (update-fn)
    3.70 +      (zero? (bit-and infoflags
    3.71 +                      (bit-or ImageObserver/ALLBITS
    3.72 +                              ImageObserver/ABORT))))))
    3.73 +
    3.74 +(defn image-layer
    3.75 +  [image-or-uri]
    3.76 +  (let [^Image image (if (isa? image-or-uri Image)
    3.77 +                       image-or-uri
    3.78 +                       (.createImage (Toolkit/getDefaultToolkit)
    3.79 +                                     ^java.net.URL image-or-uri))]
    3.80 +    (.prepareImage (Toolkit/getDefaultToolkit) image -1 -1 nil)
    3.81 +    (reify
    3.82 +     Layer
    3.83 +     (render! [layer]
    3.84 +        (.drawImage *graphics* image 0 0 (image-observer *update*)))
    3.85 +     (layer-size [layer]
    3.86 +        (let [observer (image-observer *update*)
    3.87 +              width (.getWidth image observer)
    3.88 +              height (.getHeight image observer)
    3.89 +              width (if (pos? width) width 1)
    3.90 +              height (if (pos? height) height 1)]
    3.91 +          (Size. width height))))))
    3.92 +
    3.93  (defn viewport
    3.94    "Creates scrollable viewport layer."
    3.95    ([content] (viewport content :left :top))
    3.96 @@ -175,9 +222,12 @@
    3.97      (reify
    3.98       Layer
    3.99       (render! [t]
   3.100 -        (with-theme* theme render! layer))
   3.101 +        (with-theme theme
   3.102 +          (render! layer)))
   3.103       (layer-size [t]
   3.104 -        (with-theme* theme layer-size layer))
   3.105 +        (with-theme theme
   3.106 +          (layer-size layer)))
   3.107       Anchored
   3.108       (anchor [t xa ya]
   3.109 -        (with-theme* theme anchor layer xa ya)))))
   3.110 +        (with-theme theme
   3.111 +          (anchor layer xa ya))))))