changeset 39:930c088e1367

Graph drawing. Some events should be dispatched only to the first handler. Code cleanup.
author Mikhail Kryshen <mikhail@kryshen.net>
date Fri, 09 Jul 2010 11:42:58 +0400
parents af3187fdc44d
children a96dfbfd6d4e
files src/kryshen/indyvon/component.clj src/kryshen/indyvon/core.clj src/kryshen/indyvon/demo.clj src/kryshen/indyvon/graph.clj src/kryshen/indyvon/layers.clj
diffstat 5 files changed, 192 insertions(+), 41 deletions(-) [+]
line wrap: on
line diff
--- a/src/kryshen/indyvon/component.clj	Fri Jul 09 01:11:01 2010 +0400
+++ b/src/kryshen/indyvon/component.clj	Fri Jul 09 11:42:58 2010 +0400
@@ -5,11 +5,12 @@
 ;;
 
 (ns kryshen.indyvon.component
-  (:use kryshen.indyvon.core
-        kryshen.indyvon.layers)
-  (:import (kryshen.indyvon.core Size Bounds)
-           (java.awt Graphics2D Component Dimension Color)
-           (javax.swing JFrame JPanel)))
+  (:use
+   kryshen.indyvon.core)
+  (:import
+   (kryshen.indyvon.core Size Bounds)
+   (java.awt Graphics2D Component Dimension Color)
+   (javax.swing JFrame JPanel)))
 
 (defn- font-context [^Component component]
   (.getFontRenderContext (.getFontMetrics component (.getFont component))))
--- a/src/kryshen/indyvon/core.clj	Fri Jul 09 01:11:01 2010 +0400
+++ b/src/kryshen/indyvon/core.clj	Fri Jul 09 11:42:58 2010 +0400
@@ -5,9 +5,10 @@
 ;;
 
 (ns kryshen.indyvon.core
-  (:import (java.awt Graphics2D Component Color Font)
-           (java.awt.event MouseListener MouseMotionListener)
-           (java.awt.font FontRenderContext)))
+  (:import
+   (java.awt Graphics2D Component Color Font)
+   (java.awt.event MouseListener MouseMotionListener)
+   (java.awt.font FontRenderContext)))
 
 (def ^Graphics2D *graphics*)
 (def ^FontRenderContext *font-context*)
@@ -99,7 +100,7 @@
   ([x y w h]
      (apply-theme (.create *graphics* x y w h) *theme*)))
 
-(defn with-translate* [x y w h f & args]
+(defn with-bounds* [x y w h f & args]
   (let [graphics (create-graphics x y w h)
         bounds (Bounds. (+ x (:x *bounds*))
                         (+ y (:y *bounds*))
@@ -112,8 +113,8 @@
       (finally
        (.dispose graphics)))))
 
-(defmacro with-translate [x y w h & body]
-  `(with-translate* ~x ~y ~w ~h (fn [] ~@body)))
+(defmacro with-bounds [x y w h & body]
+  `(with-bounds* ~x ~y ~w ~h (fn [] ~@body)))
 
 (defn with-handlers* [handle handlers f & args]
   (apply with-bindings*
@@ -150,7 +151,16 @@
      (let [size (size layer)]
        (draw! layer x y (:width size) (:height size))))
   ([layer x y width height]
-     (with-translate* x y width height render! layer)))
+     (with-bounds* x y width height render! layer)))
+
+(defn draw-anchored!
+  "Draw with location relative to the anchor point."
+  ([layer h-align v-align x y]
+     (let [anchor (anchor layer h-align v-align)]
+       (draw! layer (- x (:x anchor)) (- y (:y anchor)))))
+  ([layer h-align v-align x y w h]
+     (let [anchor (anchor layer h-align v-align)]
+       (draw! layer (- x (:x anchor)) (- y (:y anchor)) w h))))
 
 ;;
 ;; EventDispatcher implementation
@@ -195,10 +205,10 @@
           (< py (+ y h)))))
 
 (defn- under-cursor
-  "Returns a sequence of child nodes under cursor."
+  "Returns a vector of child nodes under cursor."
   [x y tree node]
   (some #(if (inside? x y (:bounds %))
-           (conj (under-cursor x y tree %) %))
+           (conj (vec (under-cursor x y tree %)) %))
         (get tree node)))
 
 (defn- remove-all [coll1 coll2 pred]
@@ -211,16 +221,22 @@
                (.getButton event)))
 
 (defn- translate-and-dispatch
-  ([nodes ^java.awt.event.MouseEvent event]
-     (translate-and-dispatch nodes event (awt-events (.getID event))))
-  ([nodes event id]
-     (doseq [node nodes]
-       (when-let [handler (get (:handlers node) id)]
-         (with-bindings* (:bindings node)
-           handler
-           (translate-mouse-event event
-             (-> node :bounds :x) (-> node :bounds :y) id))))
-     id))
+  ([nodes first-only ^java.awt.event.MouseEvent event]
+     (translate-and-dispatch
+      nodes first-only event (awt-events (.getID event))))
+  ([nodes first-only event id]
+     (if-let [node (first nodes)]
+       (if-let [handler (get (:handlers node) id)]
+         (do
+           (with-bindings* (:bindings node)
+             handler
+             (translate-mouse-event event
+              (-> node :bounds :x) (-> node :bounds :y) id))
+           (if first-only
+             id
+             (recur (rest nodes) false event id)))
+         (recur (rest nodes) first-only event id))
+         id)))
 
 (defn- dispatch-mouse-motion*
   "Dispatches mouse motion events. Returns a new set of nodes which
@@ -233,9 +249,9 @@
         exited (remove-all hovered hovered2 pred)
         entered (remove-all hovered2 hovered pred)
         moved (remove-all hovered2 entered pred)]
