view src/kryshen/indyvon/graph.clj @ 42:d3e3c43df1cd

Rename size to layer-size in Layer protocol to avoid name conflict when using defrecord. Implement graph layer in defrecord.
author Mikhail Kryshen <mikhail@kryshen.net>
date Sun, 11 Jul 2010 06:34:36 +0400
parents 2475c99fbb8c
children 7d67064f0880
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 (layer-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 (layer-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 (defrecord GraphLayer [graph-layout movable dragged fix-x fix-y]
80 Layer
81 (render! [layer]
82 (let [bounds (.getBounds graph-layout)
83 x (- (.getX bounds))
84 y (- (.getY bounds))]
85 (draw-edges! graph-layout x y)
86 (if movable
87 (draw-movable-vertices! graph-layout x y dragged fix-x fix-y)
88 (draw-vertices! graph-layout x y))))
89 (layer-size [layer]
90 (let [bounds (.getBounds graph-layout)]
91 (Size. (.getWidth bounds) (.getHeight bounds))))
92 Anchored
93 (anchor [layer x-align y-align]
94 (let [bounds (.getBounds graph-layout)]
95 (Location. (- (.getX bounds))
96 (- (.getY bounds))))))
98 (defn graph-layer
99 ([graph-layout]
100 (graph-layer graph-layout false))
101 ([^GraphGraph-Layout graph-layout movable]
102 (GraphLayer. graph-layout movable (ref nil) (ref 0) (ref 0))))
104 (defn build-graph
105 "Returns Graph defined by a sequence of pairs of vertex ids,
106 and a function that maps vertex id's to Vertex objects."
107 [relations f]
108 (let [graph (DefaultGraph.)
109 vs (reduce #(conj %1 (first %2) (second %2)) #{} relations)
110 vm (reduce #(assoc %1 %2 (f %2)) {} vs)
111 vs (vals vm)
112 es (map #(DefaultEdge2D. (vm (first %)) (vm (second %))) relations)]
113 (doseq [v vs]
114 (.addVertex graph v))
115 (doseq [e es]
116 (.addEdge graph e))
117 graph))
119 (comment
120 (let [graph (build-graph
121 [[1 2] [1 3] [1 4] [2 4]]
122 (fn [_] (RectangularVertex2D. 100 30)))
123 layout (ForceDirectedLayout. graph)
124 frame (JFrame. "Graph test")
125 layer (graph-layer layout true)
126 layer (viewport layer :center :center)]
127 (.add (.getContentPane frame) (make-jpanel layer))
128 (while (not (.update layout)))
129 (doto frame
130 (.setDefaultCloseOperation JFrame/DISPOSE_ON_CLOSE)
131 (.pack)
132 (.setVisible true)))
133 )