Mercurial > hg > indyvon
changeset 39:930c088e1367
Graph drawing.
Some events should be dispatched only to the first handler.
Code cleanup.
author | Mikhail Kryshen <mikhail@kryshen.net> |
---|---|
date | Fri, 09 Jul 2010 11:42:58 +0400 |
parents | af3187fdc44d |
children | a96dfbfd6d4e |
files | src/kryshen/indyvon/component.clj src/kryshen/indyvon/core.clj src/kryshen/indyvon/demo.clj src/kryshen/indyvon/graph.clj src/kryshen/indyvon/layers.clj |
diffstat | 5 files changed, 192 insertions(+), 41 deletions(-) [+] |
line wrap: on
line diff
--- a/src/kryshen/indyvon/component.clj Fri Jul 09 01:11:01 2010 +0400 +++ b/src/kryshen/indyvon/component.clj Fri Jul 09 11:42:58 2010 +0400 @@ -5,11 +5,12 @@ ;; (ns kryshen.indyvon.component - (:use kryshen.indyvon.core - kryshen.indyvon.layers) - (:import (kryshen.indyvon.core Size Bounds) - (java.awt Graphics2D Component Dimension Color) - (javax.swing JFrame JPanel))) + (:use + kryshen.indyvon.core) + (:import + (kryshen.indyvon.core Size Bounds) + (java.awt Graphics2D Component Dimension Color) + (javax.swing JFrame JPanel))) (defn- font-context [^Component component] (.getFontRenderContext (.getFontMetrics component (.getFont component))))
--- a/src/kryshen/indyvon/core.clj Fri Jul 09 01:11:01 2010 +0400 +++ b/src/kryshen/indyvon/core.clj Fri Jul 09 11:42:58 2010 +0400 @@ -5,9 +5,10 @@ ;; (ns kryshen.indyvon.core - (:import (java.awt Graphics2D Component Color Font) - (java.awt.event MouseListener MouseMotionListener) - (java.awt.font FontRenderContext))) + (:import + (java.awt Graphics2D Component Color Font) + (java.awt.event MouseListener MouseMotionListener) + (java.awt.font FontRenderContext))) (def ^Graphics2D *graphics*) (def ^FontRenderContext *font-context*) @@ -99,7 +100,7 @@ ([x y w h] (apply-theme (.create *graphics* x y w h) *theme*))) -(defn with-translate* [x y w h f & args] +(defn with-bounds* [x y w h f & args] (let [graphics (create-graphics x y w h) bounds (Bounds. (+ x (:x *bounds*)) (+ y (:y *bounds*)) @@ -112,8 +113,8 @@ (finally (.dispose graphics))))) -(defmacro with-translate [x y w h & body] - `(with-translate* ~x ~y ~w ~h (fn [] ~@body))) +(defmacro with-bounds [x y w h & body] + `(with-bounds* ~x ~y ~w ~h (fn [] ~@body))) (defn with-handlers* [handle handlers f & args] (apply with-bindings* @@ -150,7 +151,16 @@ (let [size (size layer)] (draw! layer x y (:width size) (:height size)))) ([layer x y width height] - (with-translate* x y width height render! layer))) + (with-bounds* x y width height render! layer))) + +(defn draw-anchored! + "Draw with location relative to the anchor point." + ([layer h-align v-align x y] + (let [anchor (anchor layer h-align v-align)] + (draw! layer (- x (:x anchor)) (- y (:y anchor))))) + ([layer h-align v-align x y w h] + (let [anchor (anchor layer h-align v-align)] + (draw! layer (- x (:x anchor)) (- y (:y anchor)) w h)))) ;; ;; EventDispatcher implementation @@ -195,10 +205,10 @@ (< py (+ y h))))) (defn- under-cursor - "Returns a sequence of child nodes under cursor." + "Returns a vector of child nodes under cursor." [x y tree node] (some #(if (inside? x y (:bounds %)) - (conj (under-cursor x y tree %) %)) + (conj (vec (under-cursor x y tree %)) %)) (get tree node))) (defn- remove-all [coll1 coll2 pred] @@ -211,16 +221,22 @@ (.getButton event))) (defn- translate-and-dispatch - ([nodes ^java.awt.event.MouseEvent event] - (translate-and-dispatch nodes event (awt-events (.getID event)))) - ([nodes event id] - (doseq [node nodes] - (when-let [handler (get (:handlers node) id)] - (with-bindings* (:bindings node) - handler - (translate-mouse-event event - (-> node :bounds :x) (-> node :bounds :y) id)))) - id)) + ([nodes first-only ^java.awt.event.MouseEvent event] + (translate-and-dispatch + nodes first-only event (awt-events (.getID event)))) + ([nodes first-only event id] + (if-let [node (first nodes)] + (if-let [handler (get (:handlers node) id)] + (do + (with-bindings* (:bindings node) + handler + (translate-mouse-event event + (-> node :bounds :x) (-> node :bounds :y) id)) + (if first-only + id + (recur (rest nodes) false event id))) + (recur (rest nodes) first-only event id)) + id))) (defn- dispatch-mouse-motion* "Dispatches mouse motion events. Returns a new set of nodes which @@ -233,9 +249,9 @@ exited (remove-all hovered hovered2 pred) entered (remove-all hovered2 hovered pred) moved (remove-all hovered2 entered pred)] - (translate-and-dispatch exited event :mouse-exited) - (translate-and-dispatch entered event :mouse-entered) - (translate-and-dispatch moved event :mouse-moved) + (translate-and-dispatch exited false event :mouse-exited) + (translate-and-dispatch entered false event :mouse-entered) + (translate-and-dispatch moved true event :mouse-moved) hovered2)) (defn- dispatch-mouse-motion @@ -247,7 +263,7 @@ "Dispatches mouse button events. Returns a new set of nodes which currently are picked with a pressed button." [picked hovered event] - (if (= (translate-and-dispatch hovered event) :mouse-pressed) + (if (= (translate-and-dispatch hovered true event) :mouse-pressed) hovered nil)) @@ -287,7 +303,7 @@ (dispatch-mouse-button picked hovered event)) MouseMotionListener (mouseDragged [this event] - (translate-and-dispatch @picked event)) + (translate-and-dispatch @picked true event)) (mouseMoved [this event] (dispatch-mouse-motion hovered @tree this event)))))
--- a/src/kryshen/indyvon/demo.clj Fri Jul 09 01:11:01 2010 +0400 +++ b/src/kryshen/indyvon/demo.clj Fri Jul 09 11:42:58 2010 +0400 @@ -6,12 +6,12 @@ (ns kryshen.indyvon.demo (:gen-class) - (:use kryshen.indyvon.core - kryshen.indyvon.layers - kryshen.indyvon.component) - (:import (kryshen.indyvon.core Size Bounds) - (java.awt Color) - (javax.swing JFrame))) + (:use + (kryshen.indyvon core layers component)) + (:import + (kryshen.indyvon.core Size Bounds) + (java.awt Color) + (javax.swing JFrame))) (def frame (JFrame. "Test")) @@ -28,7 +28,7 @@ (:mouse-moved e (println e)))) (size [layer] (Size. 30 20)))) -(def layer1b (border-layer layer1 2 3)) +(def layer1b (border layer1 2 3)) (def layer2 (reify @@ -42,10 +42,10 @@ (size [layer] (Size. 70 65)))) (def layer3 - (border-layer (text-layer "Sample\ntext" :right :center))) + (border (text-layer "Sample\ntext" :right :center))) (defn fps-layer [fps] - (border-layer (text-layer (format "%.1f" fps) :right :bottom) 0 5)) + (border (text-layer (format "%.1f" fps) :right :bottom) 0 5)) (def fps (let [update-interval 0.1
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/src/kryshen/indyvon/graph.clj Fri Jul 09 11:42:58 2010 +0400 @@ -0,0 +1,134 @@ +;; +;; 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! [^Graph graph x y] + (doseq [v (.vertices graph)] + (draw-anchored! v :center :center (+ x (.getX v)) (+ y (.getY v))))) + +(defn- draw-movable-vertices! + [^Graph graph x y dragged fix-x fix-y] + (doseq [v (.vertices graph)] + (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)) + (*update*) + (ref-set fix-x x) + (ref-set fix-y y))))))))))) + +(defn- draw-edges! [^Graph graph x y] + ;; TODO: extend Layer on Edge2D and draw like vertices. + (.translate *graphics* x y) + (let [path (Path2D$Double.)] + (doseq [^Edge2D e (.edges graph)] + (.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)) + graph (.getGraph layout)] + (draw-edges! graph x y) + (if movable + (draw-movable-vertices! graph x y dragged fix-x fix-y) + (draw-vertices! graph 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))) + )
--- a/src/kryshen/indyvon/layers.clj Fri Jul 09 01:11:01 2010 +0400 +++ b/src/kryshen/indyvon/layers.clj Fri Jul 09 11:42:58 2010 +0400 @@ -24,12 +24,12 @@ (defmacro align-y [inner outer align] `(align-xy ~inner ~outer ~align :top :center :bottom)) -(defn border-layer +(defn border "Decorate layer with a border." ([content] - (border-layer content 1)) + (border content 1)) ([content width] - (border-layer content width 0)) + (border content width 0)) ([content width gap] (let [offset (+ width gap)] (reify Layer