-    (translate-and-dispatch exited event :mouse-exited)
-    (translate-and-dispatch entered event :mouse-entered)
-    (translate-and-dispatch moved event :mouse-moved)
+    (translate-and-dispatch exited false event :mouse-exited)
+    (translate-and-dispatch entered false event :mouse-entered)
+    (translate-and-dispatch moved true event :mouse-moved)
     hovered2))
 
 (defn- dispatch-mouse-motion
@@ -247,7 +263,7 @@
   "Dispatches mouse button events. Returns a new set of nodes which
   currently are picked with a pressed button."
   [picked hovered event]
-  (if (= (translate-and-dispatch hovered event) :mouse-pressed)
+  (if (= (translate-and-dispatch hovered true event) :mouse-pressed)
     hovered
     nil))
 
@@ -287,7 +303,7 @@
         (dispatch-mouse-button picked hovered event))
      MouseMotionListener
      (mouseDragged [this event]
-        (translate-and-dispatch @picked event))
+        (translate-and-dispatch @picked true event))
      (mouseMoved [this event]
         (dispatch-mouse-motion hovered @tree this event)))))
 
--- a/src/kryshen/indyvon/demo.clj	Fri Jul 09 01:11:01 2010 +0400
+++ b/src/kryshen/indyvon/demo.clj	Fri Jul 09 11:42:58 2010 +0400
@@ -6,12 +6,12 @@
 
 (ns kryshen.indyvon.demo
   (:gen-class)
-  (:use kryshen.indyvon.core
-        kryshen.indyvon.layers
-        kryshen.indyvon.component)
-  (:import (kryshen.indyvon.core Size Bounds)
-           (java.awt Color)
-           (javax.swing JFrame)))
+  (:use
+   (kryshen.indyvon core layers component))
+  (:import
+   (kryshen.indyvon.core Size Bounds)
+   (java.awt Color)
+   (javax.swing JFrame)))
 
 (def frame (JFrame. "Test"))
 
@@ -28,7 +28,7 @@
            (:mouse-moved e (println e))))
       (size [layer] (Size. 30 20))))
 
