1.1 --- a/project.clj	Mon Jun 21 01:18:50 2010 +0400
     1.2 +++ b/project.clj	Mon Jun 21 04:00:45 2010 +0400
     1.3 @@ -1,8 +1,8 @@
     1.4  (defproject indyvon "1.0.0-SNAPSHOT"
     1.5 -  :description "FIXME: write"
     1.6 +  :description "INteractive DYnamic VisualizatiON library"
     1.7    :dependencies [[org.clojure/clojure "1.2.0-master-SNAPSHOT"]
     1.8                   [org.clojure/clojure-contrib "1.2.0-SNAPSHOT"]]
     1.9    :dev-dependencies [[leiningen/lein-swank "1.2.0-SNAPSHOT"]]
    1.10    :namespaces [indyvon.core
    1.11 -               indyvon.event
    1.12 +               indyvon.layers
    1.13                 indyvon.component])

     2.1 --- a/src/indyvon/component.clj	Mon Jun 21 01:18:50 2010 +0400
     2.2 +++ b/src/indyvon/component.clj	Mon Jun 21 04:00:45 2010 +0400
     2.3 @@ -5,10 +5,8 @@
     2.4  ;;
     2.5  
     2.6  (ns indyvon.component
     2.7 -  (:use indyvon.core)
     2.8 -  (:require (indyvon [event :as event]))
     2.9 +  (:use indyvon.core indyvon.layers)
    2.10    (:import (java.awt Component Dimension Color)
    2.11 -           (java.awt.event MouseEvent)
    2.12             (javax.swing JFrame JPanel)))
    2.13  
    2.14  (defn- font-context [component]
    2.15 @@ -35,7 +33,7 @@
    2.16  
    2.17  (defn make-jpanel
    2.18    ([layer]
    2.19 -     (make-jpanel layer (event/make-event-dispatcher)))
    2.20 +     (make-jpanel layer (make-event-dispatcher)))
    2.21    ([layer event-dispatcher]
    2.22       (let [context (default-context)
    2.23             context (assoc context :dispatcher event-dispatcher)
    2.24 @@ -53,9 +51,6 @@
    2.25    (do
    2.26      (def frame (JFrame. "Test"))
    2.27      
    2.28 -    (defn handler [event context]
    2.29 -      (println (:layer context) (.paramString event)))
    2.30 -      
    2.31      (def layer1
    2.32           (reify
    2.33            Layer
    2.34 @@ -65,7 +60,7 @@
    2.35            (size [this context] [30 20])
    2.36            MouseHandler
    2.37            (handle-mouse [this context event]
    2.38 -             (println "layer1" (.paramString event)))))
    2.39 +             (println "layer1" event))))
    2.40      
    2.41      (def layer1b (border-layer layer1 2 3))
    2.42      
    2.43 @@ -80,7 +75,7 @@
    2.44            (size [this context] [70 65])
    2.45            MouseHandler
    2.46            (handle-mouse [this context event]
    2.47 -             (println "layer2" (.paramString event)))))
    2.48 +             (println "layer2" event))))
    2.49      
    2.50      (def layer3
    2.51           (border-layer (text-layer "Sample\ntext" :right :center)))

     3.1 --- a/src/indyvon/core.clj	Mon Jun 21 01:18:50 2010 +0400
     3.2 +++ b/src/indyvon/core.clj	Mon Jun 21 04:00:45 2010 +0400
     3.3 @@ -5,15 +5,17 @@
     3.4  ;;
     3.5  
     3.6  (ns indyvon.core
     3.7 -  (:import (java.awt Color Font Cursor)
     3.8 -           (java.awt.font FontRenderContext TextLayout)
     3.9 -           (java.awt.event MouseEvent)))
    3.10 +  (:import (java.awt Color Font)
    3.11 +           (java.awt.event MouseListener MouseMotionListener)))
    3.12  
    3.13  (defprotocol Layer
    3.14    "Basic UI element."
    3.15    (render! [this context graphics])
    3.16    (size [this context]))
    3.17  
    3.18 +;; TODO: modifiers
    3.19 +(defrecord MouseEvent [id when x y x-on-screen y-on-screen button])
    3.20 +
    3.21  (defprotocol MouseHandler
    3.22    "Layers that also satisfy this protocol will recieve mouse events."
    3.23    (handle-mouse [this context event]))
    3.24 @@ -25,6 +27,29 @@
    3.25    (hovered? [this layer])
    3.26    (picked? [this layer]))
    3.27  
    3.28 +(defprotocol Anchored
    3.29 +  "Provide anchor point for Layers. Used by viewport."
    3.30 +  (anchor [this context h-align v-align]
    3.31 +          "Anchor point: [x y], h-align could be :left, :center
    3.32 +           or :right, v-align is :top, :center or :bottom"))
    3.33 +
    3.34 +;; Default implementation of Anchored for any Layer.
    3.35 +(extend-protocol Anchored
    3.36 +  indyvon.core.Layer
    3.37 +  (anchor [this context h-align v-align]
    3.38 +          (if (and (= h-align :left)
    3.39 +                   (= v-align :top))
    3.40 +            [0 0]
    3.41 +            (let [size (size this context)]
    3.42 +              [(case h-align
    3.43 +                 :top 0
    3.44 +                 :center (/ (size 0) 2)
    3.45 +                 :right (size 0))
    3.46 +               (case v-align
    3.47 +                 :left 0
    3.48 +                 :center (/ (size 1) 2)
    3.49 +                 :bottom (size 1))]))))
    3.50 +
    3.51  (defrecord Theme [fore-color back-color border-color font])
    3.52  
    3.53  (defn default-theme []
    3.54 @@ -81,134 +106,151 @@
    3.55            (.dispose graphics))))))
    3.56  
    3.57  ;;
    3.58 -;; Layer implementations.
    3.59 +;; EventDispatcher implementation
    3.60  ;;
    3.61  
    3.62 -(defn border-layer
    3.63 -  "Decorate layer with a border."
    3.64 -  ([content]
    3.65 -     (border-layer content 1))
    3.66 -  ([content width]
    3.67 -     (border-layer content width 0))
    3.68 -  ([content width gap]
    3.69 -     (let [offset (+ width gap)]
    3.70 -       (reify Layer
    3.71 -        (render! [l c g]
    3.72 -           (let [w (:width c)
    3.73 -                 h (:height c)]
    3.74 -             (.setColor g (-> c :theme :border-color))
    3.75 -             (doseq [i (range 0 width)]
    3.76 -               (.drawRect g i i (- w 1 i i) (- h 1 i i)))
    3.77 -             (draw! content c g offset offset (- w offset offset)
    3.78 -                    (- h offset offset))))
    3.79 -        (size [l c]
    3.80 -           (let [s (size content c)]
    3.81 -             [(+ (s 0) offset offset)
    3.82 -              (+ (s 1) offset offset)]))))))
    3.83 +(def awt-events
    3.84 +     {java.awt.event.MouseEvent/MOUSE_CLICKED  :mouse-clicked
    3.85 +      java.awt.event.MouseEvent/MOUSE_DRAGGED  :mouse-dragged
    3.86 +      java.awt.event.MouseEvent/MOUSE_ENTERED  :mouse-entered
    3.87 +      java.awt.event.MouseEvent/MOUSE_EXITED   :mouse-exited
    3.88 +      java.awt.event.MouseEvent/MOUSE_MOVED    :mouse-moved
    3.89 +      java.awt.event.MouseEvent/MOUSE_PRESSED  :mouse-pressed
    3.90 +      java.awt.event.MouseEvent/MOUSE_RELEASED :mouse-released})
    3.91  
    3.92 -;; Define as macro to avoid unnecessary calculation of inner and outer
    3.93 -;; sizes in the first case.
    3.94 -(defmacro align-xy [inner outer align first center last]
    3.95 -  `(case ~align
    3.96 -         ~first 0
    3.97 -         ~center (/ (- ~outer ~inner) 2)
    3.98 -         ~last (- ~outer ~inner)))
    3.99 +(defn- registered-parent
   3.100 +  "Returns first context parent registered for event processing."
   3.101 +  [context-tree context]
   3.102 +  (let [parent (:parent context)]
   3.103 +    (cond
   3.104 +     (nil? parent) nil
   3.105 +     (contains? context-tree parent) parent
   3.106 +     :default (recur context-tree parent))))
   3.107  
   3.108 -(defmacro align-x [inner outer align]
   3.109 -  `(align-xy ~inner ~outer ~align :left :center :right))
   3.110 +(defn- add-context
   3.111 +  [context-tree context]
   3.112 +  (let [parent (registered-parent context-tree context)]
   3.113 +    (assoc context-tree parent (cons context (context-tree parent))
   3.114 +           context nil)))
   3.115  
   3.116 -(defmacro align-y [inner outer align]
   3.117 -  `(align-xy ~inner ~outer ~align :top :center :bottom))
   3.118 +(defn- inside?
   3.119 +  ([x y context]
   3.120 +     (inside? x y (:x context) (:y context)
   3.121 +              (:width context) (:height context)))
   3.122 +  ([px py x y w h]
   3.123 +     (and (>= px x)
   3.124 +          (>= py y)
   3.125 +          (< px (+ x w))
   3.126 +          (< py (+ y h)))))
   3.127  
   3.128 -(defn- re-split [re s]
   3.129 -  (seq (.split re s)))
   3.130 +(defn- under-cursor
   3.131 +  "Returns a sequence of contexts under cursor."
   3.132 +  ([context-tree x y]
   3.133 +     (under-cursor context-tree x y nil))
   3.134 +  ([context-tree x y context]
   3.135 +     (some #(if (inside? x y %)
   3.136 +              (conj (under-cursor context-tree x y %) %))
   3.137 +           (context-tree context))))
   3.138  
   3.139 -(defn- layout-text [lines font font-context]
   3.140 -  (map #(TextLayout. % font font-context) lines))
   3.141 +(defn- remove-all [coll1 coll2 pred]
   3.142 +  (filter #(not (some (partial pred %) coll2)) coll1))
   3.143  
   3.144 -(defn- text-width [layouts]
   3.145 -  (reduce #(max %1 (.getAdvance %2)) 0 layouts))
   3.146 +;; (defn- translate-mouse-event
   3.147 +;;   [event x y id]
   3.148 +;;   (proxy [MouseEvent] [(.getComponent event)
   3.149 +;;                        id
   3.150 +;;                        (.getWhen event)
   3.151 +;;                        (.getModifiers event)
   3.152 +;;                        (- (.getX event) x)
   3.153 +;;                        (- (.getY event) y)
   3.154 +;;                        (.getClickCount event)
   3.155 +;;                        (.isPopupTrigger event)]
   3.156 +;;     (getXOnScreen [] (.getXOnScreen event))
   3.157 +;;     (getYOnScreen [] (.getYOnScreen event))))
   3.158  
   3.159 -(defn- text-height [layouts]
   3.160 -  (reduce #(+ %1 (.getAscent %2) (.getDescent %2) (.getLeading %2))
   3.161 -          0 layouts))
   3.162 +(defn- translate-mouse-event
   3.163 +  [event x y id]
   3.164 +  (MouseEvent. id (.getWhen event)
   3.165 +               (- (.getX event) x) (- (.getY event) y)
   3.166 +               (.getXOnScreen event) (.getYOnScreen event)
   3.167 +               (.getButton event)))
   3.168  
   3.169 -(defn text-layer
   3.170 -  "Creates a layer to display multiline text."
   3.171 -  ([text]
   3.172 -     (text-layer text :left :top))
   3.173 -  ([text h-align v-align]
   3.174 -     (let [lines (re-split #"\r\n|\n|\r|\u0085|\u2028|\u2029" text)]
   3.175 -       (reify Layer
   3.176 -        (render! [l c g]
   3.177 -           (let [w (:width c)
   3.178 -                 h (:height c)
   3.179 -                 font (.getFont g)
   3.180 -                 font-context (:font-context c)
   3.181 -                 layouts (layout-text lines font font-context)
   3.182 -                 y (align-y (text-height layouts) h v-align)]
   3.183 -             (loop [layouts layouts, y y]
   3.184 -               (when-first [layout layouts]
   3.185 -                 (let [ascent (.getAscent layout)
   3.186 -                       lh (+ ascent (.getDescent layout) (.getLeading layout))
   3.187 -                       x (align-x (.getAdvance layout) w h-align)]
   3.188 -                   (.draw layout g x (+ y ascent))
   3.189 -                   (recur (next layouts) (+ y lh)))))))
   3.190 -        (size [l c]
   3.191 -           (let [layouts (layout-text lines
   3.192 -                                      (-> c :theme :font)
   3.193 -                                      (:font-context c))
   3.194 -                 width (text-width layouts)
   3.195 -                 height (text-height layouts)]
   3.196 -             [width height]))))))
   3.197 +(defn- translate-and-dispatch
   3.198 +  ([contexts event]
   3.199 +     (translate-and-dispatch contexts event (awt-events (.getID event))))
   3.200 +  ([contexts event id]
   3.201 +     (doseq [context contexts]
   3.202 +       (handle-mouse
   3.203 +        (:layer context) context 
   3.204 +        (translate-mouse-event event (:x context) (:y context) id)))
   3.205 +     id))
   3.206  
   3.207 -(defprotocol Anchored
   3.208 -  "Provide anchor point for Layers. Used by viewport."
   3.209 -  (anchor [this context] "Anchor point: [x y]"))
   3.210 +(defn- dispatch-mouse-motion*
   3.211 +  "Dispatches mouse motion events. Returns a new set of contexts which
   3.212 +  currently are under cursor."
   3.213 +  [hovered context-tree event]
   3.214 +  (let [x (.getX event)
   3.215 +        y (.getY event)
   3.216 +        hovered2 (under-cursor context-tree x y)
   3.217 +        pred #(= (:layer %1) (:layer %2))
   3.218 +        exited (remove-all hovered hovered2 pred)
   3.219 +        entered (remove-all hovered2 hovered pred)
   3.220 +        moved (remove-all hovered2 entered pred)]
   3.221 +    (translate-and-dispatch exited event :mouse-exited)
   3.222 +    (translate-and-dispatch entered event :mouse-entered)
   3.223 +    (translate-and-dispatch moved event :mouse-moved)
   3.224 +    hovered2))
   3.225  
   3.226 -;; Default implementation of Anchored for any Layer.
   3.227 -(extend-protocol Anchored
   3.228 -  indyvon.core.Layer
   3.229 -  (anchor [this context] [0 0]))
   3.230 +(defn- dispatch-mouse-motion
   3.231 +  [hovered-ref context-tree event]
   3.232 +  (dosync
   3.233 +   (alter hovered-ref dispatch-mouse-motion* context-tree event)))
   3.234  
   3.235 -(defn viewport
   3.236 -  "Creates scrollable viewport layer."
   3.237 -  ([content] (viewport content :left :top))
   3.238 -  ([content h-align v-align]
   3.239 -  (let [x (ref 0)
   3.240 -        y (ref 0)
   3.241 -        fix-x (ref 0)
   3.242 -        fix-y (ref 0)
   3.243 -        last-width (ref 0)
   3.244 -        last-height (ref 0)]
   3.245 +(defn- dispatch-mouse-button*
   3.246 +  "Dispatches mouse button events. Returns a new set of contexts which
   3.247 +  currently are picked with a pressed button."
   3.248 +  [picked hovered event]
   3.249 +  (if (= (translate-and-dispatch hovered event) :mouse-pressed)
   3.250 +    hovered
   3.251 +    nil))
   3.252 +
   3.253 +(defn- dispatch-mouse-button
   3.254 +  [picked-ref hovered-ref event]
   3.255 +  (dosync
   3.256 +   (alter picked-ref dispatch-mouse-button* @hovered-ref event)))
   3.257 +
   3.258 +(defn make-event-dispatcher []
   3.259 +  (let [context-tree-r (ref {}) ; register
   3.260 +        context-tree (ref {})   ; dispatch
   3.261 +        hovered (ref '())
   3.262 +        picked (ref '())]
   3.263      (reify
   3.264 -     Layer
   3.265 -     (render! [layer c g]
   3.266 -        (let [anchor (anchor content c)
   3.267 -              width (:width c)
   3.268 -              height (:height c)]
   3.269 -          (dosync
   3.270 -           (alter x + (align-x width @last-width h-align))
   3.271 -           (alter y + (align-y height @last-height v-align))
   3.272 -           (ref-set last-width width)
   3.273 -           (ref-set last-height height))
   3.274 -          (draw! content c g
   3.275 -                 (- 0 @x (anchor 0))
   3.276 -                 (- 0 @y (anchor 1)))))
   3.277 -     (size [layer c] (size content c))
   3.278 -     MouseHandler
   3.279 -     (handle-mouse [layer c e]
   3.280 -        (when (= (.getID e) MouseEvent/MOUSE_PRESSED)
   3.281 -          (dosync
   3.282 -           (ref-set fix-x (.getXOnScreen e))
   3.283 -           (ref-set fix-y (.getYOnScreen e)))
   3.284 -          (->> Cursor/MOVE_CURSOR Cursor. (.setCursor (:target c))))
   3.285 -        (when (= (.getID e) MouseEvent/MOUSE_RELEASED)
   3.286 -          (->> Cursor/DEFAULT_CURSOR Cursor. (.setCursor (:target c))))
   3.287 -        (when (= (.getID e) MouseEvent/MOUSE_DRAGGED)
   3.288 -          (dosync
   3.289 -           (alter x + (- @fix-x (.getXOnScreen e)))
   3.290 -           (alter y + (- @fix-y (.getYOnScreen e)))
   3.291 -           (ref-set fix-x (.getXOnScreen e))
   3.292 -           (ref-set fix-y (.getYOnScreen e)))
   3.293 -          (update c)))))))
   3.294 +     EventDispatcher
   3.295 +     (listen! [this component]
   3.296 +        (doto component
   3.297 +          (.addMouseListener this)
   3.298 +          (.addMouseMotionListener this)))
   3.299 +     (register [this context]
   3.300 +        (when (satisfies? MouseHandler (:layer context))
   3.301 +          (dosync (alter context-tree-r add-context context))))
   3.302 +     (commit [this]
   3.303 +        (dosync (ref-set context-tree @context-tree-r)
   3.304 +                (ref-set context-tree-r {})))
   3.305 +     (picked? [this layer] false)
   3.306 +     (hovered? [this layer] false)
   3.307 +     MouseListener
   3.308 +     (mouseEntered [this event]
   3.309 +        (dispatch-mouse-motion hovered @context-tree event))
   3.310 +     (mouseExited [this event]
   3.311 +        (dispatch-mouse-motion hovered @context-tree event))
   3.312 +     (mouseClicked [this event]
   3.313 +        (dispatch-mouse-button picked hovered event))
   3.314 +     (mousePressed [this event]
   3.315 +        (dispatch-mouse-button picked hovered event))
   3.316 +     (mouseReleased [this event]
   3.317 +        (dispatch-mouse-button picked hovered event))
   3.318 +     MouseMotionListener
   3.319 +     (mouseDragged [this event]
   3.320 +        (translate-and-dispatch @picked event))
   3.321 +     (mouseMoved [this event]
   3.322 +        (dispatch-mouse-motion hovered @context-tree event)))))

     4.1 --- a/src/indyvon/event.clj	Mon Jun 21 01:18:50 2010 +0400
     4.2 +++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
     4.3 @@ -1,140 +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 indyvon.event
    4.11 -  (:use indyvon.core)
    4.12 -  (:import (java.awt.event MouseEvent MouseListener MouseMotionListener)
    4.13 -           java.lang.ref.WeakReference))
    4.14 -
    4.15 -(defn- registered-parent
    4.16 -  "Returns first context parent registered for event processing."
    4.17 -  [context-tree context]
    4.18 -  (let [parent (:parent context)]
    4.19 -    (cond
    4.20 -     (nil? parent) nil
    4.21 -     (contains? context-tree parent) parent
    4.22 -     :default (recur context-tree parent))))
    4.23 -
    4.24 -(defn- add-context
    4.25 -  [context-tree context]
    4.26 -  (let [parent (registered-parent context-tree context)]
    4.27 -    (assoc context-tree parent (cons context (context-tree parent))
    4.28 -           context nil)))
    4.29 -
    4.30 -(defn- inside?
    4.31 -  ([x y context]
    4.32 -     (inside? x y (:x context) (:y context)
    4.33 -              (:width context) (:height context)))
    4.34 -  ([px py x y w h]
    4.35 -     (and (>= px x)
    4.36 -          (>= py y)
    4.37 -          (< px (+ x w))
    4.38 -          (< py (+ y h)))))
    4.39 -
    4.40 -(defn- under-cursor
    4.41 -  "Returns a sequence of contexts under cursor."
    4.42 -  ([context-tree x y]
    4.43 -     (under-cursor context-tree x y nil))
    4.44 -  ([context-tree x y context]
    4.45 -     (some #(if (inside? x y %)
    4.46 -              (conj (under-cursor context-tree x y %) %))
    4.47 -           (context-tree context))))
    4.48 -
    4.49 -(defn- remove-all [coll1 coll2 pred]
    4.50 -  (filter #(not (some (partial pred %) coll2)) coll1))
    4.51 -
    4.52 -(defn- translate-mouse-event
    4.53 -  [event x y id]
    4.54 -  (proxy [MouseEvent] [(.getComponent event)
    4.55 -                       id
    4.56 -                       (.getWhen event)
    4.57 -                       (.getModifiers event)
    4.58 -                       (- (.getX event) x)
    4.59 -                       (- (.getY event) y)
    4.60 -                       (.getClickCount event)
    4.61 -                       (.isPopupTrigger event)]
    4.62 -    (getXOnScreen [] (.getXOnScreen event))
    4.63 -    (getYOnScreen [] (.getYOnScreen event))))
    4.64 -
    4.65 -(defn- translate-and-dispatch
    4.66 -  ([contexts event]
    4.67 -     (translate-and-dispatch contexts event (.getID event)))
    4.68 -  ([contexts event id]
    4.69 -     (doseq [context contexts]
    4.70 -       (handle-mouse
    4.71 -        (:layer context) context 
    4.72 -        (translate-mouse-event event (:x context) (:y context) id)))))
    4.73 -
    4.74 -(defn- dispatch-mouse-motion*
    4.75 -  "Dispatches mouse motion events. Returns a new set of contexts which
    4.76 -  currently are under cursor."
    4.77 -  [hovered context-tree event]
    4.78 -  (let [x (.getX event)
    4.79 -        y (.getY event)
    4.80 -        hovered2 (under-cursor context-tree x y)
    4.81 -        pred #(= (:layer %1) (:layer %2))
    4.82 -        exited (remove-all hovered hovered2 pred)
    4.83 -        entered (remove-all hovered2 hovered pred)
    4.84 -        moved (remove-all hovered2 entered pred)]
    4.85 -    (translate-and-dispatch exited event MouseEvent/MOUSE_EXITED)
    4.86 -    (translate-and-dispatch entered event MouseEvent/MOUSE_ENTERED)
    4.87 -    (translate-and-dispatch moved event MouseEvent/MOUSE_MOVED)
    4.88 -    hovered2))
    4.89 -
    4.90 -(defn- dispatch-mouse-motion
    4.91 -  [hovered-ref context-tree event]
    4.92 -  (dosync
    4.93 -   (alter hovered-ref dispatch-mouse-motion* context-tree event)))
    4.94 -
    4.95 -(defn- dispatch-mouse-button*
    4.96 -  "Dispatches mouse button events. Returns a new set of contexts which
    4.97 -  currently are picked with a pressed button."
    4.98 -  [picked hovered event]
    4.99 -  (translate-and-dispatch hovered event)
   4.100 -  (if (= (.getID event) MouseEvent/MOUSE_PRESSED)
   4.101 -    hovered
   4.102 -    nil))
   4.103 -
   4.104 -(defn- dispatch-mouse-button
   4.105 -  [picked-ref hovered-ref event]
   4.106 -  (dosync
   4.107 -   (alter picked-ref dispatch-mouse-button* @hovered-ref event)))
   4.108 -
   4.109 -(defn make-event-dispatcher []
   4.110 -  (let [context-tree-r (ref {}) ; register
   4.111 -        context-tree (ref {})   ; dispatch
   4.112 -        hovered (ref '())
   4.113 -        picked (ref '())]
   4.114 -    (reify
   4.115 -     EventDispatcher
   4.116 -     (listen! [this component]
   4.117 -        (doto component
   4.118 -          (.addMouseListener this)
   4.119 -          (.addMouseMotionListener this)))
   4.120 -     (register [this context]
   4.121 -        (when (satisfies? MouseHandler (:layer context))
   4.122 -          (dosync (alter context-tree-r add-context context))))
   4.123 -     (commit [this]
   4.124 -        (dosync (ref-set context-tree @context-tree-r)
   4.125 -                (ref-set context-tree-r {})))
   4.126 -     (picked? [this layer] false)
   4.127 -     (hovered? [this layer] false)
   4.128 -     MouseListener
   4.129 -     (mouseEntered [this event]
   4.130 -        (dispatch-mouse-motion hovered @context-tree event))
   4.131 -     (mouseExited [this event]
   4.132 -        (dispatch-mouse-motion hovered @context-tree event))
   4.133 -     (mouseClicked [this event]
   4.134 -        (dispatch-mouse-button picked hovered event))
   4.135 -     (mousePressed [this event]
   4.136 -        (dispatch-mouse-button picked hovered event))
   4.137 -     (mouseReleased [this event]
   4.138 -        (dispatch-mouse-button picked hovered event))
   4.139 -     MouseMotionListener
   4.140 -     (mouseDragged [this event]
   4.141 -        (translate-and-dispatch @picked event))
   4.142 -     (mouseMoved [this event]
   4.143 -        (dispatch-mouse-motion hovered @context-tree event)))))

     5.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
     5.2 +++ b/src/indyvon/layers.clj	Mon Jun 21 04:00:45 2010 +0400
     5.3 @@ -0,0 +1,134 @@
     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 indyvon.layers
    5.11 +  (:use indyvon.core)
    5.12 +  (:import (java.awt Cursor)
    5.13 +           (java.awt.font FontRenderContext TextLayout)))
    5.14 +
    5.15 +;; Define as macro to avoid unnecessary calculation of inner and outer
    5.16 +;; sizes in the first case.
    5.17 +(defmacro align-xy [inner outer align first center last]
    5.18 +  `(case ~align
    5.19 +         ~first 0
    5.20 +         ~center (/ (- ~outer ~inner) 2)
    5.21 +         ~last (- ~outer ~inner)))
    5.22 +
    5.23 +(defmacro align-x [inner outer align]
    5.24 +  `(align-xy ~inner ~outer ~align :left :center :right))
    5.25 +
    5.26 +(defmacro align-y [inner outer align]
    5.27 +  `(align-xy ~inner ~outer ~align :top :center :bottom))
    5.28 +
    5.29 +(defn border-layer
    5.30 +  "Decorate layer with a border."
    5.31 +  ([content]
    5.32 +     (border-layer content 1))
    5.33 +  ([content width]
    5.34 +     (border-layer content width 0))
    5.35 +  ([content width gap]
    5.36 +     (let [offset (+ width gap)]
    5.37 +       (reify Layer
    5.38 +        (render! [l c g]
    5.39 +           (let [w (:width c)
    5.40 +                 h (:height c)]
    5.41 +             (.setColor g (-> c :theme :border-color))
    5.42 +             (doseq [i (range 0 width)]
    5.43 +               (.drawRect g i i (- w 1 i i) (- h 1 i i)))
    5.44 +             (draw! content c g offset offset (- w offset offset)
    5.45 +                    (- h offset offset))))
    5.46 +        (size [l c]
    5.47 +           (let [s (size content c)]
    5.48 +             [(+ (s 0) offset offset)
    5.49 +              (+ (s 1) offset offset)]))))))
    5.50 +
    5.51 +(defn- re-split [re s]
    5.52 +  (seq (.split re s)))
    5.53 +
    5.54 +(defn- layout-text [lines font font-context]
    5.55 +  (map #(TextLayout. % font font-context) lines))
    5.56 +
    5.57 +(defn- text-width [layouts]
    5.58 +  (reduce #(max %1 (.getAdvance %2)) 0 layouts))
    5.59 +
    5.60 +(defn- text-height [layouts]
    5.61 +  (reduce #(+ %1 (.getAscent %2) (.getDescent %2) (.getLeading %2))
    5.62 +          0 layouts))
    5.63 +
    5.64 +(defn text-layer
    5.65 +  "Creates a layer to display multiline text."
    5.66 +  ([text]
    5.67 +     (text-layer text :left :top))
    5.68 +  ([text h-align v-align]
    5.69 +     (let [lines (re-split #"\r\n|\n|\r|\u0085|\u2028|\u2029" text)]
    5.70 +       (reify Layer
    5.71 +        (render! [l c g]
    5.72 +           (let [w (:width c)
    5.73 +                 h (:height c)
    5.74 +                 font (.getFont g)
    5.75 +                 font-context (:font-context c)
    5.76 +                 layouts (layout-text lines font font-context)
    5.77 +                 y (align-y (text-height layouts) h v-align)]
    5.78 +             (loop [layouts layouts, y y]
    5.79 +               (when-first [layout layouts]
    5.80 +                 (let [ascent (.getAscent layout)
    5.81 +                       lh (+ ascent (.getDescent layout) (.getLeading layout))
    5.82 +                       x (align-x (.getAdvance layout) w h-align)]
    5.83 +                   (.draw layout g x (+ y ascent))
    5.84 +                   (recur (next layouts) (+ y lh)))))))
    5.85 +        (size [l c]
    5.86 +           (let [layouts (layout-text lines
    5.87 +                                      (-> c :theme :font)
    5.88 +                                      (:font-context c))
    5.89 +                 width (text-width layouts)
    5.90 +                 height (text-height layouts)]
    5.91 +             [width height]))))))
    5.92 +
    5.93 +(defn viewport
    5.94 +  "Creates scrollable viewport layer."
    5.95 +  ([content] (viewport content :left :top))
    5.96 +  ([content h-align v-align]
    5.97 +  (let [x (ref 0)
    5.98 +        y (ref 0)
    5.99 +        fix-x (ref 0)
   5.100 +        fix-y (ref 0)
   5.101 +        last-width (ref 0)
   5.102 +        last-height (ref 0)]
   5.103 +    (reify
   5.104 +     Layer
   5.105 +     (render! [layer c g]
   5.106 +        (let [anchor (anchor content c h-align v-align)
   5.107 +              width (:width c)
   5.108 +              height (:height c)]
   5.109 +          (dosync
   5.110 +           (alter x + (align-x width @last-width h-align))
   5.111 +           (alter y + (align-y height @last-height v-align))
   5.112 +           (ref-set last-width width)
   5.113 +           (ref-set last-height height))
   5.114 +          (draw! content c g
   5.115 +                 (- 0 @x (anchor 0))
   5.116 +                 (- 0 @y (anchor 1)))))
   5.117 +     (size [layer c] (size content c))
   5.118 +     MouseHandler
   5.119 +     (handle-mouse [layer c e]
   5.120 +       (case (:id e)
   5.121 +         :mouse-pressed
   5.122 +         (do
   5.123 +           (dosync
   5.124 +            (ref-set fix-x (:x-on-screen e))
   5.125 +            (ref-set fix-y (:y-on-screen e)))
   5.126 +           (->> Cursor/MOVE_CURSOR Cursor. (.setCursor (:target c))))
   5.127 +         :mouse-released
   5.128 +         (->> Cursor/DEFAULT_CURSOR Cursor. (.setCursor (:target c)))
   5.129 +         :mouse-dragged
   5.130 +         (do
   5.131 +           (dosync
   5.132 +            (alter x + (- @fix-x (:x-on-screen e)))
   5.133 +            (alter y + (- @fix-y (:y-on-screen e)))
   5.134 +            (ref-set fix-x (:x-on-screen e))
   5.135 +            (ref-set fix-y (:y-on-screen e)))
   5.136 +           (update c))
   5.137 +         nil))))))