view src/kryshen/indyvon/graph.clj @ 41:2475c99fbb8c

Update graph bounds when moving vertex.
author Mikhail Kryshen <mikhail@kryshen.net>
date Sat, 10 Jul 2010 07:28:19 +0400
parents 930c088e1367
children d3e3c43df1cd
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! [^GraphLayout layout x y]
33 (doseq [v (.vertices (.getGraph layout))]
34 (draw-anchored! v :center :center (+ x (.getX v)) (+ y (.getY v)))))
36 (defn- draw-movable-vertices!
37 [^GraphLayout layout x y dragged fix-x fix-y]
38 (doseq [v (.vertices (.getGraph layout))]
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 (.updateBounds layout)
66 (*update*)
67 (ref-set fix-x x)
68 (ref-set fix-y y)))))))))))
70 (defn- draw-edges! [^GraphLayout layout x y]
71 ;; TODO: extend Layer on Edge2D and draw like vertices.
72 (.translate *graphics* x y)
73 (let [path (Path2D$Double.)]
74 (doseq [^Edge2D e (.edges (.getGraph layout))]
75 (.getPath e path)
76 (.draw *graphics* path)))
77 (.translate *graphics* (- x) (- y)))
79 (defn graph-layer
80 ([layout]
81 (graph-layer layout false))
82 ([^GraphLayout layout movable]
83 (let [dragged (ref nil)
84 fix-x (ref 0)
85 fix-y (ref 0)]
86 (reify
87 Layer
88 (render! [layer]
89 (let [bounds (.getBounds layout)
90 x (- (.getX bounds))
91 y (- (.getY bounds))]
92 (draw-edges! layout x y)
93 (if movable
94 (draw-movable-vertices! layout x y dragged fix-x fix-y)
95 (draw-vertices! layout 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 )