changeset 36:5413b188d112

Rename namespaces: indyvon to kryshen.indyvon.
author Mikhail Kryshen <mikhail@kryshen.net>
date Thu, 08 Jul 2010 07:03:24 +0400
parents 0d593970cb76
children d2fb660ca49f
files project.clj src/indyvon/component.clj src/indyvon/core.clj src/indyvon/demo.clj src/indyvon/layers.clj src/kryshen/indyvon/component.clj src/kryshen/indyvon/core.clj src/kryshen/indyvon/demo.clj src/kryshen/indyvon/layers.clj
diffstat 9 files changed, 584 insertions(+), 584 deletions(-) [+]
line diff
     1.1 --- a/project.clj	Thu Jul 08 06:02:12 2010 +0400
     1.2 +++ b/project.clj	Thu Jul 08 07:03:24 2010 +0400
     1.3 @@ -3,7 +3,7 @@
     1.4    :dependencies [[org.clojure/clojure "1.2.0-master-SNAPSHOT"]
     1.5                   [org.clojure/clojure-contrib "1.2.0-SNAPSHOT"]]
     1.6    :dev-dependencies [[leiningen/lein-swank "1.2.0-SNAPSHOT"]]
     1.7 -  :namespaces [indyvon.core
     1.8 -               indyvon.layers
     1.9 -               indyvon.component
    1.10 -               indyvon.demo])
    1.11 +  :namespaces [kryshen.indyvon.core
    1.12 +               kryshen.indyvon.layers
    1.13 +               kryshen.indyvon.component
    1.14 +               kryshen.indyvon.demo])
     2.1 --- a/src/indyvon/component.clj	Thu Jul 08 06:02:12 2010 +0400
     2.2 +++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
     2.3 @@ -1,52 +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 indyvon.component
    2.11 -  (:use indyvon.core
    2.12 -        indyvon.layers)
    2.13 -  (:import (indyvon.core Size Bounds)
    2.14 -           (java.awt Graphics2D Component Dimension Color)
    2.15 -           (javax.swing JFrame JPanel)))
    2.16 -
    2.17 -(defn- font-context [^Component component]
    2.18 -  (.getFontRenderContext (.getFontMetrics component (.getFont component))))
    2.19 -
    2.20 -(defn paint-component
    2.21 -  [^Component component layer ^Graphics2D graphics event-dispatcher]
    2.22 -  (let [size (.getSize component)
    2.23 -        width (.width size)
    2.24 -        height (.height size)]
    2.25 -    (.clearRect graphics 0 0 width height)
    2.26 -    (let [bounds (Bounds. 0 0 width height)]
    2.27 -      (binding [*graphics* graphics
    2.28 -                *font-context* (.getFontRenderContext graphics)
    2.29 -                *target* component
    2.30 -                *event-dispatcher* event-dispatcher
    2.31 -                *update* #(.repaint component)
    2.32 -                *bounds* bounds
    2.33 -                *clip* bounds]
    2.34 -        (render! layer nil)
    2.35 -        (commit event-dispatcher)))))
    2.36 -
    2.37 -(defn preferred-size [component layer]
    2.38 -  (binding [*target* component
    2.39 -            *font-context*' (font-context component)]
    2.40 -    (let [s (size layer nil)]
    2.41 -      (Dimension. (:width s) (:height s)))))
    2.42 -
    2.43 -(defn make-jpanel
    2.44 -  ([layer]
    2.45 -     (make-jpanel layer (root-event-dispatcher)))
    2.46 -  ([layer event-dispatcher]
    2.47 -     (let [panel
    2.48 -           (proxy [JPanel] []
    2.49 -             (paintComponent [g]
    2.50 -                (paint-component this layer g event-dispatcher))
    2.51 -             (getPreferredSize []
    2.52 -                (preferred-size this layer)))]
    2.53 -       (.setBackground panel (:back-color *theme*))
    2.54 -       (listen! event-dispatcher panel)
    2.55 -       panel)))
     3.1 --- a/src/indyvon/core.clj	Thu Jul 08 06:02:12 2010 +0400
     3.2 +++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
     3.3 @@ -1,310 +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 indyvon.core
    3.11 -  (:import (java.awt Graphics2D Component Color Font)
    3.12 -           (java.awt.event MouseListener MouseMotionListener)
    3.13 -           (java.awt.font FontRenderContext)))
    3.14 -
    3.15 -(def ^Graphics2D *graphics*)
    3.16 -(def ^FontRenderContext *font-context*)
    3.17 -(def ^Component *target*)
    3.18 -(def *bounds*)
    3.19 -(def *clip*)
    3.20 -(def *update*)
    3.21 -(def *event-dispatcher*)
    3.22 -
    3.23 -(defrecord Theme [fore-color back-color border-color font])
    3.24 -
    3.25 -(defn default-theme []
    3.26 -  (Theme. Color/BLACK Color/WHITE Color/BLUE (Font. "Sans" Font/PLAIN 12)))
    3.27 -
    3.28 -(def *theme* (default-theme))
    3.29 -
    3.30 -(defrecord Location [x y])
    3.31 -(defrecord Size [width height])
    3.32 -(defrecord Bounds [x y width height])
    3.33 -
    3.34 -(defprotocol Layer
    3.35 -  "Basic UI element."
    3.36 -  (render! [this opts])
    3.37 -  (size [this opts]))
    3.38 -
    3.39 -;; TODO: modifiers
    3.40 -(defrecord MouseEvent [id when x y x-on-screen y-on-screen button])
    3.41 -
    3.42 -(defprotocol EventDispatcher
    3.43 -  (listen! [this ^Component component]
    3.44 -     "Listen for events on the specified AWT Component.")
    3.45 -  (create-dispatcher [this handle handlers]
    3.46 -     "Returns new event dispatcher associated with the specified event
    3.47 -      handlers (an event-id -> handler-fn map). Handle is used to
    3.48 -      match the contexts between commits.")
    3.49 -  (commit [this]
    3.50 -     "Apply the registered handlers for event processing."))
    3.51 -
    3.52 -(defprotocol Anchored
    3.53 -  "Provide anchor point for Layers. Used by viewport."
    3.54 -  (anchor [this h-align v-align opts]
    3.55 -     "Anchor point: [x y], h-align could be :left, :center or :right,
    3.56 -      v-align is :top, :center or :bottom"))
    3.57 -
    3.58 -;; Default implementation of Anchored for any Layer.
    3.59 -(extend-protocol Anchored
    3.60 -  indyvon.core.Layer
    3.61 -  (anchor [this h-align v-align opts]
    3.62 -          (if (and (= h-align :left)
    3.63 -                   (= v-align :top))
    3.64 -            (Location. 0 0)
    3.65 -            (let [size (size this opts)]
    3.66 -              (Location.
    3.67 -               (case h-align
    3.68 -                     :top 0
    3.69 -                     :center (/ (:width size) 2)
    3.70 -                     :right (:width size))
    3.71 -               (case v-align
    3.72 -                     :left 0
    3.73 -                     :center (/ (:height size) 2)
    3.74 -                     :bottom (:height size)))))))
    3.75 -
    3.76 -(defn- ^Graphics2D make-graphics [^Graphics2D graphics x y w h]
    3.77 -  (.create graphics x y w h))
    3.78 -
    3.79 -(defn- ^Graphics2D apply-theme [^Graphics2D graphics theme]
    3.80 -  (doto graphics
    3.81 -    (.setColor (:fore-color theme))
    3.82 -    (.setFont (:font theme))))
    3.83 -
    3.84 -(defn intersect [b1 b2]
    3.85 -  (let [x11 (:x b1)
    3.86 -        y11 (:y b1)
    3.87 -        x12 (+ x11 (:width b1))
    3.88 -        y12 (+ y11 (:height b1))
    3.89 -        x21 (:x b2)
    3.90 -        y21 (:y b2)
    3.91 -        x22 (+ x21 (:width b2))
    3.92 -        y22 (+ y21 (:height b2))
    3.93 -        x1 (max x11 x21)
    3.94 -        y1 (max y11 y21)
    3.95 -        x2 (min x12 x22)
    3.96 -        y2 (min y12 y22)]
    3.97 -    (Bounds. x1 y1 (- x2 x1) (- y2 y1))))
    3.98 -
    3.99 -(defn with-translate* [x y w h f & args]
   3.100 -  (let [graphics (apply-theme (.create *graphics* x y w h) *theme*)
   3.101 -        bounds (Bounds. (+ x (:x *bounds*))
   3.102 -                        (+ y (:y *bounds*))
   3.103 -                        w h)]
   3.104 -    (try
   3.105 -      (apply with-bindings* {#'*bounds* bounds
   3.106 -                             #'*clip* (intersect bounds *clip*)
   3.107 -                             #'*graphics* graphics}
   3.108 -             f args)
   3.109 -      (finally
   3.110 -       (.dispose graphics)))))
   3.111 -
   3.112 -(defmacro with-translate [x y w h & body]
   3.113 -  `(with-translate* ~x ~y ~w ~h (fn [] ~@body)))
   3.114 -
   3.115 -
   3.116 -
   3.117 -(defn with-handlers* [handle handlers f & args]
   3.118 -  (apply with-bindings*
   3.119 -         {#'*event-dispatcher*
   3.120 -          (create-dispatcher *event-dispatcher* handle handlers)}
   3.121 -         f args))
   3.122 -
   3.123 -(defmacro with-handlers
   3.124 -  "specs => (:event-id name & handler-body)*
   3.125 -
   3.126 -  Execute form with the specified event handlers."
   3.127 -  [handle form & specs]
   3.128 -  `(with-handlers* ~handle
   3.129 -     ~(reduce (fn [m spec]
   3.130 -                (assoc m (first spec)
   3.131 -                       `(fn [~(second spec)]
   3.132 -                          ~@(nnext spec)))) {}
   3.133 -                          specs)
   3.134 -     (fn [] ~form)))
   3.135 -
   3.136 -(defn- geometry-vec [geometry]
   3.137 -  (if (vector? geometry)
   3.138 -    geometry
   3.139 -    [(:x geometry) (:y geometry) (:width geometry) (:height geometry)]))
   3.140 -
   3.141 -(defn draw!
   3.142 -  "Draw a layer. Geometry is either a map or vector [x y] or
   3.143 -   [x y width height]."
   3.144 -  [layer geometry & args]
   3.145 -  (let [[x y w h] (geometry-vec geometry)
   3.146 -        size (if-not (and w h) (size layer args))
   3.147 -        w (or w (:width size))
   3.148 -        h (or h (:height size))]
   3.149 -    (with-translate* x y w h render! layer args)))
   3.150 -
   3.151 -;;
   3.152 -;; EventDispatcher implementation
   3.153 -;;
   3.154 -
   3.155 -(def awt-events
   3.156 -     {java.awt.event.MouseEvent/MOUSE_CLICKED  :mouse-clicked
   3.157 -      java.awt.event.MouseEvent/MOUSE_DRAGGED  :mouse-dragged
   3.158 -      java.awt.event.MouseEvent/MOUSE_ENTERED  :mouse-entered
   3.159 -      java.awt.event.MouseEvent/MOUSE_EXITED   :mouse-exited
   3.160 -      java.awt.event.MouseEvent/MOUSE_MOVED    :mouse-moved
   3.161 -      java.awt.event.MouseEvent/MOUSE_PRESSED  :mouse-pressed
   3.162 -      java.awt.event.MouseEvent/MOUSE_RELEASED :mouse-released})
   3.163 -
   3.164 -(defrecord DispatcherNode [handle handlers parent bounds bindings]
   3.165 -  EventDispatcher
   3.166 -  (listen! [this component]
   3.167 -     (listen! parent component))
   3.168 -  (create-dispatcher [this handle handlers]
   3.169 -     (create-dispatcher parent handle handlers))
   3.170 -  (commit [this]
   3.171 -     (commit parent)))
   3.172 -
   3.173 -(defn- make-node [handle handlers]
   3.174 -  (DispatcherNode. handle handlers *event-dispatcher* *clip*
   3.175 -                   (get-thread-bindings)))
   3.176 -
   3.177 -(defn- assoc-cons [m key val]
   3.178 -  (assoc m key (cons val (get m key))))
   3.179 -
   3.180 -(defn- add-node [tree node]
   3.181 -  (assoc-cons tree (:parent node) node))
   3.182 -
   3.183 -(defn- inside?
   3.184 -  ([x y bounds]
   3.185 -     (inside? x y (:x bounds) (:y bounds)
   3.186 -              (:width bounds) (:height bounds)))
   3.187 -  ([px py x y w h]
   3.188 -     (and (>= px x)
   3.189 -          (>= py y)
   3.190 -          (< px (+ x w))
   3.191 -          (< py (+ y h)))))
   3.192 -
   3.193 -(defn- under-cursor
   3.194 -  "Returns a sequence of child nodes under cursor."
   3.195 -  [x y tree node]
   3.196 -  (some #(if (inside? x y (:bounds %))
   3.197 -           (conj (under-cursor x y tree %) %))
   3.198 -        (get tree node)))
   3.199 -
   3.200 -(defn- remove-all [coll1 coll2 pred]
   3.201 -  (filter #(not (some (partial pred %) coll2)) coll1))
   3.202 -
   3.203 -(defn- translate-mouse-event [^java.awt.event.MouseEvent event x y id]
   3.204 -  (MouseEvent. id (.getWhen event)
   3.205 -               (- (.getX event) x) (- (.getY event) y)
   3.206 -               (.getXOnScreen event) (.getYOnScreen event)
   3.207 -               (.getButton event)))
   3.208 -
   3.209 -(defn- translate-and-dispatch
   3.210 -  ([nodes ^java.awt.event.MouseEvent event]
   3.211 -     (translate-and-dispatch nodes event (awt-events (.getID event))))
   3.212 -  ([nodes event id]
   3.213 -     (doseq [node nodes]
   3.214 -       (when-let [handler (get (:handlers node) id)]
   3.215 -         (with-bindings* (:bindings node)
   3.216 -           handler
   3.217 -           (translate-mouse-event event
   3.218 -             (-> node :bounds :x) (-> node :bounds :y) id))))
   3.219 -     id))
   3.220 -
   3.221 -(defn- dispatch-mouse-motion*
   3.222 -  "Dispatches mouse motion events. Returns a new set of nodes which
   3.223 -  currently are under cursor."
   3.224 -  [hovered tree root ^java.awt.event.MouseEvent event]
   3.225 -  (let [x (.getX event)
   3.226 -        y (.getY event)
   3.227 -        hovered2 (under-cursor x y tree root)
   3.228 -        pred #(= (:handle %1) (:handle %2))
   3.229 -        exited (remove-all hovered hovered2 pred)
   3.230 -        entered (remove-all hovered2 hovered pred)
   3.231 -        moved (remove-all hovered2 entered pred)]
   3.232 -    (translate-and-dispatch exited event :mouse-exited)
   3.233 -    (translate-and-dispatch entered event :mouse-entered)
   3.234 -    (translate-and-dispatch moved event :mouse-moved)
   3.235 -    hovered2))
   3.236 -
   3.237 -(defn- dispatch-mouse-motion
   3.238 -  [hovered-ref tree root event]
   3.239 -  (dosync
   3.240 -   (alter hovered-ref dispatch-mouse-motion* tree root event)))
   3.241 -
   3.242 -(defn- dispatch-mouse-button*
   3.243 -  "Dispatches mouse button events. Returns a new set of nodes which
   3.244 -  currently are picked with a pressed button."
   3.245 -  [picked hovered event]
   3.246 -  (if (= (translate-and-dispatch hovered event) :mouse-pressed)
   3.247 -    hovered
   3.248 -    nil))
   3.249 -
   3.250 -(defn- dispatch-mouse-button
   3.251 -  [picked-ref hovered-ref event]
   3.252 -  (dosync
   3.253 -   (alter picked-ref dispatch-mouse-button* @hovered-ref event)))
   3.254 -
   3.255 -(defn root-event-dispatcher []
   3.256 -  (let [tree-r (ref {})   ; register
   3.257 -        tree (ref {})     ; dispatch
   3.258 -        hovered (ref '())
   3.259 -        picked (ref '())]
   3.260 -    (reify
   3.261 -     EventDispatcher
   3.262 -     (listen! [this component]
   3.263 -        (doto component
   3.264 -          (.addMouseListener this)
   3.265 -          (.addMouseMotionListener this)))
   3.266 -     (create-dispatcher [this handle handlers]
   3.267 -        (let [node (make-node handle handlers)]
   3.268 -          (dosync (alter tree-r add-node node))
   3.269 -          node))
   3.270 -     (commit [this]
   3.271 -        (dosync (ref-set tree @tree-r)
   3.272 -                (ref-set tree-r {})))
   3.273 -     MouseListener
   3.274 -     (mouseEntered [this event]
   3.275 -        (dispatch-mouse-motion hovered @tree this event))
   3.276 -     (mouseExited [this event]
   3.277 -        (dispatch-mouse-motion hovered @tree this event))
   3.278 -     (mouseClicked [this event]
   3.279 -        (dispatch-mouse-button picked hovered event))
   3.280 -     (mousePressed [this event]
   3.281 -        (dispatch-mouse-button picked hovered event))
   3.282 -     (mouseReleased [this event]
   3.283 -        (dispatch-mouse-button picked hovered event))
   3.284 -     MouseMotionListener
   3.285 -     (mouseDragged [this event]
   3.286 -        (translate-and-dispatch @picked event))
   3.287 -     (mouseMoved [this event]
   3.288 -        (dispatch-mouse-motion hovered @tree this event)))))
   3.289 -
   3.290 -;;
   3.291 -;; ИДЕИ:
   3.292 -;;
   3.293 -;; Контекст: биндинги или запись?
   3.294 -;;
   3.295 -;; Установка обработчиков (в контексте слоя):
   3.296 -;;
   3.297 -;; (listen
   3.298 -;;   (:mouse-entered e
   3.299 -;;     ...)
   3.300 -;;   (:mouse-exited e
   3.301 -;;     ...))
   3.302 -;;
   3.303 -;; Не надо IMGUI.
   3.304 -;; Построение сцены путем декорирования слоев:
   3.305 -;;
   3.306 -;; (listener
   3.307 -;;  (:action e (println e))
   3.308 -;;  (:mouse-dragged e (println e))
   3.309 -;;  (theme :font "Helvetica-14"
   3.310 -;;    (vbox
   3.311 -;;      (button (text-layer "Button 1"))
   3.312 -;;      (button (text-layer "Button 2")))))
   3.313 -;;
     4.1 --- a/src/indyvon/demo.clj	Thu Jul 08 06:02:12 2010 +0400
     4.2 +++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
     4.3 @@ -1,89 +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.demo
    4.11 -  (:gen-class)
    4.12 -  (:use indyvon.core
    4.13 -        indyvon.layers
    4.14 -        indyvon.component)
    4.15 -  (:import (indyvon.core Size Bounds)
    4.16 -           (java.awt Graphics2D Component Dimension Color)
    4.17 -           (javax.swing JFrame JPanel)))
    4.18 -
    4.19 -(def frame (JFrame. "Test"))
    4.20 -
    4.21 -(def layer1
    4.22 -     (reify
    4.23 -      Layer
    4.24 -      (render! [layer opts]
    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 -      (size [layer opts] (Size. 30 20))))
    4.33 -
    4.34 -(def layer1b (border-layer layer1 2 3))
    4.35 -
    4.36 -(def layer2
    4.37 -     (reify
    4.38 -      Layer
    4.39 -      (render! [layer opts]
    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 -      (size [layer opts] (Size. 70 65))))
    4.46 -
    4.47 -(def layer3
    4.48 -     (border-layer (text-layer "Sample\ntext" :right :center)))
    4.49 -
    4.50 -(defn fps-layer [fps]
    4.51 -  (border-layer (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 opts]
    4.61 -           (render! @fl nil)
    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 -        (size [layer opts] (size @fl nil)))))
    4.71 -
    4.72 -(def layer
    4.73 -     (reify
    4.74 -      Layer
    4.75 -      (render! [layer opts]
    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 -         (render! fps nil))
    4.83 -      (size [layer opts] (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)))
     5.1 --- a/src/indyvon/layers.clj	Thu Jul 08 06:02:12 2010 +0400
     5.2 +++ /dev/null	Thu Jan 01 00:00:00 1970 +0000
     5.3 @@ -1,129 +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 indyvon.layers
    5.11 -  (:use indyvon.core)
    5.12 -  (:import (indyvon.core Size Location)
    5.13 -           (java.awt Font Cursor)
    5.14 -           (java.awt.font FontRenderContext TextLayout)))
    5.15 -
    5.16 -;; Define as macro to avoid unnecessary calculation of inner and outer
    5.17 -;; sizes in the first case.
    5.18 -(defmacro align-xy [inner outer align first center last]
    5.19 -  `(case ~align
    5.20 -         ~first 0
    5.21 -         ~center (/ (- ~outer ~inner) 2)
    5.22 -         ~last (- ~outer ~inner)))
    5.23 -
    5.24 -(defmacro align-x [inner outer align]
    5.25 -  `(align-xy ~inner ~outer ~align :left :center :right))
    5.26 -
    5.27 -(defmacro align-y [inner outer align]
    5.28 -  `(align-xy ~inner ~outer ~align :top :center :bottom))
    5.29 -
    5.30 -(defn border-layer
    5.31 -  "Decorate layer with a border."
    5.32 -  ([content]
    5.33 -     (border-layer content 1))
    5.34 -  ([content width]
    5.35 -     (border-layer content width 0))
    5.36 -  ([content width gap]
    5.37 -     (let [offset (+ width gap)]
    5.38 -       (reify Layer
    5.39 -        (render! [l opts]
    5.40 -           (let [w (:width *bounds*)
    5.41 -                 h (:height *bounds*)]
    5.42 -             (.setColor *graphics* (:border-color *theme*))
    5.43 -             (doseq [i (range 0 width)]
    5.44 -               (.drawRect *graphics* i i (- w 1 i i) (- h 1 i i)))
    5.45 -             (apply draw! content
    5.46 -                    [offset offset (- w offset offset) (- h offset offset)]
    5.47 -                    opts)))
    5.48 -        (size [l opts]
    5.49 -           (let [s (size content opts)]
    5.50 -             (Size. (+ (:width s) offset offset)
    5.51 -                    (+ (:height s) offset offset))))))))
    5.52 -
    5.53 -(defn- re-split [^java.util.regex.Pattern re s]
    5.54 -  (seq (.split re s)))
    5.55 -
    5.56 -(defn- layout-text [lines ^Font font ^FontRenderContext font-context]
    5.57 -  (map #(TextLayout. ^String % font font-context) lines))
    5.58 -
    5.59 -(defn- text-width [layouts]
    5.60 -  (reduce (fn [w ^TextLayout tl] (max w (.getAdvance tl))) 0 layouts))
    5.61 -
    5.62 -(defn- text-height [layouts]
    5.63 -  (reduce (fn [w ^TextLayout tl] (+ w (.getAscent tl)
    5.64 -                                   (.getDescent tl)
    5.65 -                                   (.getLeading tl)))
    5.66 -          0 layouts))
    5.67 -
    5.68 -(defn text-layer
    5.69 -  "Creates a layer to display multiline text."
    5.70 -  ([text]
    5.71 -     (text-layer text :left :top))
    5.72 -  ([text h-align v-align]
    5.73 -     (let [lines (re-split #"\r\n|\n|\r|\u0085|\u2028|\u2029" text)]
    5.74 -       (reify Layer
    5.75 -        (render! [layer opts]
    5.76 -           (let [w (:width *bounds*)
    5.77 -                 h (:height *bounds*)
    5.78 -                 font (.getFont *graphics*)
    5.79 -                 layouts (layout-text lines font *font-context*)
    5.80 -                 y (align-y (text-height layouts) h v-align)]
    5.81 -             (loop [layouts layouts, y y]
    5.82 -               (when-first [^TextLayout layout layouts]
    5.83 -                 (let [ascent (.getAscent layout)
    5.84 -                       lh (+ ascent (.getDescent layout) (.getLeading layout))
    5.85 -                       x (align-x (.getAdvance layout) w h-align)]
    5.86 -                   (.draw layout *graphics* x (+ y ascent))
    5.87 -                   (recur (next layouts) (+ y lh)))))))
    5.88 -        (size [layer opts]
    5.89 -           (let [layouts (layout-text lines (:font *theme*) *font-context*)
    5.90 -                 width (text-width layouts)
    5.91 -                 height (text-height layouts)]
    5.92 -             (Size. width height)))))))
    5.93 -
    5.94 -(defn viewport
    5.95 -  "Creates scrollable viewport layer."
    5.96 -  ([content] (viewport content :left :top))
    5.97 -  ([content h-align v-align]
    5.98 -  (let [x (ref 0)
    5.99 -        y (ref 0)
   5.100 -        fix-x (ref 0)
   5.101 -        fix-y (ref 0)
   5.102 -        last-width (ref 0)
   5.103 -        last-height (ref 0)]
   5.104 -    (reify
   5.105 -     Layer
   5.106 -     (render! [layer opts]
   5.107 -        (with-handlers layer
   5.108 -         (let [anchor (anchor content h-align v-align opts)
   5.109 -               width (:width *bounds*)
   5.110 -               height (:height *bounds*)]
   5.111 -           (dosync
   5.112 -            (alter x + (align-x width @last-width h-align))
   5.113 -            (alter y + (align-y height @last-height v-align))
   5.114 -            (ref-set last-width width)
   5.115 -            (ref-set last-height height))
   5.116 -           (apply draw! content
   5.117 -                  [(- 0 @x (:x anchor)) (- 0 @y (:y anchor))] opts))
   5.118 -         (:mouse-pressed e
   5.119 -          (dosync
   5.120 -           (ref-set fix-x (:x-on-screen e))
   5.121 -           (ref-set fix-y (:y-on-screen e)))
   5.122 -          (->> Cursor/MOVE_CURSOR Cursor. (.setCursor *target*)))
   5.123 -         (:mouse-released e
   5.124 -          (->> Cursor/DEFAULT_CURSOR Cursor. (.setCursor *target*)))
   5.125 -         (:mouse-dragged e
   5.126 -          (dosync
   5.127 -           (alter x + (- @fix-x (:x-on-screen e)))
   5.128 -           (alter y + (- @fix-y (:y-on-screen e)))
   5.129 -           (ref-set fix-x (:x-on-screen e))
   5.130 -           (ref-set fix-y (:y-on-screen e)))
   5.131 -          (*update*))))
   5.132 -     (size [layer opts] (size content opts))))))
     6.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
     6.2 +++ b/src/kryshen/indyvon/component.clj	Thu Jul 08 07:03:24 2010 +0400
     6.3 @@ -0,0 +1,52 @@
     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.component
    6.11 +  (:use kryshen.indyvon.core
    6.12 +        kryshen.indyvon.layers)
    6.13 +  (:import (kryshen.indyvon.core Size Bounds)
    6.14 +           (java.awt Graphics2D Component Dimension Color)
    6.15 +           (javax.swing JFrame JPanel)))
    6.16 +
    6.17 +(defn- font-context [^Component component]
    6.18 +  (.getFontRenderContext (.getFontMetrics component (.getFont component))))
    6.19 +
    6.20 +(defn paint-component
    6.21 +  [^Component component layer ^Graphics2D graphics event-dispatcher]
    6.22 +  (let [size (.getSize component)
    6.23 +        width (.width size)
    6.24 +        height (.height size)]
    6.25 +    (.clearRect graphics 0 0 width height)
    6.26 +    (let [bounds (Bounds. 0 0 width height)]
    6.27 +      (binding [*graphics* graphics
    6.28 +                *font-context* (.getFontRenderContext graphics)
    6.29 +                *target* component
    6.30 +                *event-dispatcher* event-dispatcher
    6.31 +                *update* #(.repaint component)
    6.32 +                *bounds* bounds
    6.33 +                *clip* bounds]
    6.34 +        (render! layer nil)
    6.35 +        (commit event-dispatcher)))))
    6.36 +
    6.37 +(defn preferred-size [component layer]
    6.38 +  (binding [*target* component
    6.39 +            *font-context*' (font-context component)]
    6.40 +    (let [s (size layer nil)]
    6.41 +      (Dimension. (:width s) (:height s)))))
    6.42 +
    6.43 +(defn make-jpanel
    6.44 +  ([layer]
    6.45 +     (make-jpanel layer (root-event-dispatcher)))
    6.46 +  ([layer event-dispatcher]
    6.47 +     (let [panel
    6.48 +           (proxy [JPanel] []
    6.49 +             (paintComponent [g]
    6.50 +                (paint-component this layer g event-dispatcher))
    6.51 +             (getPreferredSize []
    6.52 +                (preferred-size this layer)))]
    6.53 +       (.setBackground panel (:back-color *theme*))
    6.54 +       (listen! event-dispatcher panel)
    6.55 +       panel)))
     7.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
     7.2 +++ b/src/kryshen/indyvon/core.clj	Thu Jul 08 07:03:24 2010 +0400
     7.3 @@ -0,0 +1,310 @@
     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 kryshen.indyvon.core
    7.11 +  (:import (java.awt Graphics2D Component Color Font)
    7.12 +           (java.awt.event MouseListener MouseMotionListener)
    7.13 +           (java.awt.font FontRenderContext)))
    7.14 +
    7.15 +(def ^Graphics2D *graphics*)
    7.16 +(def ^FontRenderContext *font-context*)
    7.17 +(def ^Component *target*)
    7.18 +(def *bounds*)
    7.19 +(def *clip*)
    7.20 +(def *update*)
    7.21 +(def *event-dispatcher*)
    7.22 +
    7.23 +(defrecord Theme [fore-color back-color border-color font])
    7.24 +
    7.25 +(defn default-theme []
    7.26 +  (Theme. Color/BLACK Color/WHITE Color/BLUE (Font. "Sans" Font/PLAIN 12)))
    7.27 +
    7.28 +(def *theme* (default-theme))
    7.29 +
    7.30 +(defrecord Location [x y])
    7.31 +(defrecord Size [width height])
    7.32 +(defrecord Bounds [x y width height])
    7.33 +
    7.34 +(defprotocol Layer
    7.35 +  "Basic UI element."
    7.36 +  (render! [this opts])
    7.37 +  (size [this opts]))
    7.38 +
    7.39 +;; TODO: modifiers
    7.40 +(defrecord MouseEvent [id when x y x-on-screen y-on-screen button])
    7.41 +
    7.42 +(defprotocol EventDispatcher
    7.43 +  (listen! [this ^Component component]
    7.44 +     "Listen for events on the specified AWT Component.")
    7.45 +  (create-dispatcher [this handle handlers]
    7.46 +     "Returns new event dispatcher associated with the specified event
    7.47 +      handlers (an event-id -> handler-fn map). Handle is used to
    7.48 +      match the contexts between commits.")
    7.49 +  (commit [this]
    7.50 +     "Apply the registered handlers for event processing."))
    7.51 +
    7.52 +(defprotocol Anchored
    7.53 +  "Provide anchor point for Layers. Used by viewport."
    7.54 +  (anchor [this h-align v-align opts]
    7.55 +     "Anchor point: [x y], h-align could be :left, :center or :right,
    7.56 +      v-align is :top, :center or :bottom"))
    7.57 +
    7.58 +;; Default implementation of Anchored for any Layer.
    7.59 +(extend-protocol Anchored
    7.60 +  kryshen.indyvon.core.Layer
    7.61 +  (anchor [this h-align v-align opts]
    7.62 +          (if (and (= h-align :left)
    7.63 +                   (= v-align :top))
    7.64 +            (Location. 0 0)
    7.65 +            (let [size (size this opts)]
    7.66 +              (Location.
    7.67 +               (case h-align
    7.68 +                     :top 0
    7.69 +                     :center (/ (:width size) 2)
    7.70 +                     :right (:width size))
    7.71 +               (case v-align
    7.72 +                     :left 0
    7.73 +                     :center (/ (:height size) 2)
    7.74 +                     :bottom (:height size)))))))
    7.75 +
    7.76 +(defn- ^Graphics2D make-graphics [^Graphics2D graphics x y w h]
    7.77 +  (.create graphics x y w h))
    7.78 +
    7.79 +(defn- ^Graphics2D apply-theme [^Graphics2D graphics theme]
    7.80 +  (doto graphics
    7.81 +    (.setColor (:fore-color theme))
    7.82 +    (.setFont (:font theme))))
    7.83 +
    7.84 +(defn intersect [b1 b2]
    7.85 +  (let [x11 (:x b1)
    7.86 +        y11 (:y b1)
    7.87 +        x12 (+ x11 (:width b1))
    7.88 +        y12 (+ y11 (:height b1))
    7.89 +        x21 (:x b2)
    7.90 +        y21 (:y b2)
    7.91 +        x22 (+ x21 (:width b2))
    7.92 +        y22 (+ y21 (:height b2))
    7.93 +        x1 (max x11 x21)
    7.94 +        y1 (max y11 y21)
    7.95 +        x2 (min x12 x22)
    7.96 +        y2 (min y12 y22)]
    7.97 +    (Bounds. x1 y1 (- x2 x1) (- y2 y1))))
    7.98 +
    7.99 +(defn with-translate* [x y w h f & args]
   7.100 +  (let [graphics (apply-theme (.create *graphics* x y w h) *theme*)
   7.101 +        bounds (Bounds. (+ x (:x *bounds*))
   7.102 +                        (+ y (:y *bounds*))
   7.103 +                        w h)]
   7.104 +    (try
   7.105 +      (apply with-bindings* {#'*bounds* bounds
   7.106 +                             #'*clip* (intersect bounds *clip*)
   7.107 +                             #'*graphics* graphics}
   7.108 +             f args)
   7.109 +      (finally
   7.110 +       (.dispose graphics)))))
   7.111 +
   7.112 +(defmacro with-translate [x y w h & body]
   7.113 +  `(with-translate* ~x ~y ~w ~h (fn [] ~@body)))
   7.114 +
   7.115 +
   7.116 +
   7.117 +(defn with-handlers* [handle handlers f & args]
   7.118 +  (apply with-bindings*
   7.119 +         {#'*event-dispatcher*
   7.120 +          (create-dispatcher *event-dispatcher* handle handlers)}
   7.121 +         f args))
   7.122 +
   7.123 +(defmacro with-handlers
   7.124 +  "specs => (:event-id name & handler-body)*
   7.125 +
   7.126 +  Execute form with the specified event handlers."
   7.127 +  [handle form & specs]
   7.128 +  `(with-handlers* ~handle
   7.129 +     ~(reduce (fn [m spec]
   7.130 +                (assoc m (first spec)
   7.131 +                       `(fn [~(second spec)]
   7.132 +                          ~@(nnext spec)))) {}
   7.133 +                          specs)
   7.134 +     (fn [] ~form)))
   7.135 +
   7.136 +(defn- geometry-vec [geometry]
   7.137 +  (if (vector? geometry)
   7.138 +    geometry
   7.139 +    [(:x geometry) (:y geometry) (:width geometry) (:height geometry)]))
   7.140 +
   7.141 +(defn draw!
   7.142 +  "Draw a layer. Geometry is either a map or vector [x y] or
   7.143 +   [x y width height]."
   7.144 +  [layer geometry & args]
   7.145 +  (let [[x y w h] (geometry-vec geometry)
   7.146 +        size (if-not (and w h) (size layer args))
   7.147 +        w (or w (:width size))
   7.148 +        h (or h (:height size))]
   7.149 +    (with-translate* x y w h render! layer args)))
   7.150 +
   7.151 +;;
   7.152 +;; EventDispatcher implementation
   7.153 +;;
   7.154 +
   7.155 +(def awt-events
   7.156 +     {java.awt.event.MouseEvent/MOUSE_CLICKED  :mouse-clicked
   7.157 +      java.awt.event.MouseEvent/MOUSE_DRAGGED  :mouse-dragged
   7.158 +      java.awt.event.MouseEvent/MOUSE_ENTERED  :mouse-entered
   7.159 +      java.awt.event.MouseEvent/MOUSE_EXITED   :mouse-exited
   7.160 +      java.awt.event.MouseEvent/MOUSE_MOVED    :mouse-moved
   7.161 +      java.awt.event.MouseEvent/MOUSE_PRESSED  :mouse-pressed
   7.162 +      java.awt.event.MouseEvent/MOUSE_RELEASED :mouse-released})
   7.163 +
   7.164 +(defrecord DispatcherNode [handle handlers parent bounds bindings]
   7.165 +  EventDispatcher
   7.166 +  (listen! [this component]
   7.167 +     (listen! parent component))
   7.168 +  (create-dispatcher [this handle handlers]
   7.169 +     (create-dispatcher parent handle handlers))
   7.170 +  (commit [this]
   7.171 +     (commit parent)))
   7.172 +
   7.173 +(defn- make-node [handle handlers]
   7.174 +  (DispatcherNode. handle handlers *event-dispatcher* *clip*
   7.175 +                   (get-thread-bindings)))
   7.176 +
   7.177 +(defn- assoc-cons [m key val]
   7.178 +  (assoc m key (cons val (get m key))))
   7.179 +
   7.180 +(defn- add-node [tree node]
   7.181 +  (assoc-cons tree (:parent node) node))
   7.182 +
   7.183 +(defn- inside?
   7.184 +  ([x y bounds]
   7.185 +     (inside? x y (:x bounds) (:y bounds)
   7.186 +              (:width bounds) (:height bounds)))
   7.187 +  ([px py x y w h]
   7.188 +     (and (>= px x)
   7.189 +          (>= py y)
   7.190 +          (< px (+ x w))
   7.191 +          (< py (+ y h)))))
   7.192 +
   7.193 +(defn- under-cursor
   7.194 +  "Returns a sequence of child nodes under cursor."
   7.195 +  [x y tree node]
   7.196 +  (some #(if (inside? x y (:bounds %))
   7.197 +           (conj (under-cursor x y tree %) %))
   7.198 +        (get tree node)))
   7.199 +
   7.200 +(defn- remove-all [coll1 coll2 pred]
   7.201 +  (filter #(not (some (partial pred %) coll2)) coll1))
   7.202 +
   7.203 +(defn- translate-mouse-event [^java.awt.event.MouseEvent event x y id]
   7.204 +  (MouseEvent. id (.getWhen event)
   7.205 +               (- (.getX event) x) (- (.getY event) y)
   7.206 +               (.getXOnScreen event) (.getYOnScreen event)
   7.207 +               (.getButton event)))
   7.208 +
   7.209 +(defn- translate-and-dispatch
   7.210 +  ([nodes ^java.awt.event.MouseEvent event]
   7.211 +     (translate-and-dispatch nodes event (awt-events (.getID event))))
   7.212 +  ([nodes event id]
   7.213 +     (doseq [node nodes]
   7.214 +       (when-let [handler (get (:handlers node) id)]
   7.215 +         (with-bindings* (:bindings node)
   7.216 +           handler
   7.217 +           (translate-mouse-event event
   7.218 +             (-> node :bounds :x) (-> node :bounds :y) id))))
   7.219 +     id))
   7.220 +
   7.221 +(defn- dispatch-mouse-motion*
   7.222 +  "Dispatches mouse motion events. Returns a new set of nodes which
   7.223 +  currently are under cursor."
   7.224 +  [hovered tree root ^java.awt.event.MouseEvent event]
   7.225 +  (let [x (.getX event)
   7.226 +        y (.getY event)
   7.227 +        hovered2 (under-cursor x y tree root)
   7.228 +        pred #(= (:handle %1) (:handle %2))
   7.229 +        exited (remove-all hovered hovered2 pred)
   7.230 +        entered (remove-all hovered2 hovered pred)
   7.231 +        moved (remove-all hovered2 entered pred)]
   7.232 +    (translate-and-dispatch exited event :mouse-exited)
   7.233 +    (translate-and-dispatch entered event :mouse-entered)
   7.234 +    (translate-and-dispatch moved event :mouse-moved)
   7.235 +    hovered2))
   7.236 +
   7.237 +(defn- dispatch-mouse-motion
   7.238 +  [hovered-ref tree root event]
   7.239 +  (dosync
   7.240 +   (alter hovered-ref dispatch-mouse-motion* tree root event)))
   7.241 +
   7.242 +(defn- dispatch-mouse-button*
   7.243 +  "Dispatches mouse button events. Returns a new set of nodes which
   7.244 +  currently are picked with a pressed button."
   7.245 +  [picked hovered event]
   7.246 +  (if (= (translate-and-dispatch hovered event) :mouse-pressed)
   7.247 +    hovered
   7.248 +    nil))
   7.249 +
   7.250 +(defn- dispatch-mouse-button
   7.251 +  [picked-ref hovered-ref event]
   7.252 +  (dosync
   7.253 +   (alter picked-ref dispatch-mouse-button* @hovered-ref event)))
   7.254 +
   7.255 +(defn root-event-dispatcher []
   7.256 +  (let [tree-r (ref {})   ; register
   7.257 +        tree (ref {})     ; dispatch
   7.258 +        hovered (ref '())
   7.259 +        picked (ref '())]
   7.260 +    (reify
   7.261 +     EventDispatcher
   7.262 +     (listen! [this component]
   7.263 +        (doto component
   7.264 +          (.addMouseListener this)
   7.265 +          (.addMouseMotionListener this)))
   7.266 +     (create-dispatcher [this handle handlers]
   7.267 +        (let [node (make-node handle handlers)]
   7.268 +          (dosync (alter tree-r add-node node))
   7.269 +          node))
   7.270 +     (commit [this]
   7.271 +        (dosync (ref-set tree @tree-r)
   7.272 +                (ref-set tree-r {})))
   7.273 +     MouseListener
   7.274 +     (mouseEntered [this event]
   7.275 +        (dispatch-mouse-motion hovered @tree this event))
   7.276 +     (mouseExited [this event]
   7.277 +        (dispatch-mouse-motion hovered @tree this event))
   7.278 +     (mouseClicked [this event]
   7.279 +        (dispatch-mouse-button picked hovered event))
   7.280 +     (mousePressed [this event]
   7.281 +        (dispatch-mouse-button picked hovered event))
   7.282 +     (mouseReleased [this event]
   7.283 +        (dispatch-mouse-button picked hovered event))
   7.284 +     MouseMotionListener
   7.285 +     (mouseDragged [this event]
   7.286 +        (translate-and-dispatch @picked event))
   7.287 +     (mouseMoved [this event]
   7.288 +        (dispatch-mouse-motion hovered @tree this event)))))
   7.289 +
   7.290 +;;
   7.291 +;; ИДЕИ:
   7.292 +;;
   7.293 +;; Контекст: биндинги или запись?
   7.294 +;;
   7.295 +;; Установка обработчиков (в контексте слоя):
   7.296 +;;
   7.297 +;; (listen
   7.298 +;;   (:mouse-entered e
   7.299 +;;     ...)
   7.300 +;;   (:mouse-exited e
   7.301 +;;     ...))
   7.302 +;;
   7.303 +;; Не надо IMGUI.
   7.304 +;; Построение сцены путем декорирования слоев:
   7.305 +;;
   7.306 +;; (listener
   7.307 +;;  (:action e (println e))
   7.308 +;;  (:mouse-dragged e (println e))
   7.309 +;;  (theme :font "Helvetica-14"
   7.310 +;;    (vbox
   7.311 +;;      (button (text-layer "Button 1"))
   7.312 +;;      (button (text-layer "Button 2")))))
   7.313 +;;
     8.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
     8.2 +++ b/src/kryshen/indyvon/demo.clj	Thu Jul 08 07:03:24 2010 +0400
     8.3 @@ -0,0 +1,89 @@
     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 kryshen.indyvon.demo
    8.11 +  (:gen-class)
    8.12 +  (:use kryshen.indyvon.core
    8.13 +        kryshen.indyvon.layers
    8.14 +        kryshen.indyvon.component)
    8.15 +  (:import (kryshen.indyvon.core Size Bounds)
    8.16 +           (java.awt Color)
    8.17 +           (javax.swing JFrame)))
    8.18 +
    8.19 +(def frame (JFrame. "Test"))
    8.20 +
    8.21 +(def layer1
    8.22 +     (reify
    8.23 +      Layer
    8.24 +      (render! [layer opts]
    8.25 +         (with-handlers layer
    8.26 +           (doto *graphics*
    8.27 +             (.setColor Color/RED)
    8.28 +             (.fillRect 0 0 (:width *bounds*) (:height *bounds*)))
    8.29 +           (:mouse-entered e (println e))
    8.30 +           (:mouse-exited e (println e))
    8.31 +           (:mouse-moved e (println e))))
    8.32 +      (size [layer opts] (Size. 30 20))))
    8.33 +
    8.34 +(def layer1b (border-layer layer1 2 3))
    8.35 +
    8.36 +(def layer2
    8.37 +     (reify
    8.38 +      Layer
    8.39 +      (render! [layer opts]
    8.40 +         (doto *graphics*
    8.41 +           (.setColor Color/YELLOW)
    8.42 +           (.fillRect 0 0 (:width *bounds*) (:height *bounds*)))
    8.43 +         (draw! layer1b [10 5])
    8.44 +         (draw! layer1 [55 5]))
    8.45 +      (size [layer opts] (Size. 70 65))))
    8.46 +
    8.47 +(def layer3
    8.48 +     (border-layer (text-layer "Sample\ntext" :right :center)))
    8.49 +
    8.50 +(defn fps-layer [fps]
    8.51 +  (border-layer (text-layer (format "%.1f" fps) :right :bottom) 0 5))
    8.52 +
    8.53 +(def fps
    8.54 +     (let [update-interval 0.1
    8.55 +           frames (ref 0)
    8.56 +           last (ref 0)
    8.57 +           fl (ref (fps-layer 0.0))]
    8.58 +       (reify
    8.59 +        Layer
    8.60 +        (render! [layer opts]
    8.61 +           (render! @fl nil)
    8.62 +           (dosync
    8.63 +            (alter frames + 1)
    8.64 +            (let [time (System/currentTimeMillis)
    8.65 +                  elapsed (/ (- time @last) 1000.0)]
    8.66 +              (when (> elapsed update-interval)
    8.67 +                (ref-set fl (fps-layer (/ @frames elapsed)))
    8.68 +                (ref-set frames 0)
    8.69 +                (ref-set last time)))))
    8.70 +        (size [layer opts] (size @fl nil)))))
    8.71 +
    8.72 +(def layer
    8.73 +     (reify
    8.74 +      Layer
    8.75 +      (render! [layer opts]
    8.76 +         (*update*)
    8.77 +         (doto *graphics*
    8.78 +           (.setColor (rand-nth [Color/BLACK Color/BLUE Color/RED]))
    8.79 +           (.drawLine 0 0 (:width *bounds*) (:height *bounds*)))
    8.80 +         (draw! layer2 [15 20])
    8.81 +         (draw! layer3 [100 100 80 50])
    8.82 +         (render! fps nil))
    8.83 +      (size [layer opts] (Size. 400 300))))
    8.84 +
    8.85 +(defn -main []
    8.86 +  (doto frame
    8.87 +    (.addWindowListener
    8.88 +     (proxy [java.awt.event.WindowAdapter] []
    8.89 +       (windowClosing [event] (.dispose frame))))
    8.90 +    (.. (getContentPane) (add (make-jpanel (viewport layer))))
    8.91 +    (.pack)
    8.92 +    (.setVisible true)))
     9.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
     9.2 +++ b/src/kryshen/indyvon/layers.clj	Thu Jul 08 07:03:24 2010 +0400
     9.3 @@ -0,0 +1,129 @@
     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 kryshen.indyvon.layers
    9.11 +  (:use kryshen.indyvon.core)
    9.12 +  (:import (kryshen.indyvon.core Size Location)
    9.13 +           (java.awt Font Cursor)
    9.14 +           (java.awt.font FontRenderContext TextLayout)))
    9.15 +
    9.16 +;; Define as macro to avoid unnecessary calculation of inner and outer
    9.17 +;; sizes in the first case.
    9.18 +(defmacro align-xy [inner outer align first center last]
    9.19 +  `(case ~align
    9.20 +         ~first 0
    9.21 +         ~center (/ (- ~outer ~inner) 2)
    9.22 +         ~last (- ~outer ~inner)))
    9.23 +
    9.24 +(defmacro align-x [inner outer align]
    9.25 +  `(align-xy ~inner ~outer ~align :left :center :right))
    9.26 +
    9.27 +(defmacro align-y [inner outer align]
    9.28 +  `(align-xy ~inner ~outer ~align :top :center :bottom))
    9.29 +
    9.30 +(defn border-layer
    9.31 +  "Decorate layer with a border."
    9.32 +  ([content]
    9.33 +     (border-layer content 1))
    9.34 +  ([content width]
    9.35 +     (border-layer content width 0))
    9.36 +  ([content width gap]
    9.37 +     (let [offset (+ width gap)]
    9.38 +       (reify Layer
    9.39 +        (render! [l opts]
    9.40 +           (let [w (:width *bounds*)
    9.41 +                 h (:height *bounds*)]
    9.42 +             (.setColor *graphics* (:border-color *theme*))
    9.43 +             (doseq [i (range 0 width)]
    9.44 +               (.drawRect *graphics* i i (- w 1 i i) (- h 1 i i)))
    9.45 +             (apply draw! content
    9.46 +                    [offset offset (- w offset offset) (- h offset offset)]
    9.47 +                    opts)))
    9.48 +        (size [l opts]
    9.49 +           (let [s (size content opts)]
    9.50 +             (Size. (+ (:width s) offset offset)
    9.51 +                    (+ (:height s) offset offset))))))))
    9.52 +
    9.53 +(defn- re-split [^java.util.regex.Pattern re s]
    9.54 +  (seq (.split re s)))
    9.55 +
    9.56 +(defn- layout-text [lines ^Font font ^FontRenderContext font-context]
    9.57 +  (map #(TextLayout. ^String % font font-context) lines))
    9.58 +
    9.59 +(defn- text-width [layouts]
    9.60 +  (reduce (fn [w ^TextLayout tl] (max w (.getAdvance tl))) 0 layouts))
    9.61 +
    9.62 +(defn- text-height [layouts]
    9.63 +  (reduce (fn [w ^TextLayout tl] (+ w (.getAscent tl)
    9.64 +                                   (.getDescent tl)
    9.65 +                                   (.getLeading tl)))
    9.66 +          0 layouts))
    9.67 +
    9.68 +(defn text-layer
    9.69 +  "Creates a layer to display multiline text."
    9.70 +  ([text]
    9.71 +     (text-layer text :left :top))
    9.72 +  ([text h-align v-align]
    9.73 +     (let [lines (re-split #"\r\n|\n|\r|\u0085|\u2028|\u2029" text)]
    9.74 +       (reify Layer
    9.75 +        (render! [layer opts]
    9.76 +           (let [w (:width *bounds*)
    9.77 +                 h (:height *bounds*)
    9.78 +                 font (.getFont *graphics*)
    9.79 +                 layouts (layout-text lines font *font-context*)
    9.80 +                 y (align-y (text-height layouts) h v-align)]
    9.81 +             (loop [layouts layouts, y y]
    9.82 +               (when-first [^TextLayout layout layouts]
    9.83 +                 (let [ascent (.getAscent layout)
    9.84 +                       lh (+ ascent (.getDescent layout) (.getLeading layout))
    9.85 +                       x (align-x (.getAdvance layout) w h-align)]
    9.86 +                   (.draw layout *graphics* x (+ y ascent))
    9.87 +                   (recur (next layouts) (+ y lh)))))))
    9.88 +        (size [layer opts]
    9.89 +           (let [layouts (layout-text lines (:font *theme*) *font-context*)
    9.90 +                 width (text-width layouts)
    9.91 +                 height (text-height layouts)]
    9.92 +             (Size. width height)))))))
    9.93 +
    9.94 +(defn viewport
    9.95 +  "Creates scrollable viewport layer."
    9.96 +  ([content] (viewport content :left :top))
    9.97 +  ([content h-align v-align]
    9.98 +  (let [x (ref 0)
    9.99 +        y (ref 0)
   9.100 +        fix-x (ref 0)
   9.101 +        fix-y (ref 0)
   9.102 +        last-width (ref 0)
   9.103 +        last-height (ref 0)]
   9.104 +    (reify
   9.105 +     Layer
   9.106 +     (render! [layer opts]
   9.107 +        (with-handlers layer
   9.108 +         (let [anchor (anchor content h-align v-align opts)
   9.109 +               width (:width *bounds*)
   9.110 +               height (:height *bounds*)]
   9.111 +           (dosync
   9.112 +            (alter x + (align-x width @last-width h-align))
   9.113 +            (alter y + (align-y height @last-height v-align))
   9.114 +            (ref-set last-width width)
   9.115 +            (ref-set last-height height))
   9.116 +           (apply draw! content
   9.117 +                  [(- 0 @x (:x anchor)) (- 0 @y (:y anchor))] opts))
   9.118 +         (:mouse-pressed e
   9.119 +          (dosync
   9.120 +           (ref-set fix-x (:x-on-screen e))
   9.121 +           (ref-set fix-y (:y-on-screen e)))
   9.122 +          (->> Cursor/MOVE_CURSOR Cursor. (.setCursor *target*)))
   9.123 +         (:mouse-released e
   9.124 +          (->> Cursor/DEFAULT_CURSOR Cursor. (.setCursor *target*)))
   9.125 +         (:mouse-dragged e
   9.126 +          (dosync
   9.127 +           (alter x + (- @fix-x (:x-on-screen e)))
   9.128 +           (alter y + (- @fix-y (:y-on-screen e)))
   9.129 +           (ref-set fix-x (:x-on-screen e))
   9.130 +           (ref-set fix-y (:y-on-screen e)))
   9.131 +          (*update*))))
   9.132 +     (size [layer opts] (size content opts))))))