-(def layer1b (border-layer layer1 2 3))
+(def layer1b (border layer1 2 3))
 
 (def layer2
      (reify
@@ -42,10 +42,10 @@
       (size [layer] (Size. 70 65))))
 
 (def layer3
-     (border-layer (text-layer "Sample\ntext" :right :center)))
+     (border (text-layer "Sample\ntext" :right :center)))
 
 (defn fps-layer [fps]
-  (border-layer (text-layer (format "%.1f" fps) :right :bottom) 0 5))
+  (border (text-layer (format "%.1f" fps) :right :bottom) 0 5))
 
 (def fps
      (let [update-interval 0.1
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/kryshen/indyvon/graph.clj	Fri Jul 09 11:42:58 2010 +0400
@@ -0,0 +1,134 @@
+;;
+;; Copyright (C) 2010 Mikhail Kryshen <mikhail@kryshen.net>
+;;
+;; This file is part of Indyvon.
+;;
+
+(ns kryshen.indyvon.graph
+  (:use
+   (kryshen.indyvon core component layers))
+  (:import
+   (kryshen.indyvon.core Location Size)
+   (kryshen.indygraph Graph DefaultGraph GraphLayout Vertex2D Edge2D
+                      RectangularVertex2D DefaultEdge2D)
+   (kryshen.indygraph.fdl ForceDirectedLayout)
+   (java.awt.geom Path2D$Double)
+   (javax.swing JFrame)))
+
+(extend-type Vertex2D
+  Layer
+  (render! [v]
+     (.drawOval *graphics* 0 0 (:width *bounds*) (:height *bounds*)))
+  (size [v]
+     (Size.
+      (+ (.getLeftBound v) (.getRightBound v))
+      (+ (.getTopBound v) (.getBottomBound v))))
+  Anchored
+  (anchor [v _ _]
+     (Location.
+      (.getLeftBound v)
+      (.getTopBound v))))
+
+(defn- draw-vertices! [^Graph graph x y]
+  (doseq [v (.vertices graph)]
+    (draw-anchored! v :center :center (+ x (.getX v)) (+ y (.getY v)))))
+
+(defn- draw-movable-vertices!
+  [^Graph graph x y dragged fix-x fix-y]
+  (doseq [v (.vertices graph)]
+    (let [x (+ x (.getX v))
+          y (+ y (.getY v))
+          anchor (anchor v :center :center)
+          size (size v)
+          x (- x (:x anchor))
+          y (- y (:y anchor))]
+    (with-bounds x y (:width size) (:height size)
+      (with-handlers v
+        (draw! v)
+        (:mouse-pressed e
+          (dosync (ref-set fix-x (:x-on-screen e))
+                  (ref-set fix-y (:y-on-screen e))
+                  (ref-set dragged v)))
+        (:mouse-released e
+          (dosync (if (= v @dragged)
+                    (ref-set dragged nil))))
+        (:mouse-dragged e
+          (let [x (:x-on-screen e)
+                y (:y-on-screen e)
+                vx (.getX v)
+                vy (.getY v)]
+            (dosync
+             (when @dragged
+               (let [dx (- x @fix-x)
+                     dy (- y @fix-y)]
+                 (.layoutLocation v (+ vx dx) (+ vy dy))
+                 (*update*)
+                 (ref-set fix-x x)
+                 (ref-set fix-y y)))))))))))
+
+(defn- draw-edges! [^Graph graph x y]
+  ;; TODO: extend Layer on Edge2D and draw like vertices.
+  (.translate *graphics* x y)
+  (let [path (Path2D$Double.)]
+  (doseq [^Edge2D e (.edges graph)]
+    (.getPath e path)
+    (.draw *graphics* path)))
+  (.translate *graphics* (- x) (- y)))
+
+(defn graph-layer
+  ([layout]
+     (graph-layer layout false))
+  ([^GraphLayout layout movable]
+     (let [dragged (ref nil)
+           fix-x (ref 0)
+           fix-y (ref 0)]
+       (reify
+        Layer
+        (render! [layer]
+           (let [bounds (.getBounds layout)
+                 x (- (.getX bounds))
+                 y (- (.getY bounds))
+                 graph (.getGraph layout)]
+             (draw-edges! graph x y)
+             (if movable
+               (draw-movable-vertices! graph x y dragged fix-x fix-y)
+               (draw-vertices! graph x y))))
+        (size [layer]
+           (let [bounds (.getBounds layout)]
+             (Size. (.getWidth bounds) (.getHeight bounds))))
+        Anchored
+        (anchor [layer x-align y-align]
+           (let [bounds (.getBounds layout)]
+             (Location. (- (.getX bounds))
+                        (- (.getY bounds)))))))))
+
+(defn build-graph
+  "Returns Graph defined by a sequence of pairs of vertex ids,
+   and a function that maps vertex id's to Vertex objects."
+  [relations f]
+  (let [graph (DefaultGraph.)
+        vs (reduce #(conj %1 (first %2) (second %2)) #{} relations)
+        vm (reduce #(assoc %1 %2 (f %2)) {} vs)
+        vs (vals vm)
+        es (map #(DefaultEdge2D. (vm (first %)) (vm (second %))) relations)]
+    (doseq [v vs]
+      (.addVertex graph v))
+    (doseq [e es]
+      (.addEdge graph e))
+    graph))
+
+(comment
+  (let [graph (build-graph
+               [[1 2] [1 3] [1 4] [2 4]]
+               (fn [_] (RectangularVertex2D. 100 30)))
+        layout (ForceDirectedLayout. graph)
+        frame (JFrame. "Graph test")
+        layer (graph-layer layout true)
+        layer (viewport layer :center :center)]
+    (.add (.getContentPane frame) (make-jpanel layer))
+    (while (not (.update layout)))
+    (doto frame
+      (.setDefaultCloseOperation JFrame/DISPOSE_ON_CLOSE)
+      (.pack)
+      (.setVisible true)))
+  )
--- a/src/kryshen/indyvon/layers.clj	Fri Jul 09 01:11:01 2010 +0400
+++ b/src/kryshen/indyvon/layers.clj	Fri Jul 09 11:42:58 2010 +0400
@@ -24,12 +24,12 @@
 (defmacro align-y [inner outer align]
   `(align-xy ~inner ~outer ~align :top :center :bottom))
 
-(defn border-layer
+(defn border
   "Decorate layer with a border."
   ([content]
-     (border-layer content 1))
+     (border content 1))
   ([content width]
-     (border-layer content width 0))
+     (border content width 0))
   ([content width gap]
      (let [offset (+ width gap)]
        (reify Layer