1.1 --- a/src/kryshen/indyvon/component.clj	Fri Jul 09 01:11:01 2010 +0400
     1.2 +++ b/src/kryshen/indyvon/component.clj	Fri Jul 09 11:42:58 2010 +0400
     1.3 @@ -5,11 +5,12 @@
     1.4  ;;
     1.5  
     1.6  (ns kryshen.indyvon.component
     1.7 -  (:use kryshen.indyvon.core
     1.8 -        kryshen.indyvon.layers)
     1.9 -  (:import (kryshen.indyvon.core Size Bounds)
    1.10 -           (java.awt Graphics2D Component Dimension Color)
    1.11 -           (javax.swing JFrame JPanel)))
    1.12 +  (:use
    1.13 +   kryshen.indyvon.core)
    1.14 +  (:import
    1.15 +   (kryshen.indyvon.core Size Bounds)
    1.16 +   (java.awt Graphics2D Component Dimension Color)
    1.17 +   (javax.swing JFrame JPanel)))
    1.18  
    1.19  (defn- font-context [^Component component]
    1.20    (.getFontRenderContext (.getFontMetrics component (.getFont component))))

     2.1 --- a/src/kryshen/indyvon/core.clj	Fri Jul 09 01:11:01 2010 +0400
     2.2 +++ b/src/kryshen/indyvon/core.clj	Fri Jul 09 11:42:58 2010 +0400
     2.3 @@ -5,9 +5,10 @@
     2.4  ;;
     2.5  
     2.6  (ns kryshen.indyvon.core
     2.7 -  (:import (java.awt Graphics2D Component Color Font)
     2.8 -           (java.awt.event MouseListener MouseMotionListener)
     2.9 -           (java.awt.font FontRenderContext)))
    2.10 +  (:import
    2.11 +   (java.awt Graphics2D Component Color Font)
    2.12 +   (java.awt.event MouseListener MouseMotionListener)
    2.13 +   (java.awt.font FontRenderContext)))
    2.14  
    2.15  (def ^Graphics2D *graphics*)
    2.16  (def ^FontRenderContext *font-context*)
    2.17 @@ -99,7 +100,7 @@
    2.18    ([x y w h]
    2.19       (apply-theme (.create *graphics* x y w h) *theme*)))
    2.20  
    2.21 -(defn with-translate* [x y w h f & args]
    2.22 +(defn with-bounds* [x y w h f & args]
    2.23    (let [graphics (create-graphics x y w h)
    2.24          bounds (Bounds. (+ x (:x *bounds*))
    2.25                          (+ y (:y *bounds*))
    2.26 @@ -112,8 +113,8 @@
    2.27        (finally
    2.28         (.dispose graphics)))))
    2.29  
    2.30 -(defmacro with-translate [x y w h & body]
    2.31 -  `(with-translate* ~x ~y ~w ~h (fn [] ~@body)))
    2.32 +(defmacro with-bounds [x y w h & body]
    2.33 +  `(with-bounds* ~x ~y ~w ~h (fn [] ~@body)))
    2.34  
    2.35  (defn with-handlers* [handle handlers f & args]
    2.36    (apply with-bindings*
    2.37 @@ -150,7 +151,16 @@
    2.38       (let [size (size layer)]
    2.39         (draw! layer x y (:width size) (:height size))))
    2.40    ([layer x y width height]
    2.41 -     (with-translate* x y width height render! layer)))
    2.42 +     (with-bounds* x y width height render! layer)))
    2.43 +
    2.44 +(defn draw-anchored!
    2.45 +  "Draw with location relative to the anchor point."
    2.46 +  ([layer h-align v-align x y]
    2.47 +     (let [anchor (anchor layer h-align v-align)]
    2.48 +       (draw! layer (- x (:x anchor)) (- y (:y anchor)))))
    2.49 +  ([layer h-align v-align x y w h]
    2.50 +     (let [anchor (anchor layer h-align v-align)]
    2.51 +       (draw! layer (- x (:x anchor)) (- y (:y anchor)) w h))))
    2.52  
    2.53  ;;
    2.54  ;; EventDispatcher implementation
    2.55 @@ -195,10 +205,10 @@
    2.56            (< py (+ y h)))))
    2.57  
    2.58  (defn- under-cursor
    2.59 -  "Returns a sequence of child nodes under cursor."
    2.60 +  "Returns a vector of child nodes under cursor."
    2.61    [x y tree node]
    2.62    (some #(if (inside? x y (:bounds %))
    2.63 -           (conj (under-cursor x y tree %) %))
    2.64 +           (conj (vec (under-cursor x y tree %)) %))
    2.65          (get tree node)))
    2.66  
    2.67  (defn- remove-all [coll1 coll2 pred]
    2.68 @@ -211,16 +221,22 @@
    2.69                 (.getButton event)))
    2.70  
    2.71  (defn- translate-and-dispatch
    2.72 -  ([nodes ^java.awt.event.MouseEvent event]
    2.73 -     (translate-and-dispatch nodes event (awt-events (.getID event))))
    2.74 -  ([nodes event id]
    2.75 -     (doseq [node nodes]
    2.76 -       (when-let [handler (get (:handlers node) id)]
    2.77 -         (with-bindings* (:bindings node)
    2.78 -           handler
    2.79 -           (translate-mouse-event event
    2.80 -             (-> node :bounds :x) (-> node :bounds :y) id))))
    2.81 -     id))
    2.82 +  ([nodes first-only ^java.awt.event.MouseEvent event]
    2.83 +     (translate-and-dispatch
    2.84 +      nodes first-only event (awt-events (.getID event))))
    2.85 +  ([nodes first-only event id]
    2.86 +     (if-let [node (first nodes)]
    2.87 +       (if-let [handler (get (:handlers node) id)]
    2.88 +         (do
    2.89 +           (with-bindings* (:bindings node)
    2.90 +             handler
    2.91 +             (translate-mouse-event event
    2.92 +              (-> node :bounds :x) (-> node :bounds :y) id))
    2.93 +           (if first-only
    2.94 +             id
    2.95 +             (recur (rest nodes) false event id)))
    2.96 +         (recur (rest nodes) first-only event id))
    2.97 +         id)))
    2.98  
    2.99  (defn- dispatch-mouse-motion*
   2.100    "Dispatches mouse motion events. Returns a new set of nodes which
   2.101 @@ -233,9 +249,9 @@
   2.102          exited (remove-all hovered hovered2 pred)
   2.103          entered (remove-all hovered2 hovered pred)
   2.104          moved (remove-all hovered2 entered pred)]
   2.105 -    (translate-and-dispatch exited event :mouse-exited)
   2.106 -    (translate-and-dispatch entered event :mouse-entered)
   2.107 -    (translate-and-dispatch moved event :mouse-moved)
   2.108 +    (translate-and-dispatch exited false event :mouse-exited)
   2.109 +    (translate-and-dispatch entered false event :mouse-entered)
   2.110 +    (translate-and-dispatch moved true event :mouse-moved)
   2.111      hovered2))
   2.112  
   2.113  (defn- dispatch-mouse-motion
   2.114 @@ -247,7 +263,7 @@
   2.115    "Dispatches mouse button events. Returns a new set of nodes which
   2.116    currently are picked with a pressed button."
   2.117    [picked hovered event]
   2.118 -  (if (= (translate-and-dispatch hovered event) :mouse-pressed)
   2.119 +  (if (= (translate-and-dispatch hovered true event) :mouse-pressed)
   2.120      hovered
   2.121      nil))
   2.122  
   2.123 @@ -287,7 +303,7 @@
   2.124          (dispatch-mouse-button picked hovered event))
   2.125       MouseMotionListener
   2.126       (mouseDragged [this event]
   2.127 -        (translate-and-dispatch @picked event))
   2.128 +        (translate-and-dispatch @picked true event))
   2.129       (mouseMoved [this event]
   2.130          (dispatch-mouse-motion hovered @tree this event)))))
   2.131  

     3.1 --- a/src/kryshen/indyvon/demo.clj	Fri Jul 09 01:11:01 2010 +0400
     3.2 +++ b/src/kryshen/indyvon/demo.clj	Fri Jul 09 11:42:58 2010 +0400
     3.3 @@ -6,12 +6,12 @@
     3.4  
     3.5  (ns kryshen.indyvon.demo
     3.6    (:gen-class)
     3.7 -  (:use kryshen.indyvon.core
     3.8 -        kryshen.indyvon.layers
     3.9 -        kryshen.indyvon.component)
    3.10 -  (:import (kryshen.indyvon.core Size Bounds)
    3.11 -           (java.awt Color)
    3.12 -           (javax.swing JFrame)))
    3.13 +  (:use
    3.14 +   (kryshen.indyvon core layers component))
    3.15 +  (:import
    3.16 +   (kryshen.indyvon.core Size Bounds)
    3.17 +   (java.awt Color)
    3.18 +   (javax.swing JFrame)))
    3.19  
    3.20  (def frame (JFrame. "Test"))
    3.21  
    3.22 @@ -28,7 +28,7 @@
    3.23             (:mouse-moved e (println e))))
    3.24        (size [layer] (Size. 30 20))))
    3.25  
    3.26 -(def layer1b (border-layer layer1 2 3))
    3.27 +(def layer1b (border layer1 2 3))
    3.28  
    3.29  (def layer2
    3.30       (reify
    3.31 @@ -42,10 +42,10 @@
    3.32        (size [layer] (Size. 70 65))))
    3.33  
    3.34  (def layer3
    3.35 -     (border-layer (text-layer "Sample\ntext" :right :center)))
    3.36 +     (border (text-layer "Sample\ntext" :right :center)))
    3.37  
    3.38  (defn fps-layer [fps]
    3.39 -  (border-layer (text-layer (format "%.1f" fps) :right :bottom) 0 5))
    3.40 +  (border (text-layer (format "%.1f" fps) :right :bottom) 0 5))
    3.41  
    3.42  (def fps
    3.43       (let [update-interval 0.1

     4.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
     4.2 +++ b/src/kryshen/indyvon/graph.clj	Fri Jul 09 11:42:58 2010 +0400
     4.3 @@ -0,0 +1,134 @@
     4.4 +;;
     4.5 +;; Copyright (C) 2010 Mikhail Kryshen <mikhail@kryshen.net>
     4.6 +;;
     4.7 +;; This file is part of Indyvon.
     4.8 +;;
     4.9 +
    4.10 +(ns kryshen.indyvon.graph
    4.11 +  (:use
    4.12 +   (kryshen.indyvon core component layers))
    4.13 +  (:import
    4.14 +   (kryshen.indyvon.core Location Size)
    4.15 +   (kryshen.indygraph Graph DefaultGraph GraphLayout Vertex2D Edge2D
    4.16 +                      RectangularVertex2D DefaultEdge2D)
    4.17 +   (kryshen.indygraph.fdl ForceDirectedLayout)
    4.18 +   (java.awt.geom Path2D$Double)
    4.19 +   (javax.swing JFrame)))
    4.20 +
    4.21 +(extend-type Vertex2D
    4.22 +  Layer
    4.23 +  (render! [v]
    4.24 +     (.drawOval *graphics* 0 0 (:width *bounds*) (:height *bounds*)))
    4.25 +  (size [v]
    4.26 +     (Size.
    4.27 +      (+ (.getLeftBound v) (.getRightBound v))
    4.28 +      (+ (.getTopBound v) (.getBottomBound v))))
    4.29 +  Anchored
    4.30 +  (anchor [v _ _]
    4.31 +     (Location.
    4.32 +      (.getLeftBound v)
    4.33 +      (.getTopBound v))))
    4.34 +
    4.35 +(defn- draw-vertices! [^Graph graph x y]
    4.36 +  (doseq [v (.vertices graph)]
    4.37 +    (draw-anchored! v :center :center (+ x (.getX v)) (+ y (.getY v)))))
    4.38 +
    4.39 +(defn- draw-movable-vertices!
    4.40 +  [^Graph graph x y dragged fix-x fix-y]
    4.41 +  (doseq [v (.vertices graph)]
    4.42 +    (let [x (+ x (.getX v))
    4.43 +          y (+ y (.getY v))
    4.44 +          anchor (anchor v :center :center)
    4.45 +          size (size v)
    4.46 +          x (- x (:x anchor))
    4.47 +          y (- y (:y anchor))]
    4.48 +    (with-bounds x y (:width size) (:height size)
    4.49 +      (with-handlers v
    4.50 +        (draw! v)
    4.51 +        (:mouse-pressed e
    4.52 +          (dosync (ref-set fix-x (:x-on-screen e))
    4.53 +                  (ref-set fix-y (:y-on-screen e))
    4.54 +                  (ref-set dragged v)))
    4.55 +        (:mouse-released e
    4.56 +          (dosync (if (= v @dragged)
    4.57 +                    (ref-set dragged nil))))
    4.58 +        (:mouse-dragged e
    4.59 +          (let [x (:x-on-screen e)
    4.60 +                y (:y-on-screen e)
    4.61 +                vx (.getX v)
    4.62 +                vy (.getY v)]
    4.63 +            (dosync
    4.64 +             (when @dragged
    4.65 +               (let [dx (- x @fix-x)
    4.66 +                     dy (- y @fix-y)]
    4.67 +                 (.layoutLocation v (+ vx dx) (+ vy dy))
    4.68 +                 (*update*)
    4.69 +                 (ref-set fix-x x)
    4.70 +                 (ref-set fix-y y)))))))))))
    4.71 +
    4.72 +(defn- draw-edges! [^Graph graph x y]
    4.73 +  ;; TODO: extend Layer on Edge2D and draw like vertices.
    4.74 +  (.translate *graphics* x y)
    4.75 +  (let [path (Path2D$Double.)]
    4.76 +  (doseq [^Edge2D e (.edges graph)]
    4.77 +    (.getPath e path)
    4.78 +    (.draw *graphics* path)))
    4.79 +  (.translate *graphics* (- x) (- y)))
    4.80 +
    4.81 +(defn graph-layer
    4.82 +  ([layout]
    4.83 +     (graph-layer layout false))
    4.84 +  ([^GraphLayout layout movable]
    4.85 +     (let [dragged (ref nil)
    4.86 +           fix-x (ref 0)
    4.87 +           fix-y (ref 0)]
    4.88 +       (reify
    4.89 +        Layer
    4.90 +        (render! [layer]
    4.91 +           (let [bounds (.getBounds layout)
    4.92 +                 x (- (.getX bounds))
    4.93 +                 y (- (.getY bounds))
    4.94 +                 graph (.getGraph layout)]
    4.95 +             (draw-edges! graph x y)
    4.96 +             (if movable
    4.97 +               (draw-movable-vertices! graph x y dragged fix-x fix-y)
    4.98 +               (draw-vertices! graph x y))))
    4.99 +        (size [layer]
   4.100 +           (let [bounds (.getBounds layout)]
   4.101 +             (Size. (.getWidth bounds) (.getHeight bounds))))
   4.102 +        Anchored
   4.103 +        (anchor [layer x-align y-align]
   4.104 +           (let [bounds (.getBounds layout)]
   4.105 +             (Location. (- (.getX bounds))
   4.106 +                        (- (.getY bounds)))))))))
   4.107 +
   4.108 +(defn build-graph
   4.109 +  "Returns Graph defined by a sequence of pairs of vertex ids,
   4.110 +   and a function that maps vertex id's to Vertex objects."
   4.111 +  [relations f]
   4.112 +  (let [graph (DefaultGraph.)
   4.113 +        vs (reduce #(conj %1 (first %2) (second %2)) #{} relations)
   4.114 +        vm (reduce #(assoc %1 %2 (f %2)) {} vs)
   4.115 +        vs (vals vm)
   4.116 +        es (map #(DefaultEdge2D. (vm (first %)) (vm (second %))) relations)]
   4.117 +    (doseq [v vs]
   4.118 +      (.addVertex graph v))
   4.119 +    (doseq [e es]
   4.120 +      (.addEdge graph e))
   4.121 +    graph))
   4.122 +
   4.123 +(comment
   4.124 +  (let [graph (build-graph
   4.125 +               [[1 2] [1 3] [1 4] [2 4]]
   4.126 +               (fn [_] (RectangularVertex2D. 100 30)))
   4.127 +        layout (ForceDirectedLayout. graph)
   4.128 +        frame (JFrame. "Graph test")
   4.129 +        layer (graph-layer layout true)
   4.130 +        layer (viewport layer :center :center)]
   4.131 +    (.add (.getContentPane frame) (make-jpanel layer))
   4.132 +    (while (not (.update layout)))
   4.133 +    (doto frame
   4.134 +      (.setDefaultCloseOperation JFrame/DISPOSE_ON_CLOSE)
   4.135 +      (.pack)
   4.136 +      (.setVisible true)))
   4.137 +  )

     5.1 --- a/src/kryshen/indyvon/layers.clj	Fri Jul 09 01:11:01 2010 +0400
     5.2 +++ b/src/kryshen/indyvon/layers.clj	Fri Jul 09 11:42:58 2010 +0400
     5.3 @@ -24,12 +24,12 @@
     5.4  (defmacro align-y [inner outer align]
     5.5    `(align-xy ~inner ~outer ~align :top :center :bottom))
     5.6  
     5.7 -(defn border-layer
     5.8 +(defn border
     5.9    "Decorate layer with a border."
    5.10    ([content]
    5.11 -     (border-layer content 1))
    5.12 +     (border content 1))
    5.13    ([content width]
    5.14 -     (border-layer content width 0))
    5.15 +     (border content width 0))
    5.16    ([content width gap]
    5.17       (let [offset (+ width gap)]
    5.18         (reify Layer