Mercurial > hg > indyvon
view src/kryshen/indyvon/graph.clj @ 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 | |
| children | 2475c99fbb8c |
line source
1 ;;
2 ;; Copyright (C) 2010 Mikhail Kryshen <mikhail@kryshen.net>
3 ;;
4 ;; This file is part of Indyvon.
5 ;;
7 (ns kryshen.indyvon.graph
8 (:use
9 (kryshen.indyvon core component layers))
10 (:import
11 (kryshen.indyvon.core Location Size)
12 (kryshen.indygraph Graph DefaultGraph GraphLayout Vertex2D Edge2D
13 RectangularVertex2D DefaultEdge2D)
14 (kryshen.indygraph.fdl ForceDirectedLayout)
15 (java.awt.geom Path2D$Double)
16 (javax.swing JFrame)))
18 (extend-type Vertex2D
19 Layer
20 (render! [v]
21 (.drawOval *graphics* 0 0 (:width *bounds*) (:height *bounds*)))
22 (size [v]
23 (Size.
24 (+ (.getLeftBound v) (.getRightBound v))
25 (+ (.getTopBound v) (.getBottomBound v))))
26 Anchored
27 (anchor [v _ _]
28 (Location.
29 (.getLeftBound v)
30 (.getTopBound v))))
32 (defn- draw-vertices! [^Graph graph x y]
33 (doseq [v (.vertices graph)]
34 (draw-anchored! v :center :center (+ x (.getX v)) (+ y (.getY v)))))
36 (defn- draw-movable-vertices!
37 [^Graph graph x y dragged fix-x fix-y]
38 (doseq [v (.vertices graph)]
39 (let [x (+ x (.getX v))
40 y (+ y (.getY v))
41 anchor (anchor v :center :center)
42 size (size v)
43 x (- x (:x anchor))
44 y (- y (:y anchor))]
45 (with-bounds x y (:width size) (:height size)
46 (with-handlers v
47 (draw! v)
48 (:mouse-pressed e
49 (dosync (ref-set fix-x (:x-on-screen e))
50 (ref-set fix-y (:y-on-screen e))
51 (ref-set dragged v)))
52 (:mouse-released e
53 (dosync (if (= v @dragged)
54 (ref-set dragged nil))))
55 (:mouse-dragged e
56 (let [x (:x-on-screen e)
57 y (:y-on-screen e)
58 vx (.getX v)
59 vy (.getY v)]
60 (dosync
61 (when @dragged
62 (let [dx (- x @fix-x)
63 dy (- y @fix-y)]
64 (.layoutLocation v (+ vx dx) (+ vy dy))
65 (*update*)
66 (ref-set fix-x x)
67 (ref-set fix-y y)))))))))))
69 (defn- draw-edges! [^Graph graph x y]
70 ;; TODO: extend Layer on Edge2D and draw like vertices.
71 (.translate *graphics* x y)
72 (let [path (Path2D$Double.)]
73 (doseq [^Edge2D e (.edges graph)]
74 (.getPath e path)
75 (.draw *graphics* path)))
76 (.translate *graphics* (- x) (- y)))
78 (defn graph-layer
79 ([layout]
80 (graph-layer layout false))
81 ([^GraphLayout layout movable]
82 (let [dragged (ref nil)
83 fix-x (ref 0)
84 fix-y (ref 0)]
85 (reify
86 Layer
87 (render! [layer]
88 (let [bounds (.getBounds layout)
89 x (- (.getX bounds))
90 y (- (.getY bounds))
91 graph (.getGraph layout)]
92 (draw-edges! graph x y)
93 (if movable
94 (draw-movable-vertices! graph x y dragged fix-x fix-y)
95 (draw-vertices! graph x y))))
96 (size [layer]
97 (let [bounds (.getBounds layout)]
98 (Size. (.getWidth bounds) (.getHeight bounds))))
99 Anchored
100 (anchor [layer x-align y-align]
101 (let [bounds (.getBounds layout)]
102 (Location. (- (.getX bounds))
103 (- (.getY bounds)))))))))
105 (defn build-graph
106 "Returns Graph defined by a sequence of pairs of vertex ids,
107 and a function that maps vertex id's to Vertex objects."
108 [relations f]
109 (let [graph (DefaultGraph.)
110 vs (reduce #(conj %1 (first %2) (second %2)) #{} relations)
111 vm (reduce #(assoc %1 %2 (f %2)) {} vs)
112 vs (vals vm)
113 es (map #(DefaultEdge2D. (vm (first %)) (vm (second %))) relations)]
114 (doseq [v vs]
115 (.addVertex graph v))
116 (doseq [e es]
117 (.addEdge graph e))
118 graph))
120 (comment
121 (let [graph (build-graph
122 [[1 2] [1 3] [1 4] [2 4]]
123 (fn [_] (RectangularVertex2D. 100 30)))
124 layout (ForceDirectedLayout. graph)
125 frame (JFrame. "Graph test")
126 layer (graph-layer layout true)
127 layer (viewport layer :center :center)]
128 (.add (.getContentPane frame) (make-jpanel layer))
129 (while (not (.update layout)))
130 (doto frame
131 (.setDefaultCloseOperation JFrame/DISPOSE_ON_CLOSE)
132 (.pack)
133 (.setVisible true)))
134 )