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