Mercurial > hg > indyvon
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))) )