Mercurial > hg > indyvon
changeset 34:6975b9a71eec
Finally use var bindings instead of a context record.
author | Mikhail Kryshen <mikhail@kryshen.net> |
---|---|
date | Thu, 08 Jul 2010 05:27:54 +0400 |
parents | 439f6ecee119 (current diff) 828795987d4c (diff) |
children | 0d593970cb76 |
files | src/indyvon/component.clj src/indyvon/core.clj src/indyvon/layers.clj |
diffstat | 3 files changed, 182 insertions(+), 186 deletions(-) [+] |
line wrap: on
line diff
--- a/src/indyvon/component.clj Wed Jul 07 07:17:08 2010 +0400 +++ b/src/indyvon/component.clj Thu Jul 08 05:27:54 2010 +0400 @@ -5,54 +5,50 @@ ;; (ns indyvon.component - (:use indyvon.core indyvon.layers) - (:import (indyvon.core Size Location) - (java.awt Component Graphics2D Dimension Color) + (:use indyvon.core + indyvon.layers) + (:import (indyvon.core Size Bounds) + (java.awt Graphics2D Component Dimension Color) (javax.swing JFrame JPanel))) (defn- font-context [^Component component] (.getFontRenderContext (.getFontMetrics component (.getFont component)))) (defn paint-component - [^Component component layer context ^Graphics2D graphics] + [^Component component layer ^Graphics2D graphics event-dispatcher] (let [size (.getSize component) width (.width size) - height (.height size) - context (assoc context - :x 0 - :y 0 - :width width - :height height - :clip (indyvon.core.Bounds. 0 0 width height) - :target component - :graphics graphics - :font-context (.getFontRenderContext graphics) - :update-fn #(.repaint component))] + height (.height size)] (.clearRect graphics 0 0 width height) - (draw! layer context)) - (commit (:event-dispatcher context))) + (let [bounds (Bounds. 0 0 width height)] + (binding [*graphics* graphics + *font-context* (.getFontRenderContext graphics) + *target* component + *event-dispatcher* event-dispatcher + *update* #(.repaint component) + *bounds* bounds + *clip* bounds] + (render! layer nil) + (commit event-dispatcher))))) -(defn preferred-size [component layer context] - (let [context (assoc context - :target component - :font-context (font-context component)) - s (size layer context)] - (Dimension. (:width s) (:height s)))) +(defn preferred-size [component layer] + (binding [*target* component + *font-context*' (font-context component)] + (let [s (size layer nil)] + (Dimension. (:width s) (:height s))))) (defn make-jpanel ([layer] (make-jpanel layer (root-event-dispatcher))) ([layer event-dispatcher] - (let [context (default-context) - context (assoc context :event-dispatcher event-dispatcher) - panel + (let [panel (proxy [JPanel] [] (paintComponent [g] - (paint-component this layer context g)) + (paint-component this layer g event-dispatcher)) (getPreferredSize [] - (preferred-size this layer context)))] + (preferred-size this layer)))] + (.setBackground panel (:back-color *theme*)) (listen! event-dispatcher panel) - (.setBackground panel (-> context :theme :back-color)) panel))) (comment @@ -62,28 +58,28 @@ (def layer1 (reify Layer - (render! [this context] - (let-handlers this [context] - (doto (graphics context) + (render! [layer opts] + (with-handlers layer + (doto *graphics* (.setColor Color/RED) - (.fillRect 0 0 (:width context) (:height context))) + (.fillRect 0 0 (:width *bounds*) (:height *bounds*))) (:mouse-entered e (println e)) (:mouse-exited e (println e)) (:mouse-moved e (println e)))) - (size [this context] (Size. 30 20)))) + (size [layer opts] (Size. 30 20)))) (def layer1b (border-layer layer1 2 3)) (def layer2 (reify Layer - (render! [this context] - (doto (graphics context) + (render! [layer opts] + (doto *graphics* (.setColor Color/YELLOW) - (.fillRect 0 0 (:width context) (:height context))) - (draw! layer1b context 10 5) - (draw! layer1 context 55 5)) - (size [this context] (Size. 70 65)))) + (.fillRect 0 0 (:width *bounds*) (:height *bounds*))) + (draw! layer1b [10 5]) + (draw! layer1 [55 5])) + (size [layer opts] (Size. 70 65)))) (def layer3 (border-layer (text-layer "Sample\ntext" :right :center))) @@ -98,8 +94,8 @@ fl (ref (fps-layer 0.0))] (reify Layer - (render! [this c] - (draw! @fl c) + (render! [layer opts] + (render! @fl nil) (dosync (alter frames + 1) (let [time (System/currentTimeMillis) @@ -108,19 +104,19 @@ (ref-set fl (fps-layer (/ @frames elapsed))) (ref-set frames 0) (ref-set last time))))) - (size [this c] (size @fl c))))) + (size [layer opts] (size @fl nil))))) (def layer (reify Layer - (render! [this context] - (update context) - (doto (graphics context) + (render! [layer opts] + (*update*) + (doto *graphics* (.setColor (rand-nth [Color/BLACK Color/BLUE Color/RED])) - (.drawLine 0 0 (:width context) (:height context))) - (draw! layer2 context 15 20) - (draw! layer3 context 100 100 80 50) - (draw! fps context)) - (size [this context] (Size. 400 300)))) + (.drawLine 0 0 (:width *bounds*) (:height *bounds*))) + (draw! layer2 [15 20]) + (draw! layer3 [100 100 80 50]) + (render! fps nil)) + (size [layer opts] (Size. 400 300)))) (doto frame (.addWindowListener
--- a/src/indyvon/core.clj Wed Jul 07 07:17:08 2010 +0400 +++ b/src/indyvon/core.clj Thu Jul 08 05:27:54 2010 +0400 @@ -6,24 +6,40 @@ (ns indyvon.core (:import (java.awt Graphics2D Component Color Font) - (java.awt.event MouseListener MouseMotionListener))) + (java.awt.event MouseListener MouseMotionListener) + (java.awt.font FontRenderContext))) -(defprotocol Layer - "Basic UI element." - (render! [this context]) - (size [this context])) +(def ^Graphics2D *graphics*) +(def ^FontRenderContext *font-context*) +(def ^Component *target*) +(def *bounds*) +(def *clip*) +(def *update*) +(def *event-dispatcher*) + +(defrecord Theme [fore-color back-color border-color font]) + +(defn default-theme [] + (Theme. Color/BLACK Color/WHITE Color/BLUE (Font. "Sans" Font/PLAIN 12))) + +(def *theme* (default-theme)) (defrecord Location [x y]) (defrecord Size [width height]) (defrecord Bounds [x y width height]) +(defprotocol Layer + "Basic UI element." + (render! [this opts]) + (size [this opts])) + ;; TODO: modifiers (defrecord MouseEvent [id when x y x-on-screen y-on-screen button]) (defprotocol EventDispatcher (listen! [this ^Component component] "Listen for events on the specified AWT Component.") - (create-dispatcher [this context handle handlers] + (create-dispatcher [this handle handlers] "Returns new event dispatcher associated with the specified event handlers (an event-id -> handler-fn map). Handle is used to match the contexts between commits.") @@ -32,18 +48,18 @@ (defprotocol Anchored "Provide anchor point for Layers. Used by viewport." - (anchor [this context h-align v-align] + (anchor [this h-align v-align opts] "Anchor point: [x y], h-align could be :left, :center or :right, v-align is :top, :center or :bottom")) ;; Default implementation of Anchored for any Layer. (extend-protocol Anchored indyvon.core.Layer - (anchor [this context h-align v-align] + (anchor [this h-align v-align opts] (if (and (= h-align :left) (= v-align :top)) (Location. 0 0) - (let [size (size this context)] + (let [size (size this opts)] (Location. (case h-align :top 0 @@ -54,26 +70,6 @@ :center (/ (:height size) 2) :bottom (:height size))))))) -(defrecord Theme [fore-color back-color border-color font]) - -(defn default-theme [] - (Theme. Color/BLACK Color/WHITE Color/BLUE (Font. "Sans" Font/PLAIN 12))) - -(defrecord LayerContext [x y width height clip - update-fn font-context theme - target event-dispatcher]) - -(defn default-context [] - (LayerContext. 0 0 0 0 nil nil nil (default-theme) nil nil)) - -(defn update [context] - ((:update-fn context))) - -(defn ^Graphics2D graphics - "Get AWT Graphics2D from context." - [context] - (:graphics context)) - (defn- ^Graphics2D make-graphics [^Graphics2D graphics x y w h] (.create graphics x y w h)) @@ -82,69 +78,72 @@ (.setColor (:fore-color theme)) (.setFont (:font theme)))) -(defn intersect [bounds x y w h] - (let [x12 (+ x w) - y12 (+ y h) - x21 (:x bounds) - y21 (:y bounds) - x22 (+ x21 (:width bounds)) - y22 (+ y21 (:height bounds)) - x1 (max x x21) - y1 (max y y21) +(defn intersect [b1 b2] + (let [x11 (:x b1) + y11 (:y b1) + x12 (+ x11 (:width b1)) + y12 (+ y11 (:height b1)) + x21 (:x b2) + y21 (:y b2) + x22 (+ x21 (:width b2)) + y22 (+ y21 (:height b2)) + x1 (max x11 x21) + y1 (max y11 y21) x2 (min x12 x22) y2 (min y12 y22)] (Bounds. x1 y1 (- x2 x1) (- y2 y1)))) -(defn translate [context x y w h] - (let [ax (+ (:x context) x) - ay (+ (:y context) y)] - (assoc context - :x (+ (:x context) x) - :y (+ (:y context) y) - :width w - :height h - :clip (intersect (:clip context) ax ay w h) - :graphics (apply-theme - (make-graphics (:graphics context) x y w h) - (:theme context))))) +(defn with-translate* [x y w h f & args] + (let [graphics (apply-theme (.create *graphics* x y w h) *theme*) + bounds (Bounds. (+ x (:x *bounds*)) + (+ y (:y *bounds*)) + w h)] + (try + (apply with-bindings* {#'*bounds* bounds + #'*clip* (intersect bounds *clip*) + #'*graphics* graphics} + f args) + (finally + (.dispose graphics))))) + +(defmacro with-translate [x y w h & body] + `(with-translate* ~x ~y ~w ~h (fn [] ~@body))) + + + +(defn with-handlers* [handle handlers f & args] + (apply with-bindings* + {#'*event-dispatcher* + (create-dispatcher *event-dispatcher* handle handlers)} + f args)) + +(defmacro with-handlers + "specs => (:event-id name & handler-body)* + + Execute form with the specified event handlers." + [handle form & specs] + `(with-handlers* ~handle + ~(reduce (fn [m spec] + (assoc m (first spec) + `(fn [~(second spec)] + ~@(nnext spec)))) {} + specs) + (fn [] ~form))) + +(defn- geometry-vec [geometry] + (if (vector? geometry) + geometry + [(:x geometry) (:y geometry) (:width geometry) (:height geometry)])) (defn draw! - "Render layer in a new graphics context." - ([layer context] - (render! layer context)) - ([layer context x y] - (let [s (size layer context)] - (draw! layer context x y (:width s) (:height s)))) - ([layer context x y w h] - (let [context (translate context x y w h)] - (try - (render! layer context) - (finally - (.dispose (:graphics context))))))) - -(defn add-handlers [context handle handlers] - "Returns new context with the specified event handlers." - (assoc context - :event-dispatcher - (create-dispatcher (:event-dispatcher context) context - handle handlers))) - -(defmacro let-handlers [handle bindings form & specs] - "bindings => [binding-form context] or [context-symbol] - specs => (:event-id name & handler-body)* - - Execute form with the specified event handlers." - (let [[binding context] bindings - context (or context binding)] - `(let [context# ~context - ~binding - (add-handlers context# ~handle - ~(reduce (fn [m spec] - (assoc m (first spec) - `(fn [~(second spec)] - ~@(nnext spec)))) {} - specs))] - ~form))) + "Draw a layer. Geometry is either a map or vector [x y] or + [x y width height]." + [layer geometry & args] + (let [[x y w h] (geometry-vec geometry) + size (if-not (and w h) (size layer args)) + w (or w (:width size)) + h (or h (:height size))] + (with-translate* x y w h render! layer args))) ;; ;; EventDispatcher implementation @@ -159,17 +158,18 @@ java.awt.event.MouseEvent/MOUSE_PRESSED :mouse-pressed java.awt.event.MouseEvent/MOUSE_RELEASED :mouse-released}) -(defrecord DispatcherNode [handle handlers parent bounds] +(defrecord DispatcherNode [handle handlers parent bounds bindings] EventDispatcher (listen! [this component] (listen! parent component)) - (create-dispatcher [this context handle handlers] - (create-dispatcher parent context handle handlers)) + (create-dispatcher [this handle handlers] + (create-dispatcher parent handle handlers)) (commit [this] (commit parent))) -(defn- make-node [c handle handlers] - (DispatcherNode. handle handlers (:event-dispatcher c) (:clip c))) +(defn- make-node [handle handlers] + (DispatcherNode. handle handlers *event-dispatcher* *clip* + (get-thread-bindings))) (defn- assoc-cons [m key val] (assoc m key (cons val (get m key)))) @@ -209,9 +209,10 @@ ([nodes event id] (doseq [node nodes] (when-let [handler (get (:handlers node) id)] - (handler - (translate-mouse-event event - (-> node :bounds :x) (-> node :bounds :y) id)))) + (with-bindings* (:bindings node) + handler + (translate-mouse-event event + (-> node :bounds :x) (-> node :bounds :y) id)))) id)) (defn- dispatch-mouse-motion* @@ -259,8 +260,8 @@ (doto component (.addMouseListener this) (.addMouseMotionListener this))) - (create-dispatcher [this context handle handlers] - (let [node (make-node context handle handlers)] + (create-dispatcher [this handle handlers] + (let [node (make-node handle handlers)] (dosync (alter tree-r add-node node)) node)) (commit [this]
--- a/src/indyvon/layers.clj Wed Jul 07 07:17:08 2010 +0400 +++ b/src/indyvon/layers.clj Thu Jul 08 05:27:54 2010 +0400 @@ -7,7 +7,7 @@ (ns indyvon.layers (:use indyvon.core) (:import (indyvon.core Size Location) - (java.awt Cursor) + (java.awt Font Cursor) (java.awt.font FontRenderContext TextLayout))) ;; Define as macro to avoid unnecessary calculation of inner and outer @@ -33,30 +33,33 @@ ([content width gap] (let [offset (+ width gap)] (reify Layer - (render! [l c] - (let [w (:width c) - h (:height c)] - (.setColor (graphics c) (-> c :theme :border-color)) + (render! [l opts] + (let [w (:width *bounds*) + h (:height *bounds*)] + (.setColor *graphics* (:border-color *theme*)) (doseq [i (range 0 width)] - (.drawRect (graphics c) i i (- w 1 i i) (- h 1 i i))) - (draw! content c offset offset (- w offset offset) - (- h offset offset)))) - (size [l c] - (let [s (size content c)] + (.drawRect *graphics* i i (- w 1 i i) (- h 1 i i))) + (apply draw! content + [offset offset (- w offset offset) (- h offset offset)] + opts))) + (size [l opts] + (let [s (size content opts)] (Size. (+ (:width s) offset offset) (+ (:height s) offset offset)))))))) -(defn- re-split [re s] +(defn- re-split [^java.util.regex.Pattern re s] (seq (.split re s))) -(defn- layout-text [lines font font-context] - (map #(TextLayout. % font font-context) lines)) +(defn- layout-text [lines ^Font font ^FontRenderContext font-context] + (map #(TextLayout. ^String % font font-context) lines)) (defn- text-width [layouts] - (reduce #(max %1 (.getAdvance %2)) 0 layouts)) + (reduce (fn [w ^TextLayout tl] (max w (.getAdvance tl))) 0 layouts)) (defn- text-height [layouts] - (reduce #(+ %1 (.getAscent %2) (.getDescent %2) (.getLeading %2)) + (reduce (fn [w ^TextLayout tl] (+ w (.getAscent tl) + (.getDescent tl) + (.getLeading tl))) 0 layouts)) (defn text-layer @@ -66,24 +69,21 @@ ([text h-align v-align] (let [lines (re-split #"\r\n|\n|\r|\u0085|\u2028|\u2029" text)] (reify Layer - (render! [l c] - (let [w (:width c) - h (:height c) - font (.getFont (graphics c)) - font-context (:font-context c) - layouts (layout-text lines font font-context) + (render! [layer opts] + (let [w (:width *bounds*) + h (:height *bounds*) + font (.getFont *graphics*) + layouts (layout-text lines font *font-context*) y (align-y (text-height layouts) h v-align)] (loop [layouts layouts, y y] - (when-first [layout layouts] + (when-first [^TextLayout layout layouts] (let [ascent (.getAscent layout) lh (+ ascent (.getDescent layout) (.getLeading layout)) x (align-x (.getAdvance layout) w h-align)] - (.draw layout (graphics c) x (+ y ascent)) + (.draw layout *graphics* x (+ y ascent)) (recur (next layouts) (+ y lh))))))) - (size [l c] - (let [layouts (layout-text lines - (-> c :theme :font) - (:font-context c)) + (size [layer opts] + (let [layouts (layout-text lines (:font *theme*) *font-context*) width (text-width layouts) height (text-height layouts)] (Size. width height))))))) @@ -100,31 +100,30 @@ last-height (ref 0)] (reify Layer - (render! [layer c] - (let-handlers layer [c] - (let [anchor (anchor content c h-align v-align) - width (:width c) - height (:height c)] + (render! [layer opts] + (with-handlers layer + (let [anchor (anchor content h-align v-align opts) + width (:width *bounds*) + height (:height *bounds*)] (dosync (alter x + (align-x width @last-width h-align)) (alter y + (align-y height @last-height v-align)) (ref-set last-width width) (ref-set last-height height)) - (draw! content c - (- 0 @x (:x anchor)) - (- 0 @y (:y anchor)))) + (apply draw! content + [(- 0 @x (:x anchor)) (- 0 @y (:y anchor))] opts)) (:mouse-pressed e (dosync (ref-set fix-x (:x-on-screen e)) (ref-set fix-y (:y-on-screen e))) - (->> Cursor/MOVE_CURSOR Cursor. (.setCursor (:target c)))) + (->> Cursor/MOVE_CURSOR Cursor. (.setCursor *target*))) (:mouse-released e - (->> Cursor/DEFAULT_CURSOR Cursor. (.setCursor (:target c)))) + (->> Cursor/DEFAULT_CURSOR Cursor. (.setCursor *target*))) (:mouse-dragged e (dosync (alter x + (- @fix-x (:x-on-screen e))) (alter y + (- @fix-y (:y-on-screen e))) (ref-set fix-x (:x-on-screen e)) (ref-set fix-y (:y-on-screen e))) - (update c)))) - (size [layer c] (size content c)))))) + (*update*)))) + (size [layer opts] (size content opts))))))