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 wrap: on
line source

;;
;; 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! [^GraphLayout layout x y]
  (doseq [v (.vertices (.getGraph layout))]
    (draw-anchored! v :center :center (+ x (.getX v)) (+ y (.getY v)))))

(defn- draw-movable-vertices!
  [^GraphLayout layout x y dragged fix-x fix-y]
  (doseq [v (.vertices (.getGraph layout))]
    (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))
                 (.updateBounds layout)
                 (*update*)
                 (ref-set fix-x x)
                 (ref-set fix-y y)))))))))))

(defn- draw-edges! [^GraphLayout layout x y]
  ;; TODO: extend Layer on Edge2D and draw like vertices.
  (.translate *graphics* x y)
  (let [path (Path2D$Double.)]
  (doseq [^Edge2D e (.edges (.getGraph layout))]
    (.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))]
             (draw-edges! layout x y)
             (if movable
               (draw-movable-vertices! layout x y dragged fix-x fix-y)
               (draw-vertices! layout 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)))
  )