changeset 49:ca728127d605

Use conventional namespace/package name.
author Mikhail Kryshen <mikhail@kryshen.net>
date Thu, 29 Jul 2010 01:08:34 +0400
parents a948ac563f6f
children 409b1b16053d
files project.clj 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 src/net/kryshen/indyvon/component.clj src/net/kryshen/indyvon/core.clj src/net/kryshen/indyvon/demo.clj src/net/kryshen/indyvon/graph.clj src/net/kryshen/indyvon/layers.clj test/indyvon/core_test.clj
diffstat 12 files changed, 865 insertions(+), 870 deletions(-) [+]
line diff
     1.1 --- a/project.clj	Wed Jul 28 04:47:30 2010 +0400
     1.2 +++ b/project.clj	Thu Jul 29 01:08:34 2010 +0400
     1.3 @@ -3,7 +3,7 @@
     1.4    :dependencies [[org.clojure/clojure "1.2.0-beta1"]
     1.5                   [org.clojure/clojure-contrib "1.2.0-beta1"]]
     1.6    :dev-dependencies [[swank-clojure/swank-clojure "1.2.1"]]
     1.7 -  :namespaces [kryshen.indyvon.core
     1.8 -               kryshen.indyvon.layers
     1.9 -               kryshen.indyvon.component
    1.10 -               kryshen.indyvon.demo])
    1.11 +  :namespaces [net.kryshen.indyvon.core
    1.12 +               net.kryshen.indyvon.layers
    1.13 +               net.kryshen.indyvon.component
    1.14 +               net.kryshen.indyvon.demo])
     2.1 --- a/src/kryshen/indyvon/component.clj	Wed Jul 28 04:47:30 2010 +0400
     2.2 +++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
     2.3 @@ -1,53 +0,0 @@
     2.4 -;;
     2.5 -;; Copyright (C) 2010 Mikhail Kryshen <mikhail@kryshen.net>
     2.6 -;;
     2.7 -;; This file is part of Indyvon.
     2.8 -;;
     2.9 -
    2.10 -(ns kryshen.indyvon.component
    2.11 -  (:use
    2.12 -   kryshen.indyvon.core)
    2.13 -  (:import
    2.14 -   (kryshen.indyvon.core Size Bounds)
    2.15 -   (java.awt Graphics2D Component Dimension Color)
    2.16 -   (javax.swing JFrame JPanel)))
    2.17 -
    2.18 -(defn- font-context [^Component component]
    2.19 -  (.getFontRenderContext (.getFontMetrics component (.getFont component))))
    2.20 -
    2.21 -(defn paint-component
    2.22 -  [^Component component layer ^Graphics2D graphics event-dispatcher]
    2.23 -  (let [size (.getSize component)
    2.24 -        width (.width size)
    2.25 -        height (.height size)]
    2.26 -    (.clearRect graphics 0 0 width height)
    2.27 -    (let [bounds (Bounds. 0 0 width height)]
    2.28 -      (binding [*graphics* graphics
    2.29 -                *font-context* (.getFontRenderContext graphics)
    2.30 -                *target* component
    2.31 -                *event-dispatcher* event-dispatcher
    2.32 -                *update* #(.repaint component)
    2.33 -                *bounds* bounds
    2.34 -                *clip* bounds]
    2.35 -        (render! layer)
    2.36 -        (commit event-dispatcher)))))
    2.37 -
    2.38 -(defn preferred-size [component layer]
    2.39 -  (binding [*target* component
    2.40 -            *font-context*' (font-context component)]
    2.41 -    (let [s (layer-size layer)]
    2.42 -      (Dimension. (:width s) (:height s)))))
    2.43 -
    2.44 -(defn make-jpanel
    2.45 -  ([layer]
    2.46 -     (make-jpanel layer (root-event-dispatcher)))
    2.47 -  ([layer event-dispatcher]
    2.48 -     (let [panel
    2.49 -           (proxy [JPanel] []
    2.50 -             (paintComponent [g]
    2.51 -                (paint-component this layer g event-dispatcher))
    2.52 -             (getPreferredSize []
    2.53 -                (preferred-size this layer)))]
    2.54 -       (.setBackground panel (:back-color *theme*))
    2.55 -       (listen! event-dispatcher panel)
    2.56 -       panel)))
     3.1 --- a/src/kryshen/indyvon/core.clj	Wed Jul 28 04:47:30 2010 +0400
     3.2 +++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
     3.3 @@ -1,341 +0,0 @@
     3.4 -;;
     3.5 -;; Copyright (C) 2010 Mikhail Kryshen <mikhail@kryshen.net>
     3.6 -;;
     3.7 -;; This file is part of Indyvon.
     3.8 -;;
     3.9 -
    3.10 -(ns kryshen.indyvon.core
    3.11 -  (:import
    3.12 -   (java.awt Graphics2D Component Color Font AWTEvent)
    3.13 -   (java.awt.event MouseListener MouseMotionListener)
    3.14 -   (java.awt.font FontRenderContext)))
    3.15 -
    3.16 -(def ^Graphics2D *graphics*)
    3.17 -(def ^FontRenderContext *font-context*)
    3.18 -(def ^Component *target*)
    3.19 -(def *bounds*)
    3.20 -(def *clip*)
    3.21 -(def *update*)
    3.22 -(def *event-dispatcher*)
    3.23 -
    3.24 -(defrecord Theme [fore-color back-color alt-back-color border-color font])
    3.25 -
    3.26 -(defn default-theme []
    3.27 -  (Theme. Color/BLACK Color/LIGHT_GRAY Color/WHITE
    3.28 -          Color/BLUE (Font. "Sans" Font/PLAIN 12)))
    3.29 -
    3.30 -(def *theme* (default-theme))
    3.31 -
    3.32 -(defrecord Location [x y])
    3.33 -(defrecord Size [width height])
    3.34 -(defrecord Bounds [x y width height])
    3.35 -
    3.36 -(defprotocol Layer
    3.37 -  "Basic UI element."
    3.38 -  (render! [this])
    3.39 -  (layer-size [this]))
    3.40 -
    3.41 -;; TODO: modifiers
    3.42 -(defrecord MouseEvent [id when x y x-on-screen y-on-screen button])
    3.43 -
    3.44 -(defprotocol EventDispatcher
    3.45 -  (listen! [this ^Component component]
    3.46 -     "Listen for events on the specified AWT Component.")
    3.47 -  (create-dispatcher [this handle handlers]
    3.48 -     "Returns new event dispatcher associated with the specified event
    3.49 -      handlers (an event-id -> handler-fn map). Handle is used to
    3.50 -      match the contexts between commits.")
    3.51 -  (commit [this]
    3.52 -     "Apply the registered handlers for event processing."))
    3.53 -
    3.54 -(defprotocol Anchored
    3.55 -  "Provide anchor point for Layers. Used by viewport."
    3.56 -  (anchor [this h-align v-align]
    3.57 -     "Anchor point: [x y], h-align could be :left, :center or :right,
    3.58 -      v-align is :top, :center or :bottom"))
    3.59 -
    3.60 -;; Default implementation of Anchored for any Layer.
    3.61 -(extend-protocol Anchored
    3.62 -  kryshen.indyvon.core.Layer
    3.63 -  (anchor [this h-align v-align]
    3.64 -          (if (and (= h-align :left)
    3.65 -                   (= v-align :top))
    3.66 -            (Location. 0 0)
    3.67 -            (let [size (layer-size this)]
    3.68 -              (Location.
    3.69 -               (case h-align
    3.70 -                     :top 0
    3.71 -                     :center (/ (:width size) 2)
    3.72 -                     :right (:width size))
    3.73 -               (case v-align
    3.74 -                     :left 0
    3.75 -                     :center (/ (:height size) 2)
    3.76 -                     :bottom (:height size)))))))
    3.77 -
    3.78 -(defn- ^Graphics2D make-graphics [^Graphics2D graphics x y w h]
    3.79 -  (.create graphics x y w h))
    3.80 -
    3.81 -(defn- ^Graphics2D apply-theme [^Graphics2D graphics theme]
    3.82 -  (doto graphics
    3.83 -    (.setColor (:fore-color theme))
    3.84 -    (.setFont (:font theme))))
    3.85 -
    3.86 -(defn intersect
    3.87 -  ([b1 b2]
    3.88 -     (let [x1 (:x b1)
    3.89 -           y1 (:y b1)
    3.90 -           x2 (:x b2)
    3.91 -           y2 (:y b2)]
    3.92 -       (intersect x1 y1 (+ x1 (:width b1)) (+ y1 (:height b1))
    3.93 -                  x2 y2 (+ x2 (:width b2)) (+ y2 (:height b2)))))
    3.94 -  ([x11 y11 x12 y12, x21 y21 x22 y22]
    3.95 -     (let [x1 (max x11 x21)
    3.96 -           y1 (max y11 y21)
    3.97 -           x2 (min x12 x22)
    3.98 -           y2 (min y12 y22)]
    3.99 -       (Bounds. x1 y1 (- x2 x1) (- y2 y1)))))
   3.100 -
   3.101 -(defn ^Graphics2D create-graphics
   3.102 -  ([]
   3.103 -     (create-graphics 0 0 (:width *bounds*) (:height *bounds*)))
   3.104 -  ([x y w h]
   3.105 -     (apply-theme (.create *graphics* x y w h) *theme*)))
   3.106 -
   3.107 -(defmacro with-bounds [x y w h & body]
   3.108 -  `(let [bounds# (Bounds. (+ ~x (:x *bounds*))
   3.109 -                          (+ ~y (:y *bounds*))
   3.110 -                          ~w ~h)
   3.111 -         clip# (intersect bounds# *clip*)]
   3.112 -     (when (and (pos? (:width clip#)) (pos? (:height clip#)))
   3.113 -       (let [graphics# (create-graphics ~x ~y ~w ~h)]
   3.114 -         (try
   3.115 -           (binding [*bounds* bounds#
   3.116 -                     *clip* clip#
   3.117 -                     *graphics* graphics#]
   3.118 -             ~@body)
   3.119 -           (finally
   3.120 -            (.dispose graphics#)))))))
   3.121 -
   3.122 -(defmacro with-handlers* [handle handlers & body]
   3.123 -  `(binding
   3.124 -       [*event-dispatcher*
   3.125 -        (create-dispatcher *event-dispatcher* ~handle ~handlers)]
   3.126 -     ~@body))
   3.127 -
   3.128 -(defmacro with-handlers
   3.129 -  "specs => (:event-id name & handler-body)*
   3.130 -
   3.131 -  Execute form with the specified event handlers."
   3.132 -  [handle form & specs]
   3.133 -  `(with-handlers* ~handle
   3.134 -     ~(reduce (fn [m spec]
   3.135 -                (assoc m (first spec)
   3.136 -                       `(fn [~(second spec)]
   3.137 -                          ~@(nnext spec)))) {}
   3.138 -                          specs)
   3.139 -     ~form))
   3.140 -
   3.141 -(defn with-theme* [theme f & args]
   3.142 -  (apply with-bindings* {#'*theme* (merge *theme* theme)}
   3.143 -         f args))
   3.144 -
   3.145 -(defmacro with-theme [theme & body]
   3.146 -  `(binding [*theme* (merge *theme* ~theme)]
   3.147 -     ~@body))
   3.148 -
   3.149 -(defmacro with-color [color & body]
   3.150 -  `(let [color# (.getColor *graphics*)]
   3.151 -     (try
   3.152 -       (.setColor *graphics* ~color)
   3.153 -       ~@body
   3.154 -       (finally
   3.155 -        (.setColor *graphics* color#)))))
   3.156 -
   3.157 -(defn- geometry-vec [geometry]
   3.158 -  (if (vector? geometry)
   3.159 -    geometry
   3.160 -    [(:x geometry) (:y geometry) (:width geometry) (:height geometry)]))
   3.161 -
   3.162 -(defn draw!
   3.163 -  ([layer]
   3.164 -     (let [graphics (create-graphics)]
   3.165 -       (try
   3.166 -         (binding [*graphics* graphics]
   3.167 -           (render! layer))
   3.168 -         (finally
   3.169 -          (.dispose graphics)))))
   3.170 -  ([layer x y]
   3.171 -     (let [size (layer-size layer)]
   3.172 -       (draw! layer x y (:width size) (:height size))))
   3.173 -  ([layer x y width height]
   3.174 -     (with-bounds x y width height
   3.175 -       (render! layer))))
   3.176 -
   3.177 -(defn draw-anchored!
   3.178 -  "Draw with location relative to the anchor point."
   3.179 -  ([layer h-align v-align x y]
   3.180 -     (let [anchor (anchor layer h-align v-align)]
   3.181 -       (draw! layer (- x (:x anchor)) (- y (:y anchor)))))
   3.182 -  ([layer h-align v-align x y w h]
   3.183 -     (let [anchor (anchor layer h-align v-align)]
   3.184 -       (draw! layer (- x (:x anchor)) (- y (:y anchor)) w h))))
   3.185 -
   3.186 -;;
   3.187 -;; EventDispatcher implementation
   3.188 -;;
   3.189 -
   3.190 -(def awt-events
   3.191 -     {java.awt.event.MouseEvent/MOUSE_CLICKED  :mouse-clicked
   3.192 -      java.awt.event.MouseEvent/MOUSE_DRAGGED  :mouse-dragged
   3.193 -      java.awt.event.MouseEvent/MOUSE_ENTERED  :mouse-entered
   3.194 -      java.awt.event.MouseEvent/MOUSE_EXITED   :mouse-exited
   3.195 -      java.awt.event.MouseEvent/MOUSE_MOVED    :mouse-moved
   3.196 -      java.awt.event.MouseEvent/MOUSE_PRESSED  :mouse-pressed
   3.197 -      java.awt.event.MouseEvent/MOUSE_RELEASED :mouse-released})
   3.198 -
   3.199 -(defrecord DispatcherNode [handle handlers parent bounds bindings]
   3.200 -  EventDispatcher
   3.201 -  (listen! [this component]
   3.202 -     (listen! parent component))
   3.203 -  (create-dispatcher [this handle handlers]
   3.204 -     (create-dispatcher parent handle handlers))
   3.205 -  (commit [this]
   3.206 -     (commit parent)))
   3.207 -
   3.208 -(defn- make-node [handle handlers]
   3.209 -  (DispatcherNode. handle handlers *event-dispatcher* *clip*
   3.210 -                   (get-thread-bindings)))
   3.211 -
   3.212 -(defn- assoc-cons [m key val]
   3.213 -  (assoc m key (cons val (get m key))))
   3.214 -
   3.215 -(defn- add-node [tree node]
   3.216 -  (assoc-cons tree (:parent node) node))
   3.217 -
   3.218 -(defn- inside?
   3.219 -  ([x y bounds]
   3.220 -     (inside? x y (:x bounds) (:y bounds)
   3.221 -              (:width bounds) (:height bounds)))
   3.222 -  ([px py x y w h]
   3.223 -     (and (>= px x)
   3.224 -          (>= py y)
   3.225 -          (< px (+ x w))
   3.226 -          (< py (+ y h)))))
   3.227 -
   3.228 -(defn- under-cursor
   3.229 -  "Returns a vector of child nodes under cursor."
   3.230 -  [x y tree node]
   3.231 -  (some #(if (inside? x y (:bounds %))
   3.232 -           (conj (vec (under-cursor x y tree %)) %))
   3.233 -        (get tree node)))
   3.234 -
   3.235 -(defn- remove-all [coll1 coll2 pred]
   3.236 -  (filter #(not (some (partial pred %) coll2)) coll1))
   3.237 -
   3.238 -(defn- translate-mouse-event [^java.awt.event.MouseEvent event x y id]
   3.239 -  (MouseEvent. id (.getWhen event)
   3.240 -               (- (.getX event) x) (- (.getY event) y)
   3.241 -               (.getXOnScreen event) (.getYOnScreen event)
   3.242 -               (.getButton event)))
   3.243 -
   3.244 -(defn- translate-and-dispatch
   3.245 -  ([nodes first-only ^java.awt.event.MouseEvent event]
   3.246 -     (translate-and-dispatch nodes first-only
   3.247 -       event (awt-events (.getID event))))
   3.248 -  ([nodes first-only event id]
   3.249 -     (if-let [node (first nodes)]
   3.250 -       (if-let [handler (get (:handlers node) id)]
   3.251 -         (do
   3.252 -           (with-bindings* (:bindings node)
   3.253 -             handler
   3.254 -             (translate-mouse-event event
   3.255 -               (-> node :bounds :x) (-> node :bounds :y) id))
   3.256 -           (if-not first-only
   3.257 -             (recur (rest nodes) false event id)))
   3.258 -         (recur (rest nodes) first-only event id)))))
   3.259 -
   3.260 -(defn- dispatch-mouse-motion
   3.261 -  "Dispatches mouse motion events."
   3.262 -  [hovered-ref tree root ^java.awt.event.MouseEvent event]
   3.263 -  (let [x (.getX event)
   3.264 -        y (.getY event)
   3.265 -        [hovered hovered2] (dosync
   3.266 -                            [@hovered-ref
   3.267 -                             (ref-set hovered-ref
   3.268 -                                      (under-cursor x y tree root))])
   3.269 -        pred #(= (:handle %1) (:handle %2))
   3.270 -        exited (remove-all hovered hovered2 pred)
   3.271 -        entered (remove-all hovered2 hovered pred)
   3.272 -        moved (remove-all hovered2 entered pred)]
   3.273 -    (translate-and-dispatch exited false event :mouse-exited)
   3.274 -    (translate-and-dispatch entered false event :mouse-entered)
   3.275 -    (translate-and-dispatch moved true event :mouse-moved)))
   3.276 -
   3.277 -(defn- dispatch-mouse-button
   3.278 -  [picked-ref hovered-ref ^java.awt.event.MouseEvent event]
   3.279 -  (let [id (awt-events (.getID event))
   3.280 -        hovered (if (= id :mouse-pressed)
   3.281 -                  (dosync (ref-set picked-ref @hovered-ref))
   3.282 -                  @hovered-ref)]
   3.283 -    (translate-and-dispatch hovered true event id)))
   3.284 -
   3.285 -(defn root-event-dispatcher []
   3.286 -  (let [tree-r (ref {})   ; register
   3.287 -        tree (ref {})     ; dispatch
   3.288 -        hovered (ref '())
   3.289 -        picked (ref '())]
   3.290 -    (reify
   3.291 -     EventDispatcher
   3.292 -     (listen! [this component]
   3.293 -        (doto component
   3.294 -          (.addMouseListener this)
   3.295 -          (.addMouseMotionListener this)))
   3.296 -     (create-dispatcher [this handle handlers]
   3.297 -        (let [node (make-node handle handlers)]
   3.298 -          (dosync (alter tree-r add-node node))
   3.299 -          node))
   3.300 -     (commit [this]
   3.301 -        (dosync (ref-set tree @tree-r)
   3.302 -                (ref-set tree-r {})))
   3.303 -     MouseListener
   3.304 -     (mouseEntered [this event]
   3.305 -        (dispatch-mouse-motion hovered @tree this event))
   3.306 -     (mouseExited [this event]
   3.307 -        (dispatch-mouse-motion hovered @tree this event))
   3.308 -     (mouseClicked [this event]
   3.309 -        (dispatch-mouse-button picked hovered event))
   3.310 -     (mousePressed [this event]
   3.311 -        (dispatch-mouse-button picked hovered event))
   3.312 -     (mouseReleased [this event]
   3.313 -        (translate-and-dispatch @picked true event))
   3.314 -        ;;(dispatch-mouse-button picked hovered event))
   3.315 -     MouseMotionListener
   3.316 -     (mouseDragged [this event]
   3.317 -        (translate-and-dispatch @picked true event))
   3.318 -     (mouseMoved [this event]
   3.319 -        (dispatch-mouse-motion hovered @tree this event)))))
   3.320 -
   3.321 -;;
   3.322 -;; ИДЕИ:
   3.323 -;;
   3.324 -;; Контекст: биндинги или запись?
   3.325 -;;
   3.326 -;; Установка обработчиков (в контексте слоя):
   3.327 -;;
   3.328 -;; (listen
   3.329 -;;   (:mouse-entered e
   3.330 -;;     ...)
   3.331 -;;   (:mouse-exited e
   3.332 -;;     ...))
   3.333 -;;
   3.334 -;; Не надо IMGUI.
   3.335 -;; Построение сцены путем декорирования слоев:
   3.336 -;;
   3.337 -;; (listener
   3.338 -;;  (:action e (println e))
   3.339 -;;  (:mouse-dragged e (println e))
   3.340 -;;  (theme :font "Helvetica-14"
   3.341 -;;    (vbox
   3.342 -;;      (button (text-layer "Button 1"))
   3.343 -;;      (button (text-layer "Button 2")))))
   3.344 -;;
     4.1 --- a/src/kryshen/indyvon/demo.clj	Wed Jul 28 04:47:30 2010 +0400
     4.2 +++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
     4.3 @@ -1,90 +0,0 @@
     4.4 -;;
     4.5 -;; Copyright (C) 2010 Mikhail Kryshen <mikhail@kryshen.net>
     4.6 -;;
     4.7 -;; This file is part of Indyvon.
     4.8 -;;
     4.9 -
    4.10 -(ns kryshen.indyvon.demo
    4.11 -  (:gen-class)
    4.12 -  (:use
    4.13 -   (kryshen.indyvon core layers component))
    4.14 -  (:import
    4.15 -   (kryshen.indyvon.core Size Bounds)
    4.16 -   (java.awt Color)
    4.17 -   (javax.swing JFrame)))
    4.18 -
    4.19 -(def frame (JFrame. "Test"))
    4.20 -
    4.21 -(def layer1
    4.22 -     (reify
    4.23 -      Layer
    4.24 -      (render! [layer]
    4.25 -         (with-handlers layer
    4.26 -           (doto *graphics*
    4.27 -             (.setColor Color/RED)
    4.28 -             (.fillRect 0 0 (:width *bounds*) (:height *bounds*)))
    4.29 -           (:mouse-entered e (println e))
    4.30 -           (:mouse-exited e (println e))
    4.31 -           (:mouse-moved e (println e))))
    4.32 -      (layer-size [layer] (Size. 30 20))))
    4.33 -
    4.34 -(def layer1b (border layer1 2 3))
    4.35 -
    4.36 -(def layer2
    4.37 -     (reify
    4.38 -      Layer
    4.39 -      (render! [layer]
    4.40 -         (doto *graphics*
    4.41 -           (.setColor Color/YELLOW)
    4.42 -           (.fillRect 0 0 (:width *bounds*) (:height *bounds*)))
    4.43 -         (draw! layer1b 10 5)
    4.44 -         (draw! layer1 55 5))
    4.45 -      (layer-size [layer] (Size. 70 65))))
    4.46 -
    4.47 -(def layer3
    4.48 -     (border (text-layer "Sample\ntext" :right :center)))
    4.49 -
    4.50 -(defn fps-layer [fps]
    4.51 -  (border (text-layer (format "%.1f" fps) :right :bottom) 0 5))
    4.52 -
    4.53 -(def fps
    4.54 -     (let [update-interval 0.1
    4.55 -           frames (ref 0)
    4.56 -           last (ref 0)
    4.57 -           fl (ref (fps-layer 0.0))]
    4.58 -       (reify
    4.59 -        Layer
    4.60 -        (render! [layer]
    4.61 -           (draw! @fl)
    4.62 -           (dosync
    4.63 -            (alter frames + 1)
    4.64 -            (let [time (System/currentTimeMillis)
    4.65 -                  elapsed (/ (- time @last) 1000.0)]
    4.66 -              (when (> elapsed update-interval)
    4.67 -                (ref-set fl (fps-layer (/ @frames elapsed)))
    4.68 -                (ref-set frames 0)
    4.69 -                (ref-set last time)))))
    4.70 -        (layer-size [layer] (layer-size @fl)))))
    4.71 -
    4.72 -(def layer
    4.73 -     (reify
    4.74 -      Layer
    4.75 -      (render! [layer]
    4.76 -         (*update*)
    4.77 -         (doto *graphics*
    4.78 -           (.setColor (rand-nth [Color/BLACK Color/BLUE Color/RED]))
    4.79 -           (.drawLine 0 0 (:width *bounds*) (:height *bounds*)))
    4.80 -         (draw! layer2 15 20)
    4.81 -         (draw! layer3 100 100 80 50)
    4.82 -         (draw! fps))
    4.83 -      (layer-size [layer] (Size. 400 300))))
    4.84 -
    4.85 -(defn -main []
    4.86 -  (doto frame
    4.87 -    (.addWindowListener
    4.88 -     (proxy [java.awt.event.WindowAdapter] []
    4.89 -       (windowClosing [event] (.dispose frame))))
    4.90 -    (.. (getContentPane) (add (make-jpanel (viewport layer))))
    4.91 -    (.pack)
    4.92 -    (.setVisible true)))
    4.93 -
     5.1 --- a/src/kryshen/indyvon/graph.clj	Wed Jul 28 04:47:30 2010 +0400
     5.2 +++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
     5.3 @@ -1,142 +0,0 @@
     5.4 -;;
     5.5 -;; Copyright (C) 2010 Mikhail Kryshen <mikhail@kryshen.net>
     5.6 -;;
     5.7 -;; This file is part of Indyvon.
     5.8 -;;
     5.9 -
    5.10 -(ns kryshen.indyvon.graph
    5.11 -  (:use
    5.12 -   (kryshen.indyvon core component layers))
    5.13 -  (:import
    5.14 -   (kryshen.indyvon.core Location Size)
    5.15 -   (kryshen.indygraph Graph DefaultGraph GraphLayout Vertex2D Edge2D
    5.16 -                      RectangularVertex2D DefaultEdge2D)
    5.17 -   (kryshen.indygraph.fdl ForceDirectedLayout)
    5.18 -   (java.awt.geom Path2D$Double)
    5.19 -   (javax.swing JFrame)))
    5.20 -
    5.21 -(extend-type Vertex2D
    5.22 -  Layer
    5.23 -  (render! [v]
    5.24 -     (.drawOval *graphics* 0 0 (:width *bounds*) (:height *bounds*)))
    5.25 -  (layer-size [v]
    5.26 -     (Size.
    5.27 -      (+ (.getLeftBound v) (.getRightBound v))
    5.28 -      (+ (.getTopBound v) (.getBottomBound v))))
    5.29 -  Anchored
    5.30 -  (anchor [v _ _]
    5.31 -     (Location.
    5.32 -      (.getLeftBound v)
    5.33 -      (.getTopBound v))))
    5.34 -
    5.35 -(defn- draw-vertices! [^GraphLayout layout x y]
    5.36 -  (doseq [v (.vertices (.getGraph layout))]
    5.37 -    (draw-anchored! v :center :center (+ x (.getX v)) (+ y (.getY v)))))
    5.38 -
    5.39 -(defn- draw-movable-vertex!
    5.40 -  [^Vertex2D v ^GraphLayout layout x y dragged fix-x fix-y]
    5.41 -  (let [x (+ x (.getX v))
    5.42 -        y (+ y (.getY v))
    5.43 -        anchor (anchor v :center :center)
    5.44 -        size (layer-size v)
    5.45 -        x (- x (:x anchor))
    5.46 -        y (- y (:y anchor))]
    5.47 -    (with-bounds x y (:width size) (:height size)
    5.48 -      (with-handlers v
    5.49 -        (draw! v)
    5.50 -        (:mouse-pressed e
    5.51 -          (dosync (ref-set fix-x (:x-on-screen e))
    5.52 -                  (ref-set fix-y (:y-on-screen e))
    5.53 -                  (ref-set dragged v)))
    5.54 -        (:mouse-released e
    5.55 -          (dosync (if (= v @dragged)
    5.56 -                    (ref-set dragged nil))))
    5.57 -        (:mouse-dragged e
    5.58 -          (let [x (:x-on-screen e)
    5.59 -                y (:y-on-screen e)
    5.60 -                vx (.getX v)
    5.61 -                vy (.getY v)]
    5.62 -            (dosync
    5.63 -             (when @dragged
    5.64 -               (let [dx (- x @fix-x)
    5.65 -                     dy (- y @fix-y)]
    5.66 -                 (.layoutLocation v (+ vx dx) (+ vy dy))
    5.67 -                 (.invalidateLayout layout)
    5.68 -                 (*update*)
    5.69 -                 (ref-set fix-x x)
    5.70 -                 (ref-set fix-y y))))))))))
    5.71 -  
    5.72 -(defn- draw-movable-vertices!
    5.73 -  [^GraphLayout layout x y dragged-ref fix-x fix-y]
    5.74 -  (let [dragged @dragged-ref]
    5.75 -    (doseq [v (.vertices (.getGraph layout))
    5.76 -            :when (not= v dragged)]
    5.77 -      (draw-movable-vertex! v layout x y dragged-ref fix-x fix-y))
    5.78 -    ;; Draw the vertex being dragged above others.
    5.79 -    (when dragged
    5.80 -      (draw-movable-vertex! dragged layout x y dragged-ref fix-x fix-y))))
    5.81 -    
    5.82 -(defn- draw-edges! [^GraphLayout layout x y]
    5.83 -  ;; TODO: extend Layer on Edge2D and draw like vertices.
    5.84 -  (.translate *graphics* x y)
    5.85 -  (let [path (Path2D$Double.)]
    5.86 -  (doseq [^Edge2D e (.edges (.getGraph layout))]
    5.87 -    (.getPath e path)
    5.88 -    (.draw *graphics* path)))
    5.89 -  (.translate *graphics* (- x) (- y)))
    5.90 -
    5.91 -(defrecord GraphLayer [layout movable dragged fix-x fix-y]
    5.92 -  Layer
    5.93 -  (render! [layer]
    5.94 -     (let [bounds (.getBounds layout)
    5.95 -           x (- (.getX bounds))
    5.96 -           y (- (.getY bounds))]
    5.97 -       (draw-edges! layout x y)
    5.98 -       (if movable
    5.99 -         (draw-movable-vertices! layout x y dragged fix-x fix-y)
   5.100 -         (draw-vertices! layout x y))))
   5.101 -  (layer-size [layer]
   5.102 -     (let [bounds (.getBounds layout)]
   5.103 -       (Size. (.getWidth bounds) (.getHeight bounds))))
   5.104 -  Anchored
   5.105 -  (anchor [layer x-align y-align]
   5.106 -          (let [bounds (.getBounds layout)]
   5.107 -            (Location. (- (.getX bounds))
   5.108 -                       (- (.getY bounds))))))
   5.109 -
   5.110 -(defn graph-layer
   5.111 -  ([graph-layout]
   5.112 -     (graph-layer graph-layout false))
   5.113 -  ([^GraphLayout graph-layout movable]
   5.114 -     (GraphLayer. graph-layout movable (ref nil) (ref 0) (ref 0))))
   5.115 -
   5.116 -(defn build-graph
   5.117 -  "Returns Graph defined by a sequence of pairs of vertex ids,
   5.118 -   and a function that maps vertex id's to Vertex objects."
   5.119 -  [relations f]
   5.120 -  (let [graph (DefaultGraph.)
   5.121 -        vs (reduce #(conj %1 (first %2) (second %2)) #{} relations)
   5.122 -        vm (reduce #(assoc %1 %2 (f %2)) {} vs)
   5.123 -        vs (vals vm)
   5.124 -        es (map #(DefaultEdge2D. (vm (first %)) (vm (second %))) relations)]
   5.125 -    (doseq [v vs]
   5.126 -      (.addVertex graph v))
   5.127 -    (doseq [e es]
   5.128 -      (.addEdge graph e))
   5.129 -    graph))
   5.130 -
   5.131 -(comment
   5.132 -  (let [graph (build-graph
   5.133 -               [[1 2] [1 3] [1 4] [2 4]]
   5.134 -               (fn [_] (RectangularVertex2D. 100 30)))
   5.135 -        layout (ForceDirectedLayout. graph)
   5.136 -        frame (JFrame. "Graph test")
   5.137 -        layer (graph-layer layout true)
   5.138 -        layer (viewport layer :center :center)]
   5.139 -    (.add (.getContentPane frame) (make-jpanel layer))
   5.140 -    (while (not (.update layout)))
   5.141 -    (doto frame
   5.142 -      (.setDefaultCloseOperation JFrame/DISPOSE_ON_CLOSE)
   5.143 -      (.pack)
   5.144 -      (.setVisible true)))
   5.145 -  )
     6.1 --- a/src/kryshen/indyvon/layers.clj	Wed Jul 28 04:47:30 2010 +0400
     6.2 +++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
     6.3 @@ -1,234 +0,0 @@
     6.4 -;;
     6.5 -;; Copyright (C) 2010 Mikhail Kryshen <mikhail@kryshen.net>
     6.6 -;;
     6.7 -;; This file is part of Indyvon.
     6.8 -;;
     6.9 -
    6.10 -(ns kryshen.indyvon.layers
    6.11 -  (:use kryshen.indyvon.core)
    6.12 -  (:import (kryshen.indyvon.core Size Location)
    6.13 -           (java.lang.ref SoftReference)
    6.14 -           (java.awt Font Cursor Image Toolkit)
    6.15 -           (java.awt.image ImageObserver)
    6.16 -           (java.awt.font FontRenderContext TextLayout)))
    6.17 -
    6.18 -;; Define as macro to avoid unnecessary calculation of inner and outer
    6.19 -;; sizes in the first case.
    6.20 -(defmacro align-xy [inner outer align first center last]
    6.21 -  `(case ~align
    6.22 -         ~first 0
    6.23 -         ~center (/ (- ~outer ~inner) 2)
    6.24 -         ~last (- ~outer ~inner)))
    6.25 -
    6.26 -(defmacro align-x [inner outer align]
    6.27 -  `(align-xy ~inner ~outer ~align :left :center :right))
    6.28 -
    6.29 -(defmacro align-y [inner outer align]
    6.30 -  `(align-xy ~inner ~outer ~align :top :center :bottom))
    6.31 -
    6.32 -(defmacro decorate-layer [layer & render-tail]
    6.33 -  `(reify
    6.34 -    Layer
    6.35 -    (render! ~@render-tail)
    6.36 -    (layer-size [t#] (layer-size ~layer))
    6.37 -    Anchored
    6.38 -    (anchor [t# xa# ya#] (anchor ~layer xa# ya#))))
    6.39 -
    6.40 -(defn padding
    6.41 -  ([content pad]
    6.42 -     (padding content pad pad pad pad))
    6.43 -  ([content top left bottom right]
    6.44 -     (if (== 0 top left bottom right)
    6.45 -       content
    6.46 -       (reify
    6.47 -        Layer
    6.48 -        (render! [l]
    6.49 -           (draw! content
    6.50 -                  left top
    6.51 -                  (- (:width *bounds*) left right)
    6.52 -                  (- (:height *bounds*) top bottom)))
    6.53 -        (layer-size [l]
    6.54 -           (let [s (layer-size content)]
    6.55 -             (Size. (+ (:width s) left right)
    6.56 -                    (+ (:height s) top bottom))))))))
    6.57 -
    6.58 -(defn border
    6.59 -  "Decorate layer with a border."
    6.60 -  ([content]
    6.61 -     (border content 1))
    6.62 -  ([content width]
    6.63 -     (border content width 0))
    6.64 -  ([content width gap]
    6.65 -     (let [layer (padding content (+ width gap))]
    6.66 -       (decorate-layer layer [_]
    6.67 -         (let [w (:width *bounds*)
    6.68 -               h (:height *bounds*)]
    6.69 -           (with-color (:border-color *theme*)
    6.70 -             (doseq [i (range 0 width)]
    6.71 -               (.drawRect *graphics* i i (- w 1 i i) (- h 1 i i))))
    6.72 -           (render! layer))))))
    6.73 -
    6.74 -(defn panel
    6.75 -  "Opaque layer using theme's alt-back-color."
    6.76 -  ([content]
    6.77 -     (panel content 0))
    6.78 -  ([content gap]
    6.79 -     (let [layer (padding content gap)]
    6.80 -       (decorate-layer layer [_]
    6.81 -         (with-color (:alt-back-color *theme*)
    6.82 -           (.fillRect *graphics* 0 0
    6.83 -                      (:width *bounds*) (:height *bounds*)))
    6.84 -         (render! layer)))))
    6.85 -
    6.86 -(defn- re-split [^java.util.regex.Pattern re s]
    6.87 -  (seq (.split re s)))
    6.88 -
    6.89 -(def text-layout-cache (atom {}))
    6.90 -
    6.91 -(defn- get-text-layout
    6.92 -  [^String line ^Font font ^FontRenderContext font-context]
    6.93 -  (let [key [line font font-context]]
    6.94 -    (or (if-let [^SoftReference softref (@text-layout-cache key)]
    6.95 -          (.get softref)
    6.96 -          (do (swap! text-layout-cache dissoc key)
    6.97 -              false))
    6.98 -        (let [layout (TextLayout. line font font-context)]
    6.99 -          (println "text-layout-cache miss" line)
   6.100 -          (swap! text-layout-cache assoc key (SoftReference. layout))
   6.101 -          layout))))
   6.102 -
   6.103 -(defn- layout-text
   6.104 -  [lines ^Font font ^FontRenderContext font-context]
   6.105 -  (map #(get-text-layout % font font-context) lines))
   6.106 -  ;;(map #(TextLayout. ^String % font font-context) lines))
   6.107 -
   6.108 -(defn- text-width [layouts]
   6.109 -  (reduce (fn [w ^TextLayout tl] (max w (.getAdvance tl))) 0 layouts))
   6.110 -
   6.111 -(defn- text-height [layouts]
   6.112 -  (reduce (fn [w ^TextLayout tl] (+ w (.getAscent tl)
   6.113 -                                   (.getDescent tl)
   6.114 -                                   (.getLeading tl)))
   6.115 -          0 layouts))
   6.116 -
   6.117 -(defn text-layer
   6.118 -  "Creates a layer to display multiline text."
   6.119 -  ([text]
   6.120 -     (text-layer text :left :top))
   6.121 -  ([text h-align v-align]
   6.122 -     (let [lines (re-split #"\r\n|\n|\r|\u0085|\u2028|\u2029" text)]
   6.123 -       (reify Layer
   6.124 -        (render! [layer]
   6.125 -           (let [w (:width *bounds*)
   6.126 -                 h (:height *bounds*)
   6.127 -                 font (.getFont *graphics*)
   6.128 -                 layouts (layout-text lines font *font-context*)
   6.129 -                 y (align-y (text-height layouts) h v-align)]
   6.130 -             (loop [layouts layouts, y y]
   6.131 -               (when-first [^TextLayout layout layouts]
   6.132 -                 (let [ascent (.getAscent layout)
   6.133 -                       lh (+ ascent (.getDescent layout) (.getLeading layout))
   6.134 -                       x (align-x (.getAdvance layout) w h-align)]
   6.135 -                   (.draw layout *graphics* x (+ y ascent))
   6.136 -                   (recur (next layouts) (+ y lh)))))))
   6.137 -        (layer-size [layer]
   6.138 -           (let [layouts (layout-text lines (:font *theme*) *font-context*)
   6.139 -                 width (text-width layouts)
   6.140 -                 height (text-height layouts)]
   6.141 -             (Size. width height)))))))
   6.142 -
   6.143 -(defn- image-observer [update-fn]
   6.144 -  (reify
   6.145 -   ImageObserver
   6.146 -   (imageUpdate [this img infoflags x y width height]
   6.147 -      (update-fn)
   6.148 -      (zero? (bit-and infoflags
   6.149 -                      (bit-or ImageObserver/ALLBITS
   6.150 -                              ImageObserver/ABORT))))))
   6.151 -
   6.152 -(defn image-layer
   6.153 -  [image-or-uri]
   6.154 -  (let [^Image image (if (isa? image-or-uri Image)
   6.155 -                       image-or-uri
   6.156 -                       (.getImage (Toolkit/getDefaultToolkit)
   6.157 -                                  ^java.net.URL image-or-uri))]
   6.158 -    (.prepareImage (Toolkit/getDefaultToolkit) image -1 -1 nil)
   6.159 -    (reify
   6.160 -     Layer
   6.161 -     (render! [layer]
   6.162 -        (.drawImage *graphics* image 0 0
   6.163 -                    ^ImageObserver (image-observer *update*)))
   6.164 -     (layer-size [layer]
   6.165 -        (let [observer (image-observer *update*)
   6.166 -              width (.getWidth image observer)
   6.167 -              height (.getHeight image observer)
   6.168 -              width (if (pos? width) width 1)
   6.169 -              height (if (pos? height) height 1)]
   6.170 -          (Size. width height))))))
   6.171 -
   6.172 -(defn viewport
   6.173 -  "Creates scrollable viewport layer."
   6.174 -  ([content] (viewport content :left :top))
   6.175 -  ([content h-align v-align]
   6.176 -  (let [x (ref 0)
   6.177 -        y (ref 0)
   6.178 -        fix-x (ref 0)
   6.179 -        fix-y (ref 0)
   6.180 -        last-width (ref 0)
   6.181 -        last-height (ref 0)]
   6.182 -    (reify
   6.183 -     Layer
   6.184 -     (render! [layer]
   6.185 -        (with-handlers layer
   6.186 -         (let [anchor (anchor content h-align v-align)
   6.187 -               width (:width *bounds*)
   6.188 -               height (:height *bounds*)]
   6.189 -           (dosync
   6.190 -            (alter x + (align-x width @last-width h-align))
   6.191 -            (alter y + (align-y height @last-height v-align))
   6.192 -            (ref-set last-width width)
   6.193 -            (ref-set last-height height))
   6.194 -           (draw! content (- 0 @x (:x anchor)) (- 0 @y (:y anchor))))
   6.195 -         (:mouse-pressed e
   6.196 -          (dosync
   6.197 -           (ref-set fix-x (:x-on-screen e))
   6.198 -           (ref-set fix-y (:y-on-screen e)))
   6.199 -          (->> Cursor/MOVE_CURSOR Cursor. (.setCursor *target*)))
   6.200 -         (:mouse-released e
   6.201 -          (->> Cursor/DEFAULT_CURSOR Cursor. (.setCursor *target*)))
   6.202 -         (:mouse-dragged e
   6.203 -          (dosync
   6.204 -           (alter x + (- @fix-x (:x-on-screen e)))
   6.205 -           (alter y + (- @fix-y (:y-on-screen e)))
   6.206 -           (ref-set fix-x (:x-on-screen e))
   6.207 -           (ref-set fix-y (:y-on-screen e)))
   6.208 -          (*update*))))
   6.209 -     (layer-size [layer] (layer-size content))))))
   6.210 -
   6.211 -;;
   6.212 -;; Layer context decorators.
   6.213 -;;
   6.214 -
   6.215 -(defmacro handler [layer & handlers]
   6.216 -  `(let [layer# ~layer]
   6.217 -     (decorate-layer layer# [t#]
   6.218 -        (with-handlers t#
   6.219 -          (render! layer#)
   6.220 -          ~@handlers))))
   6.221 -
   6.222 -(defn theme [layer & map-or-keyvals]
   6.223 -  (let [theme (if (== (count map-or-keyvals) 1)
   6.224 -                map-or-keyvals
   6.225 -                (apply array-map map-or-keyvals))]
   6.226 -    (reify
   6.227 -     Layer
   6.228 -     (render! [t]
   6.229 -        (with-theme theme
   6.230 -          (render! layer)))
   6.231 -     (layer-size [t]
   6.232 -        (with-theme theme
   6.233 -          (layer-size layer)))
   6.234 -     Anchored
   6.235 -     (anchor [t xa ya]
   6.236 -        (with-theme theme
   6.237 -          (anchor layer xa ya))))))
     7.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
     7.2 +++ b/src/net/kryshen/indyvon/component.clj	Thu Jul 29 01:08:34 2010 +0400
     7.3 @@ -0,0 +1,53 @@
     7.4 +;;
     7.5 +;; Copyright (C) 2010 Mikhail Kryshen <mikhail@kryshen.net>
     7.6 +;;
     7.7 +;; This file is part of Indyvon.
     7.8 +;;
     7.9 +
    7.10 +(ns net.kryshen.indyvon.component
    7.11 +  (:use
    7.12 +   net.kryshen.indyvon.core)
    7.13 +  (:import
    7.14 +   (net.kryshen.indyvon.core Size Bounds)
    7.15 +   (java.awt Graphics2D Component Dimension Color)
    7.16 +   (javax.swing JFrame JPanel)))
    7.17 +
    7.18 +(defn- font-context [^Component component]
    7.19 +  (.getFontRenderContext (.getFontMetrics component (.getFont component))))
    7.20 +
    7.21 +(defn paint-component
    7.22 +  [^Component component layer ^Graphics2D graphics event-dispatcher]
    7.23 +  (let [size (.getSize component)
    7.24 +        width (.width size)
    7.25 +        height (.height size)]
    7.26 +    (.clearRect graphics 0 0 width height)
    7.27 +    (let [bounds (Bounds. 0 0 width height)]
    7.28 +      (binding [*graphics* graphics
    7.29 +                *font-context* (.getFontRenderContext graphics)
    7.30 +                *target* component
    7.31 +                *event-dispatcher* event-dispatcher
    7.32 +                *update* #(.repaint component)
    7.33 +                *bounds* bounds
    7.34 +                *clip* bounds]
    7.35 +        (render! layer)
    7.36 +        (commit event-dispatcher)))))
    7.37 +
    7.38 +(defn preferred-size [component layer]
    7.39 +  (binding [*target* component
    7.40 +            *font-context*' (font-context component)]
    7.41 +    (let [s (layer-size layer)]
    7.42 +      (Dimension. (:width s) (:height s)))))
    7.43 +
    7.44 +(defn make-jpanel
    7.45 +  ([layer]
    7.46 +     (make-jpanel layer (root-event-dispatcher)))
    7.47 +  ([layer event-dispatcher]
    7.48 +     (let [panel
    7.49 +           (proxy [JPanel] []
    7.50 +             (paintComponent [g]
    7.51 +                (paint-component this layer g event-dispatcher))
    7.52 +             (getPreferredSize []
    7.53 +                (preferred-size this layer)))]
    7.54 +       (.setBackground panel (:back-color *theme*))
    7.55 +       (listen! event-dispatcher panel)
    7.56 +       panel)))
     8.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
     8.2 +++ b/src/net/kryshen/indyvon/core.clj	Thu Jul 29 01:08:34 2010 +0400
     8.3 @@ -0,0 +1,341 @@
     8.4 +;;
     8.5 +;; Copyright (C) 2010 Mikhail Kryshen <mikhail@kryshen.net>
     8.6 +;;
     8.7 +;; This file is part of Indyvon.
     8.8 +;;
     8.9 +
    8.10 +(ns net.kryshen.indyvon.core
    8.11 +  (:import
    8.12 +   (java.awt Graphics2D Component Color Font AWTEvent)
    8.13 +   (java.awt.event MouseListener MouseMotionListener)
    8.14 +   (java.awt.font FontRenderContext)))
    8.15 +
    8.16 +(def ^Graphics2D *graphics*)
    8.17 +(def ^FontRenderContext *font-context*)
    8.18 +(def ^Component *target*)
    8.19 +(def *bounds*)
    8.20 +(def *clip*)
    8.21 +(def *update*)
    8.22 +(def *event-dispatcher*)
    8.23 +
    8.24 +(defrecord Theme [fore-color back-color alt-back-color border-color font])
    8.25 +
    8.26 +(defn default-theme []
    8.27 +  (Theme. Color/BLACK Color/LIGHT_GRAY Color/WHITE
    8.28 +          Color/BLUE (Font. "Sans" Font/PLAIN 12)))
    8.29 +
    8.30 +(def *theme* (default-theme))
    8.31 +
    8.32 +(defrecord Location [x y])
    8.33 +(defrecord Size [width height])
    8.34 +(defrecord Bounds [x y width height])
    8.35 +
    8.36 +(defprotocol Layer
    8.37 +  "Basic UI element."
    8.38 +  (render! [this])
    8.39 +  (layer-size [this]))
    8.40 +
    8.41 +;; TODO: modifiers
    8.42 +(defrecord MouseEvent [id when x y x-on-screen y-on-screen button])
    8.43 +
    8.44 +(defprotocol EventDispatcher
    8.45 +  (listen! [this ^Component component]
    8.46 +     "Listen for events on the specified AWT Component.")
    8.47 +  (create-dispatcher [this handle handlers]
    8.48 +     "Returns new event dispatcher associated with the specified event
    8.49 +      handlers (an event-id -> handler-fn map). Handle is used to
    8.50 +      match the contexts between commits.")
    8.51 +  (commit [this]
    8.52 +     "Apply the registered handlers for event processing."))
    8.53 +
    8.54 +(defprotocol Anchored
    8.55 +  "Provide anchor point for Layers. Used by viewport."
    8.56 +  (anchor [this h-align v-align]
    8.57 +     "Anchor point: [x y], h-align could be :left, :center or :right,
    8.58 +      v-align is :top, :center or :bottom"))
    8.59 +
    8.60 +;; Default implementation of Anchored for any Layer.
    8.61 +(extend-protocol Anchored
    8.62 +  net.kryshen.indyvon.core.Layer
    8.63 +  (anchor [this h-align v-align]
    8.64 +          (if (and (= h-align :left)
    8.65 +                   (= v-align :top))
    8.66 +            (Location. 0 0)
    8.67 +            (let [size (layer-size this)]
    8.68 +              (Location.
    8.69 +               (case h-align
    8.70 +                     :top 0
    8.71 +                     :center (/ (:width size) 2)
    8.72 +                     :right (:width size))
    8.73 +               (case v-align
    8.74 +                     :left 0
    8.75 +                     :center (/ (:height size) 2)
    8.76 +                     :bottom (:height size)))))))
    8.77 +
    8.78 +(defn- ^Graphics2D make-graphics [^Graphics2D graphics x y w h]
    8.79 +  (.create graphics x y w h))
    8.80 +
    8.81 +(defn- ^Graphics2D apply-theme [^Graphics2D graphics theme]
    8.82 +  (doto graphics
    8.83 +    (.setColor (:fore-color theme))
    8.84 +    (.setFont (:font theme))))
    8.85 +
    8.86 +(defn intersect
    8.87 +  ([b1 b2]
    8.88 +     (let [x1 (:x b1)
    8.89 +           y1 (:y b1)
    8.90 +           x2 (:x b2)
    8.91 +           y2 (:y b2)]
    8.92 +       (intersect x1 y1 (+ x1 (:width b1)) (+ y1 (:height b1))
    8.93 +                  x2 y2 (+ x2 (:width b2)) (+ y2 (:height b2)))))
    8.94 +  ([x11 y11 x12 y12, x21 y21 x22 y22]
    8.95 +     (let [x1 (max x11 x21)
    8.96 +           y1 (max y11 y21)
    8.97 +           x2 (min x12 x22)
    8.98 +           y2 (min y12 y22)]
    8.99 +       (Bounds. x1 y1 (- x2 x1) (- y2 y1)))))
   8.100 +
   8.101 +(defn ^Graphics2D create-graphics
   8.102 +  ([]
   8.103 +     (create-graphics 0 0 (:width *bounds*) (:height *bounds*)))
   8.104 +  ([x y w h]
   8.105 +     (apply-theme (.create *graphics* x y w h) *theme*)))
   8.106 +
   8.107 +(defmacro with-bounds [x y w h & body]
   8.108 +  `(let [bounds# (Bounds. (+ ~x (:x *bounds*))
   8.109 +                          (+ ~y (:y *bounds*))
   8.110 +                          ~w ~h)
   8.111 +         clip# (intersect bounds# *clip*)]
   8.112 +     (when (and (pos? (:width clip#)) (pos? (:height clip#)))
   8.113 +       (let [graphics# (create-graphics ~x ~y ~w ~h)]
   8.114 +         (try
   8.115 +           (binding [*bounds* bounds#
   8.116 +                     *clip* clip#
   8.117 +                     *graphics* graphics#]
   8.118 +             ~@body)
   8.119 +           (finally
   8.120 +            (.dispose graphics#)))))))
   8.121 +
   8.122 +(defmacro with-handlers* [handle handlers & body]
   8.123 +  `(binding
   8.124 +       [*event-dispatcher*
   8.125 +        (create-dispatcher *event-dispatcher* ~handle ~handlers)]
   8.126 +     ~@body))
   8.127 +
   8.128 +(defmacro with-handlers
   8.129 +  "specs => (:event-id name & handler-body)*
   8.130 +
   8.131 +  Execute form with the specified event handlers."
   8.132 +  [handle form & specs]
   8.133 +  `(with-handlers* ~handle
   8.134 +     ~(reduce (fn [m spec]
   8.135 +                (assoc m (first spec)
   8.136 +                       `(fn [~(second spec)]
   8.137 +                          ~@(nnext spec)))) {}
   8.138 +                          specs)
   8.139 +     ~form))
   8.140 +
   8.141 +(defn with-theme* [theme f & args]
   8.142 +  (apply with-bindings* {#'*theme* (merge *theme* theme)}
   8.143 +         f args))
   8.144 +
   8.145 +(defmacro with-theme [theme & body]
   8.146 +  `(binding [*theme* (merge *theme* ~theme)]
   8.147 +     ~@body))
   8.148 +
   8.149 +(defmacro with-color [color & body]
   8.150 +  `(let [color# (.getColor *graphics*)]
   8.151 +     (try
   8.152 +       (.setColor *graphics* ~color)
   8.153 +       ~@body
   8.154 +       (finally
   8.155 +        (.setColor *graphics* color#)))))
   8.156 +
   8.157 +(defn- geometry-vec [geometry]
   8.158 +  (if (vector? geometry)
   8.159 +    geometry
   8.160 +    [(:x geometry) (:y geometry) (:width geometry) (:height geometry)]))
   8.161 +
   8.162 +(defn draw!
   8.163 +  ([layer]
   8.164 +     (let [graphics (create-graphics)]
   8.165 +       (try
   8.166 +         (binding [*graphics* graphics]
   8.167 +           (render! layer))
   8.168 +         (finally
   8.169 +          (.dispose graphics)))))
   8.170 +  ([layer x y]
   8.171 +     (let [size (layer-size layer)]
   8.172 +       (draw! layer x y (:width size) (:height size))))
   8.173 +  ([layer x y width height]
   8.174 +     (with-bounds x y width height
   8.175 +       (render! layer))))
   8.176 +
   8.177 +(defn draw-anchored!
   8.178 +  "Draw with location relative to the anchor point."
   8.179 +  ([layer h-align v-align x y]
   8.180 +     (let [anchor (anchor layer h-align v-align)]
   8.181 +       (draw! layer (- x (:x anchor)) (- y (:y anchor)))))
   8.182 +  ([layer h-align v-align x y w h]
   8.183 +     (let [anchor (anchor layer h-align v-align)]
   8.184 +       (draw! layer (- x (:x anchor)) (- y (:y anchor)) w h))))
   8.185 +
   8.186 +;;
   8.187 +;; EventDispatcher implementation
   8.188 +;;
   8.189 +
   8.190 +(def awt-events
   8.191 +     {java.awt.event.MouseEvent/MOUSE_CLICKED  :mouse-clicked
   8.192 +      java.awt.event.MouseEvent/MOUSE_DRAGGED  :mouse-dragged
   8.193 +      java.awt.event.MouseEvent/MOUSE_ENTERED  :mouse-entered
   8.194 +      java.awt.event.MouseEvent/MOUSE_EXITED   :mouse-exited
   8.195 +      java.awt.event.MouseEvent/MOUSE_MOVED    :mouse-moved
   8.196 +      java.awt.event.MouseEvent/MOUSE_PRESSED  :mouse-pressed
   8.197 +      java.awt.event.MouseEvent/MOUSE_RELEASED :mouse-released})
   8.198 +
   8.199 +(defrecord DispatcherNode [handle handlers parent bounds bindings]
   8.200 +  EventDispatcher
   8.201 +  (listen! [this component]
   8.202 +     (listen! parent component))
   8.203 +  (create-dispatcher [this handle handlers]
   8.204 +     (create-dispatcher parent handle handlers))
   8.205 +  (commit [this]
   8.206 +     (commit parent)))
   8.207 +
   8.208 +(defn- make-node [handle handlers]
   8.209 +  (DispatcherNode. handle handlers *event-dispatcher* *clip*
   8.210 +                   (get-thread-bindings)))
   8.211 +
   8.212 +(defn- assoc-cons [m key val]
   8.213 +  (assoc m key (cons val (get m key))))
   8.214 +
   8.215 +(defn- add-node [tree node]
   8.216 +  (assoc-cons tree (:parent node) node))
   8.217 +
   8.218 +(defn- inside?
   8.219 +  ([x y bounds]
   8.220 +     (inside? x y (:x bounds) (:y bounds)
   8.221 +              (:width bounds) (:height bounds)))
   8.222 +  ([px py x y w h]
   8.223 +     (and (>= px x)
   8.224 +          (>= py y)
   8.225 +          (< px (+ x w))
   8.226 +          (< py (+ y h)))))
   8.227 +
   8.228 +(defn- under-cursor
   8.229 +  "Returns a vector of child nodes under cursor."
   8.230 +  [x y tree node]
   8.231 +  (some #(if (inside? x y (:bounds %))
   8.232 +           (conj (vec (under-cursor x y tree %)) %))
   8.233 +        (get tree node)))
   8.234 +
   8.235 +(defn- remove-all [coll1 coll2 pred]
   8.236 +  (filter #(not (some (partial pred %) coll2)) coll1))
   8.237 +
   8.238 +(defn- translate-mouse-event [^java.awt.event.MouseEvent event x y id]
   8.239 +  (MouseEvent. id (.getWhen event)
   8.240 +               (- (.getX event) x) (- (.getY event) y)
   8.241 +               (.getXOnScreen event) (.getYOnScreen event)
   8.242 +               (.getButton event)))
   8.243 +
   8.244 +(defn- translate-and-dispatch
   8.245 +  ([nodes first-only ^java.awt.event.MouseEvent event]
   8.246 +     (translate-and-dispatch nodes first-only
   8.247 +       event (awt-events (.getID event))))
   8.248 +  ([nodes first-only event id]
   8.249 +     (if-let [node (first nodes)]
   8.250 +       (if-let [handler (get (:handlers node) id)]
   8.251 +         (do
   8.252 +           (with-bindings* (:bindings node)
   8.253 +             handler
   8.254 +             (translate-mouse-event event
   8.255 +               (-> node :bounds :x) (-> node :bounds :y) id))
   8.256 +           (if-not first-only
   8.257 +             (recur (rest nodes) false event id)))
   8.258 +         (recur (rest nodes) first-only event id)))))
   8.259 +
   8.260 +(defn- dispatch-mouse-motion
   8.261 +  "Dispatches mouse motion events."
   8.262 +  [hovered-ref tree root ^java.awt.event.MouseEvent event]
   8.263 +  (let [x (.getX event)
   8.264 +        y (.getY event)
   8.265 +        [hovered hovered2] (dosync
   8.266 +                            [@hovered-ref
   8.267 +                             (ref-set hovered-ref
   8.268 +                                      (under-cursor x y tree root))])
   8.269 +        pred #(= (:handle %1) (:handle %2))
   8.270 +        exited (remove-all hovered hovered2 pred)
   8.271 +        entered (remove-all hovered2 hovered pred)
   8.272 +        moved (remove-all hovered2 entered pred)]
   8.273 +    (translate-and-dispatch exited false event :mouse-exited)
   8.274 +    (translate-and-dispatch entered false event :mouse-entered)
   8.275 +    (translate-and-dispatch moved true event :mouse-moved)))
   8.276 +
   8.277 +(defn- dispatch-mouse-button
   8.278 +  [picked-ref hovered-ref ^java.awt.event.MouseEvent event]
   8.279 +  (let [id (awt-events (.getID event))
   8.280 +        hovered (if (= id :mouse-pressed)
   8.281 +                  (dosync (ref-set picked-ref @hovered-ref))
   8.282 +                  @hovered-ref)]
   8.283 +    (translate-and-dispatch hovered true event id)))
   8.284 +
   8.285 +(defn root-event-dispatcher []
   8.286 +  (let [tree-r (ref {})   ; register
   8.287 +        tree (ref {})     ; dispatch
   8.288 +        hovered (ref '())
   8.289 +        picked (ref '())]
   8.290 +    (reify
   8.291 +     EventDispatcher
   8.292 +     (listen! [this component]
   8.293 +        (doto component
   8.294 +          (.addMouseListener this)
   8.295 +          (.addMouseMotionListener this)))
   8.296 +     (create-dispatcher [this handle handlers]
   8.297 +        (let [node (make-node handle handlers)]
   8.298 +          (dosync (alter tree-r add-node node))
   8.299 +          node))
   8.300 +     (commit [this]
   8.301 +        (dosync (ref-set tree @tree-r)
   8.302 +                (ref-set tree-r {})))
   8.303 +     MouseListener
   8.304 +     (mouseEntered [this event]
   8.305 +        (dispatch-mouse-motion hovered @tree this event))
   8.306 +     (mouseExited [this event]
   8.307 +        (dispatch-mouse-motion hovered @tree this event))
   8.308 +     (mouseClicked [this event]
   8.309 +        (dispatch-mouse-button picked hovered event))
   8.310 +     (mousePressed [this event]
   8.311 +        (dispatch-mouse-button picked hovered event))
   8.312 +     (mouseReleased [this event]
   8.313 +        (translate-and-dispatch @picked true event))
   8.314 +        ;;(dispatch-mouse-button picked hovered event))
   8.315 +     MouseMotionListener
   8.316 +     (mouseDragged [this event]
   8.317 +        (translate-and-dispatch @picked true event))
   8.318 +     (mouseMoved [this event]
   8.319 +        (dispatch-mouse-motion hovered @tree this event)))))
   8.320 +
   8.321 +;;
   8.322 +;; ИДЕИ:
   8.323 +;;
   8.324 +;; Контекст: биндинги или запись?
   8.325 +;;
   8.326 +;; Установка обработчиков (в контексте слоя):
   8.327 +;;
   8.328 +;; (listen
   8.329 +;;   (:mouse-entered e
   8.330 +;;     ...)
   8.331 +;;   (:mouse-exited e
   8.332 +;;     ...))
   8.333 +;;
   8.334 +;; Не надо IMGUI.
   8.335 +;; Построение сцены путем декорирования слоев:
   8.336 +;;
   8.337 +;; (listener
   8.338 +;;  (:action e (println e))
   8.339 +;;  (:mouse-dragged e (println e))
   8.340 +;;  (theme :font "Helvetica-14"
   8.341 +;;    (vbox
   8.342 +;;      (button (text-layer "Button 1"))
   8.343 +;;      (button (text-layer "Button 2")))))
   8.344 +;;
     9.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
     9.2 +++ b/src/net/kryshen/indyvon/demo.clj	Thu Jul 29 01:08:34 2010 +0400
     9.3 @@ -0,0 +1,89 @@
     9.4 +;;
     9.5 +;; Copyright (C) 2010 Mikhail Kryshen <mikhail@kryshen.net>
     9.6 +;;
     9.7 +;; This file is part of Indyvon.
     9.8 +;;
     9.9 +
    9.10 +(ns net.kryshen.indyvon.demo
    9.11 +  (:gen-class)
    9.12 +  (:use
    9.13 +   (net.kryshen.indyvon core layers component))
    9.14 +  (:import
    9.15 +   (net.kryshen.indyvon.core Size Bounds)
    9.16 +   (java.awt Color)
    9.17 +   (javax.swing JFrame)))
    9.18 +
    9.19 +(def frame (JFrame. "Test"))
    9.20 +
    9.21 +(def layer1
    9.22 +     (reify
    9.23 +      Layer
    9.24 +      (render! [layer]
    9.25 +         (with-handlers layer
    9.26 +           (doto *graphics*
    9.27 +             (.setColor Color/RED)
    9.28 +             (.fillRect 0 0 (:width *bounds*) (:height *bounds*)))
    9.29 +           (:mouse-entered e (println e))
    9.30 +           (:mouse-exited e (println e))
    9.31 +           (:mouse-moved e (println e))))
    9.32 +      (layer-size [layer] (Size. 30 20))))
    9.33 +
    9.34 +(def layer1b (border layer1 2 3))
    9.35 +
    9.36 +(def layer2
    9.37 +     (reify
    9.38 +      Layer
    9.39 +      (render! [layer]
    9.40 +         (doto *graphics*
    9.41 +           (.setColor Color/YELLOW)
    9.42 +           (.fillRect 0 0 (:width *bounds*) (:height *bounds*)))
    9.43 +         (draw! layer1b 10 5)
    9.44 +         (draw! layer1 55 5))
    9.45 +      (layer-size [layer] (Size. 70 65))))
    9.46 +
    9.47 +(def layer3
    9.48 +     (border (text-layer "Sample\ntext" :right :center)))
    9.49 +
    9.50 +(defn fps-layer [fps]
    9.51 +  (border (text-layer (format "%.1f" fps) :right :bottom) 0 5))
    9.52 +
    9.53 +(def fps
    9.54 +     (let [update-interval 0.1
    9.55 +           frames (ref 0)
    9.56 +           last (ref 0)
    9.57 +           fl (ref (fps-layer 0.0))]
    9.58 +       (reify
    9.59 +        Layer
    9.60 +        (render! [layer]
    9.61 +           (draw! @fl)
    9.62 +           (dosync
    9.63 +            (alter frames + 1)
    9.64 +            (let [time (System/currentTimeMillis)
    9.65 +                  elapsed (/ (- time @last) 1000.0)]
    9.66 +              (when (> elapsed update-interval)
    9.67 +                (ref-set fl (fps-layer (/ @frames elapsed)))
    9.68 +                (ref-set frames 0)
    9.69 +                (ref-set last time)))))
    9.70 +        (layer-size [layer] (layer-size @fl)))))
    9.71 +
    9.72 +(def layer
    9.73 +     (reify
    9.74 +      Layer
    9.75 +      (render! [layer]
    9.76 +         (*update*)
    9.77 +         (doto *graphics*
    9.78 +           (.setColor (rand-nth [Color/BLACK Color/BLUE Color/RED]))
    9.79 +           (.drawLine 0 0 (:width *bounds*) (:height *bounds*)))
    9.80 +         (draw! layer2 15 20)
    9.81 +         (draw! layer3 100 100 80 50)
    9.82 +         (draw! fps))
    9.83 +      (layer-size [layer] (Size. 400 300))))
    9.84 +
    9.85 +(defn -main []
    9.86 +  (doto frame
    9.87 +    (.addWindowListener
    9.88 +     (proxy [java.awt.event.WindowAdapter] []
    9.89 +       (windowClosing [event] (.dispose frame))))
    9.90 +    (.. (getContentPane) (add (make-jpanel (viewport layer))))
    9.91 +    (.pack)
    9.92 +    (.setVisible true)))
    10.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    10.2 +++ b/src/net/kryshen/indyvon/graph.clj	Thu Jul 29 01:08:34 2010 +0400
    10.3 @@ -0,0 +1,142 @@
    10.4 +;;
    10.5 +;; Copyright (C) 2010 Mikhail Kryshen <mikhail@kryshen.net>
    10.6 +;;
    10.7 +;; This file is part of Indyvon.
    10.8 +;;
    10.9 +
   10.10 +(ns net.kryshen.indyvon.graph
   10.11 +  (:use
   10.12 +   (net.kryshen.indyvon core component layers))
   10.13 +  (:import
   10.14 +   (net.kryshen.indyvon.core Location Size)
   10.15 +   (net.kryshen.indygraph Graph DefaultGraph GraphLayout Vertex2D
   10.16 +                          Edge2D RectangularVertex2D DefaultEdge2D)
   10.17 +   (net.kryshen.indygraph.fdl ForceDirectedLayout)
   10.18 +   (java.awt.geom Path2D$Double)
   10.19 +   (javax.swing JFrame)))
   10.20 +
   10.21 +(extend-type Vertex2D
   10.22 +  Layer
   10.23 +  (render! [v]
   10.24 +     (.drawOval *graphics* 0 0 (:width *bounds*) (:height *bounds*)))
   10.25 +  (layer-size [v]
   10.26 +     (Size.
   10.27 +      (+ (.getLeftBound v) (.getRightBound v))
   10.28 +      (+ (.getTopBound v) (.getBottomBound v))))
   10.29 +  Anchored
   10.30 +  (anchor [v _ _]
   10.31 +     (Location.
   10.32 +      (.getLeftBound v)
   10.33 +      (.getTopBound v))))
   10.34 +
   10.35 +(defn- draw-vertices! [^GraphLayout layout x y]
   10.36 +  (doseq [v (.vertices (.getGraph layout))]
   10.37 +    (draw-anchored! v :center :center (+ x (.getX v)) (+ y (.getY v)))))
   10.38 +
   10.39 +(defn- draw-movable-vertex!
   10.40 +  [^Vertex2D v ^GraphLayout layout x y dragged fix-x fix-y]
   10.41 +  (let [x (+ x (.getX v))
   10.42 +        y (+ y (.getY v))
   10.43 +        anchor (anchor v :center :center)
   10.44 +        size (layer-size v)
   10.45 +        x (- x (:x anchor))
   10.46 +        y (- y (:y anchor))]
   10.47 +    (with-bounds x y (:width size) (:height size)
   10.48 +      (with-handlers v
   10.49 +        (draw! v)
   10.50 +        (:mouse-pressed e
   10.51 +          (dosync (ref-set fix-x (:x-on-screen e))
   10.52 +                  (ref-set fix-y (:y-on-screen e))
   10.53 +                  (ref-set dragged v)))
   10.54 +        (:mouse-released e
   10.55 +          (dosync (if (= v @dragged)
   10.56 +                    (ref-set dragged nil))))
   10.57 +        (:mouse-dragged e
   10.58 +          (let [x (:x-on-screen e)
   10.59 +                y (:y-on-screen e)
   10.60 +                vx (.getX v)
   10.61 +                vy (.getY v)]
   10.62 +            (dosync
   10.63 +             (when @dragged
   10.64 +               (let [dx (- x @fix-x)
   10.65 +                     dy (- y @fix-y)]
   10.66 +                 (.layoutLocation v (+ vx dx) (+ vy dy))
   10.67 +                 (.invalidateLayout layout)
   10.68 +                 (*update*)
   10.69 +                 (ref-set fix-x x)
   10.70 +                 (ref-set fix-y y))))))))))
   10.71 +  
   10.72 +(defn- draw-movable-vertices!
   10.73 +  [^GraphLayout layout x y dragged-ref fix-x fix-y]
   10.74 +  (let [dragged @dragged-ref]
   10.75 +    (doseq [v (.vertices (.getGraph layout))
   10.76 +            :when (not= v dragged)]
   10.77 +      (draw-movable-vertex! v layout x y dragged-ref fix-x fix-y))
   10.78 +    ;; Draw the vertex being dragged above others.
   10.79 +    (when dragged
   10.80 +      (draw-movable-vertex! dragged layout x y dragged-ref fix-x fix-y))))
   10.81 +    
   10.82 +(defn- draw-edges! [^GraphLayout layout x y]
   10.83 +  ;; TODO: extend Layer on Edge2D and draw like vertices.
   10.84 +  (.translate *graphics* x y)
   10.85 +  (let [path (Path2D$Double.)]
   10.86 +  (doseq [^Edge2D e (.edges (.getGraph layout))]
   10.87 +    (.getPath e path)
   10.88 +    (.draw *graphics* path)))
   10.89 +  (.translate *graphics* (- x) (- y)))
   10.90 +
   10.91 +(defrecord GraphLayer [layout movable dragged fix-x fix-y]
   10.92 +  Layer
   10.93 +  (render! [layer]
   10.94 +     (let [bounds (.getBounds layout)
   10.95 +           x (- (.getX bounds))
   10.96 +           y (- (.getY bounds))]
   10.97 +       (draw-edges! layout x y)
   10.98 +       (if movable
   10.99 +         (draw-movable-vertices! layout x y dragged fix-x fix-y)
  10.100 +         (draw-vertices! layout x y))))
  10.101 +  (layer-size [layer]
  10.102 +     (let [bounds (.getBounds layout)]
  10.103 +       (Size. (.getWidth bounds) (.getHeight bounds))))
  10.104 +  Anchored
  10.105 +  (anchor [layer x-align y-align]
  10.106 +          (let [bounds (.getBounds layout)]
  10.107 +            (Location. (- (.getX bounds))
  10.108 +                       (- (.getY bounds))))))
  10.109 +
  10.110 +(defn graph-layer
  10.111 +  ([graph-layout]
  10.112 +     (graph-layer graph-layout false))
  10.113 +  ([^GraphLayout graph-layout movable]
  10.114 +     (GraphLayer. graph-layout movable (ref nil) (ref 0) (ref 0))))
  10.115 +
  10.116 +(defn build-graph
  10.117 +  "Returns Graph defined by a sequence of pairs of vertex ids,
  10.118 +   and a function that maps vertex id's to Vertex objects."
  10.119 +  [relations f]
  10.120 +  (let [graph (DefaultGraph.)
  10.121 +        vs (reduce #(conj %1 (first %2) (second %2)) #{} relations)
  10.122 +        vm (reduce #(assoc %1 %2 (f %2)) {} vs)
  10.123 +        vs (vals vm)
  10.124 +        es (map #(DefaultEdge2D. (vm (first %)) (vm (second %))) relations)]
  10.125 +    (doseq [v vs]
  10.126 +      (.addVertex graph v))
  10.127 +    (doseq [e es]
  10.128 +      (.addEdge graph e))
  10.129 +    graph))
  10.130 +
  10.131 +(comment
  10.132 +  (let [graph (build-graph
  10.133 +               [[1 2] [1 3] [1 4] [2 4]]
  10.134 +               (fn [_] (RectangularVertex2D. 100 30)))
  10.135 +        layout (ForceDirectedLayout. graph)
  10.136 +        frame (JFrame. "Graph test")
  10.137 +        layer (graph-layer layout true)
  10.138 +        layer (viewport layer :center :center)]
  10.139 +    (.add (.getContentPane frame) (make-jpanel layer))
  10.140 +    (while (not (.update layout)))
  10.141 +    (doto frame
  10.142 +      (.setDefaultCloseOperation JFrame/DISPOSE_ON_CLOSE)
  10.143 +      (.pack)
  10.144 +      (.setVisible true)))
  10.145 +  )
    11.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    11.2 +++ b/src/net/kryshen/indyvon/layers.clj	Thu Jul 29 01:08:34 2010 +0400
    11.3 @@ -0,0 +1,236 @@
    11.4 +;;
    11.5 +;; Copyright (C) 2010 Mikhail Kryshen <mikhail@kryshen.net>
    11.6 +;;
    11.7 +;; This file is part of Indyvon.
    11.8 +;;
    11.9 +
   11.10 +(ns net.kryshen.indyvon.layers
   11.11 +  (:use
   11.12 +   net.kryshen.indyvon.core)
   11.13 +  (:import
   11.14 +   (net.kryshen.indyvon.core Size Location)
   11.15 +   (java.lang.ref SoftReference)
   11.16 +   (java.awt Font Cursor Image Toolkit)
   11.17 +   (java.awt.image ImageObserver)
   11.18 +   (java.awt.font FontRenderContext TextLayout)))
   11.19 +
   11.20 +;; Define as macro to avoid unnecessary calculation of inner and outer
   11.21 +;; sizes in the first case.
   11.22 +(defmacro align-xy [inner outer align first center last]
   11.23 +  `(case ~align
   11.24 +         ~first 0
   11.25 +         ~center (/ (- ~outer ~inner) 2)
   11.26 +         ~last (- ~outer ~inner)))
   11.27 +
   11.28 +(defmacro align-x [inner outer align]
   11.29 +  `(align-xy ~inner ~outer ~align :left :center :right))
   11.30 +
   11.31 +(defmacro align-y [inner outer align]
   11.32 +  `(align-xy ~inner ~outer ~align :top :center :bottom))
   11.33 +
   11.34 +(defmacro decorate-layer [layer & render-tail]
   11.35 +  `(reify
   11.36 +    Layer
   11.37 +    (render! ~@render-tail)
   11.38 +    (layer-size [t#] (layer-size ~layer))
   11.39 +    Anchored
   11.40 +    (anchor [t# xa# ya#] (anchor ~layer xa# ya#))))
   11.41 +
   11.42 +(defn padding
   11.43 +  ([content pad]
   11.44 +     (padding content pad pad pad pad))
   11.45 +  ([content top left bottom right]
   11.46 +     (if (== 0 top left bottom right)
   11.47 +       content
   11.48 +       (reify
   11.49 +        Layer
   11.50 +        (render! [l]
   11.51 +           (draw! content
   11.52 +                  left top
   11.53 +                  (- (:width *bounds*) left right)
   11.54 +                  (- (:height *bounds*) top bottom)))
   11.55 +        (layer-size [l]
   11.56 +           (let [s (layer-size content)]
   11.57 +             (Size. (+ (:width s) left right)
   11.58 +                    (+ (:height s) top bottom))))))))
   11.59 +
   11.60 +(defn border
   11.61 +  "Decorate layer with a border."
   11.62 +  ([content]
   11.63 +     (border content 1))
   11.64 +  ([content width]
   11.65 +     (border content width 0))
   11.66 +  ([content width gap]
   11.67 +     (let [layer (padding content (+ width gap))]
   11.68 +       (decorate-layer layer [_]
   11.69 +         (let [w (:width *bounds*)
   11.70 +               h (:height *bounds*)]
   11.71 +           (with-color (:border-color *theme*)
   11.72 +             (doseq [i (range 0 width)]
   11.73 +               (.drawRect *graphics* i i (- w 1 i i) (- h 1 i i))))
   11.74 +           (render! layer))))))
   11.75 +
   11.76 +(defn panel
   11.77 +  "Opaque layer using theme's alt-back-color."
   11.78 +  ([content]
   11.79 +     (panel content 0))
   11.80 +  ([content gap]
   11.81 +     (let [layer (padding content gap)]
   11.82 +       (decorate-layer layer [_]
   11.83 +         (with-color (:alt-back-color *theme*)
   11.84 +           (.fillRect *graphics* 0 0
   11.85 +                      (:width *bounds*) (:height *bounds*)))
   11.86 +         (render! layer)))))
   11.87 +
   11.88 +(defn- re-split [^java.util.regex.Pattern re s]
   11.89 +  (seq (.split re s)))
   11.90 +
   11.91 +(def text-layout-cache (atom {}))
   11.92 +
   11.93 +(defn- get-text-layout
   11.94 +  [^String line ^Font font ^FontRenderContext font-context]
   11.95 +  (let [key [line font font-context]]
   11.96 +    (or (if-let [^SoftReference softref (@text-layout-cache key)]
   11.97 +          (.get softref)
   11.98 +          (do (swap! text-layout-cache dissoc key)
   11.99 +              false))
  11.100 +        (let [layout (TextLayout. line font font-context)]
  11.101 +          ;;(println "text-layout-cache miss" line)
  11.102 +          (swap! text-layout-cache assoc key (SoftReference. layout))
  11.103 +          layout))))
  11.104 +
  11.105 +(defn- layout-text
  11.106 +  [lines ^Font font ^FontRenderContext font-context]
  11.107 +  (map #(get-text-layout % font font-context) lines))
  11.108 +  ;;(map #(TextLayout. ^String % font font-context) lines))
  11.109 +
  11.110 +(defn- text-width [layouts]
  11.111 +  (reduce (fn [w ^TextLayout tl] (max w (.getAdvance tl))) 0 layouts))
  11.112 +
  11.113 +(defn- text-height [layouts]
  11.114 +  (reduce (fn [w ^TextLayout tl] (+ w (.getAscent tl)
  11.115 +                                   (.getDescent tl)
  11.116 +                                   (.getLeading tl)))
  11.117 +          0 layouts))
  11.118 +
  11.119 +(defn text-layer
  11.120 +  "Creates a layer to display multiline text."
  11.121 +  ([text]
  11.122 +     (text-layer text :left :top))
  11.123 +  ([text h-align v-align]
  11.124 +     (let [lines (re-split #"\r\n|\n|\r|\u0085|\u2028|\u2029" text)]
  11.125 +       (reify Layer
  11.126 +        (render! [layer]
  11.127 +           (let [w (:width *bounds*)
  11.128 +                 h (:height *bounds*)
  11.129 +                 font (.getFont *graphics*)
  11.130 +                 layouts (layout-text lines font *font-context*)
  11.131 +                 y (align-y (text-height layouts) h v-align)]
  11.132 +             (loop [layouts layouts, y y]
  11.133 +               (when-first [^TextLayout layout layouts]
  11.134 +                 (let [ascent (.getAscent layout)
  11.135 +                       lh (+ ascent (.getDescent layout) (.getLeading layout))
  11.136 +                       x (align-x (.getAdvance layout) w h-align)]
  11.137 +                   (.draw layout *graphics* x (+ y ascent))
  11.138 +                   (recur (next layouts) (+ y lh)))))))
  11.139 +        (layer-size [layer]
  11.140 +           (let [layouts (layout-text lines (:font *theme*) *font-context*)
  11.141 +                 width (text-width layouts)
  11.142 +                 height (text-height layouts)]
  11.143 +             (Size. width height)))))))
  11.144 +
  11.145 +(defn- image-observer [update-fn]
  11.146 +  (reify
  11.147 +   ImageObserver
  11.148 +   (imageUpdate [this img infoflags x y width height]
  11.149 +      (update-fn)
  11.150 +      (zero? (bit-and infoflags
  11.151 +                      (bit-or ImageObserver/ALLBITS
  11.152 +                              ImageObserver/ABORT))))))
  11.153 +
  11.154 +(defn image-layer
  11.155 +  [image-or-uri]
  11.156 +  (let [^Image image (if (isa? image-or-uri Image)
  11.157 +                       image-or-uri
  11.158 +                       (.getImage (Toolkit/getDefaultToolkit)
  11.159 +                                  ^java.net.URL image-or-uri))]
  11.160 +    (.prepareImage (Toolkit/getDefaultToolkit) image -1 -1 nil)
  11.161 +    (reify
  11.162 +     Layer
  11.163 +     (render! [layer]
  11.164 +        (.drawImage *graphics* image 0 0
  11.165 +                    ^ImageObserver (image-observer *update*)))
  11.166 +     (layer-size [layer]
  11.167 +        (let [observer (image-observer *update*)
  11.168 +              width (.getWidth image observer)
  11.169 +              height (.getHeight image observer)
  11.170 +              width (if (pos? width) width 1)
  11.171 +              height (if (pos? height) height 1)]
  11.172 +          (Size. width height))))))
  11.173 +
  11.174 +(defn viewport
  11.175 +  "Creates scrollable viewport layer."
  11.176 +  ([content] (viewport content :left :top))
  11.177 +  ([content h-align v-align]
  11.178 +  (let [x (ref 0)
  11.179 +        y (ref 0)
  11.180 +        fix-x (ref 0)
  11.181 +        fix-y (ref 0)
  11.182 +        last-width (ref 0)
  11.183 +        last-height (ref 0)]
  11.184 +    (reify
  11.185 +     Layer
  11.186 +     (render! [layer]
  11.187 +        (with-handlers layer
  11.188 +         (let [anchor (anchor content h-align v-align)
  11.189 +               width (:width *bounds*)
  11.190 +               height (:height *bounds*)]
  11.191 +           (dosync
  11.192 +            (alter x + (align-x width @last-width h-align))
  11.193 +            (alter y + (align-y height @last-height v-align))
  11.194 +            (ref-set last-width width)
  11.195 +            (ref-set last-height height))
  11.196 +           (draw! content (- 0 @x (:x anchor)) (- 0 @y (:y anchor))))
  11.197 +         (:mouse-pressed e
  11.198 +          (dosync
  11.199 +           (ref-set fix-x (:x-on-screen e))
  11.200 +           (ref-set fix-y (:y-on-screen e)))
  11.201 +          (->> Cursor/MOVE_CURSOR Cursor. (.setCursor *target*)))
  11.202 +         (:mouse-released e
  11.203 +          (->> Cursor/DEFAULT_CURSOR Cursor. (.setCursor *target*)))
  11.204 +         (:mouse-dragged e
  11.205 +          (dosync
  11.206 +           (alter x + (- @fix-x (:x-on-screen e)))
  11.207 +           (alter y + (- @fix-y (:y-on-screen e)))
  11.208 +           (ref-set fix-x (:x-on-screen e))
  11.209 +           (ref-set fix-y (:y-on-screen e)))
  11.210 +          (*update*))))
  11.211 +     (layer-size [layer] (layer-size content))))))
  11.212 +
  11.213 +;;
  11.214 +;; Layer context decorators.
  11.215 +;;
  11.216 +
  11.217 +(defmacro handler [layer & handlers]
  11.218 +  `(let [layer# ~layer]
  11.219 +     (decorate-layer layer# [t#]
  11.220 +        (with-handlers t#
  11.221 +          (render! layer#)
  11.222 +          ~@handlers))))
  11.223 +
  11.224 +(defn theme [layer & map-or-keyvals]
  11.225 +  (let [theme (if (== (count map-or-keyvals) 1)
  11.226 +                map-or-keyvals
  11.227 +                (apply array-map map-or-keyvals))]
  11.228 +    (reify
  11.229 +     Layer
  11.230 +     (render! [t]
  11.231 +        (with-theme theme
  11.232 +          (render! layer)))
  11.233 +     (layer-size [t]
  11.234 +        (with-theme theme
  11.235 +          (layer-size layer)))
  11.236 +     Anchored
  11.237 +     (anchor [t xa ya]
  11.238 +        (with-theme theme
  11.239 +          (anchor layer xa ya))))))
    12.1 --- a/test/indyvon/core_test.clj	Wed Jul 28 04:47:30 2010 +0400
    12.2 +++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
    12.3 @@ -1,6 +0,0 @@
    12.4 -(ns indyvon.core-test
    12.5 -  (:use [indyvon.core] :reload-all)
    12.6 -  (:use [clojure.test]))
    12.7 -
    12.8 -(deftest replace-me ;; FIXME: write
    12.9 -  (is false))