1.1 --- a/src/net/kryshen/indyvon/graph.clj	Sun Aug 29 03:59:10 2010 +0400
     1.2 +++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
     1.3 @@ -1,142 +0,0 @@
     1.4 -;;
     1.5 -;; Copyright (C) 2010 Mikhail Kryshen <mikhail@kryshen.net>
     1.6 -;;
     1.7 -;; This file is part of Indyvon.
     1.8 -;;
     1.9 -
    1.10 -(ns net.kryshen.indyvon.graph
    1.11 -  (:use
    1.12 -   (net.kryshen.indyvon core component layers))
    1.13 -  (:import
    1.14 -   (net.kryshen.indyvon.core Location Size)
    1.15 -   (net.kryshen.indygraph Graph DefaultGraph GraphLayout Vertex2D
    1.16 -                          Edge2D RectangularVertex2D DefaultEdge2D)
    1.17 -   (net.kryshen.indygraph.fdl ForceDirectedLayout)
    1.18 -   (java.awt.geom Path2D$Double)
    1.19 -   (javax.swing JFrame)))
    1.20 -
    1.21 -(extend-type Vertex2D
    1.22 -  Layer
    1.23 -  (render! [v]
    1.24 -     (.drawOval *graphics* 0 0 (:width *bounds*) (:height *bounds*)))
    1.25 -  (layer-size [v]
    1.26 -     (Size.
    1.27 -      (+ (.getLeftBound v) (.getRightBound v))
    1.28 -      (+ (.getTopBound v) (.getBottomBound v))))
    1.29 -  Anchored
    1.30 -  (anchor [v _ _]
    1.31 -     (Location.
    1.32 -      (.getLeftBound v)
    1.33 -      (.getTopBound v))))
    1.34 -
    1.35 -(defn- draw-vertices! [^GraphLayout layout x y]
    1.36 -  (doseq [v (.vertices (.getGraph layout))]
    1.37 -    (draw-anchored! v :center :center (+ x (.getX v)) (+ y (.getY v)))))
    1.38 -
    1.39 -(defn- draw-movable-vertex!
    1.40 -  [^Vertex2D v ^GraphLayout layout x y dragged fix-x fix-y]
    1.41 -  (let [x (+ x (.getX v))
    1.42 -        y (+ y (.getY v))
    1.43 -        anchor (anchor v :center :center)
    1.44 -        size (layer-size v)
    1.45 -        x (- x (:x anchor))
    1.46 -        y (- y (:y anchor))]
    1.47 -    (with-bounds x y (:width size) (:height size)
    1.48 -      (with-handlers v
    1.49 -        (draw! v)
    1.50 -        (:mouse-pressed e
    1.51 -          (dosync (ref-set fix-x (:x-on-screen e))
    1.52 -                  (ref-set fix-y (:y-on-screen e))
    1.53 -                  (ref-set dragged v)))
    1.54 -        (:mouse-released e
    1.55 -          (dosync (if (= v @dragged)
    1.56 -                    (ref-set dragged nil))))
    1.57 -        (:mouse-dragged e
    1.58 -          (let [x (:x-on-screen e)
    1.59 -                y (:y-on-screen e)
    1.60 -                vx (.getX v)
    1.61 -                vy (.getY v)]
    1.62 -            (dosync
    1.63 -             (when @dragged
    1.64 -               (let [dx (- x @fix-x)
    1.65 -                     dy (- y @fix-y)]
    1.66 -                 (.layoutLocation v (+ vx dx) (+ vy dy))
    1.67 -                 (.invalidateLayout layout)
    1.68 -                 (*update*)
    1.69 -                 (ref-set fix-x x)
    1.70 -                 (ref-set fix-y y))))))))))
    1.71 -  
    1.72 -(defn- draw-movable-vertices!
    1.73 -  [^GraphLayout layout x y dragged-ref fix-x fix-y]
    1.74 -  (let [dragged @dragged-ref]
    1.75 -    (doseq [v (.vertices (.getGraph layout))
    1.76 -            :when (not= v dragged)]
    1.77 -      (draw-movable-vertex! v layout x y dragged-ref fix-x fix-y))
    1.78 -    ;; Draw the vertex being dragged above others.
    1.79 -    (when dragged
    1.80 -      (draw-movable-vertex! dragged layout x y dragged-ref fix-x fix-y))))
    1.81 -    
    1.82 -(defn- draw-edges! [^GraphLayout layout x y]
    1.83 -  ;; TODO: extend Layer on Edge2D and draw like vertices.
    1.84 -  (.translate *graphics* x y)
    1.85 -  (let [path (Path2D$Double.)]
    1.86 -  (doseq [^Edge2D e (.edges (.getGraph layout))]
    1.87 -    (.getPath e path)
    1.88 -    (.draw *graphics* path)))
    1.89 -  (.translate *graphics* (- x) (- y)))
    1.90 -
    1.91 -(defrecord GraphLayer [layout movable dragged fix-x fix-y]
    1.92 -  Layer
    1.93 -  (render! [layer]
    1.94 -     (let [bounds (.getBounds layout)
    1.95 -           x (- (.getX bounds))
    1.96 -           y (- (.getY bounds))]
    1.97 -       (draw-edges! layout x y)
    1.98 -       (if movable
    1.99 -         (draw-movable-vertices! layout x y dragged fix-x fix-y)
   1.100 -         (draw-vertices! layout x y))))
   1.101 -  (layer-size [layer]
   1.102 -     (let [bounds (.getBounds layout)]
   1.103 -       (Size. (.getWidth bounds) (.getHeight bounds))))
   1.104 -  Anchored
   1.105 -  (anchor [layer x-align y-align]
   1.106 -          (let [bounds (.getBounds layout)]
   1.107 -            (Location. (- (.getX bounds))
   1.108 -                       (- (.getY bounds))))))
   1.109 -
   1.110 -(defn graph-layer
   1.111 -  ([graph-layout]
   1.112 -     (graph-layer graph-layout false))
   1.113 -  ([^GraphLayout graph-layout movable]
   1.114 -     (GraphLayer. graph-layout movable (ref nil) (ref 0) (ref 0))))
   1.115 -
   1.116 -(defn build-graph
   1.117 -  "Returns Graph defined by a sequence of pairs of vertex ids,
   1.118 -   and a function that maps vertex id's to Vertex objects."
   1.119 -  [relations f]
   1.120 -  (let [graph (DefaultGraph.)
   1.121 -        vs (reduce #(conj %1 (first %2) (second %2)) #{} relations)
   1.122 -        vm (reduce #(assoc %1 %2 (f %2)) {} vs)
   1.123 -        vs (vals vm)
   1.124 -        es (map #(DefaultEdge2D. (vm (first %)) (vm (second %))) relations)]
   1.125 -    (doseq [v vs]
   1.126 -      (.addVertex graph v))
   1.127 -    (doseq [e es]
   1.128 -      (.addEdge graph e))
   1.129 -    graph))
   1.130 -
   1.131 -(comment
   1.132 -  (let [graph (build-graph
   1.133 -               [[1 2] [1 3] [1 4] [2 4]]
   1.134 -               (fn [_] (RectangularVertex2D. 100 30)))
   1.135 -        layout (ForceDirectedLayout. graph)
   1.136 -        frame (JFrame. "Graph test")
   1.137 -        layer (graph-layer layout true)
   1.138 -        layer (viewport layer :center :center)]
   1.139 -    (.add (.getContentPane frame) (make-jpanel layer))
   1.140 -    (while (not (.update layout)))
   1.141 -    (doto frame
   1.142 -      (.setDefaultCloseOperation JFrame/DISPOSE_ON_CLOSE)
   1.143 -      (.pack)
   1.144 -      (.setVisible true)))
   1.145 -  )