Mercurial > hg > indyvon
changeset 106:f42e2b9e1ad9
Removed Anchored protocol, "layer-size" function in Layer replaced with "geometry" which returns a structure describing both layer size and anchor point.
Indyvon now requires Clojure 1.3.
| author | Mikhail Kryshen <mikhail@kryshen.net> |
|---|---|
| date | Wed, 21 Sep 2011 02:27:11 +0300 |
| parents | 24e98602b37e |
| children | 5fdb0bb99f75 |
| files | README.rst README.ru project.clj src/net/kryshen/indyvon/async.clj src/net/kryshen/indyvon/component.clj src/net/kryshen/indyvon/core.clj src/net/kryshen/indyvon/demo.clj src/net/kryshen/indyvon/layers.clj |
| diffstat | 8 files changed, 209 insertions(+), 144 deletions(-) [+] |
line wrap: on
line diff
--- a/README.rst Tue May 24 18:43:49 2011 +0400 +++ b/README.rst Wed Sep 21 02:27:11 2011 +0300 @@ -11,7 +11,7 @@ (defprotocol Layer (render! [layer] "Draws the layer.") - (layer-size [layer] + (geometry [layer] "Returns preferred size for the layer.")) Layer functions are called in the Layer context which is defined by
--- a/README.ru Tue May 24 18:43:49 2011 +0400 +++ b/README.ru Wed Sep 21 02:27:11 2011 +0300 @@ -15,7 +15,7 @@ (слой), который содержит всего две функции: render! — отрисовка, - layer-size — получение предпочтительного размера элемента. + geometry — получение предпочтительных размеров элемента. Слой, в отличии от обычных компонентов интерфейса или элементов графов сцены в системах визуализации, не имеет состояния (координаты, размер,
--- a/project.clj Tue May 24 18:43:49 2011 +0400 +++ b/project.clj Wed Sep 21 02:27:11 2011 +0300 @@ -1,9 +1,8 @@ (defproject indyvon "1.0.0-SNAPSHOT" :description "INteractive DYnamic VisualizatiON library" ;;:warn-on-reflection true - :dependencies [[org.clojure/clojure "1.2.1"] + :dependencies [[org.clojure/clojure "1.3.0-RC0"] [com.google.guava/guava "r09"]] - :dev-dependencies [[swank-clojure "1.3.1"]] ;;:aot [net.kryshen.indyvon.core ;; net.kryshen.indyvon.async ;; net.kryshen.indyvon.layers
--- a/src/net/kryshen/indyvon/async.clj Tue May 24 18:43:49 2011 +0400 +++ b/src/net/kryshen/indyvon/async.clj Wed Sep 21 02:27:11 2011 +0300 @@ -22,7 +22,6 @@ (:use net.kryshen.indyvon.core) (:import - (net.kryshen.indyvon.core Size Location) java.awt.GraphicsConfiguration (java.awt Image AlphaComposite Transparency) (java.awt.image BufferedImage) @@ -146,8 +145,8 @@ (draw-offscreen-async layer)) (with-buffer layer :front [b] (.drawImage *graphics* ^Image (:image b) 0 0 nil))) - (layer-size [layer] - (Size. width height))) + (geometry [layer] + (->Size width height))) (defn- create-thread-factory [priority] (reify
--- a/src/net/kryshen/indyvon/component.clj Tue May 24 18:43:49 2011 +0400 +++ b/src/net/kryshen/indyvon/component.clj Wed Sep 21 02:27:11 2011 +0300 @@ -22,7 +22,6 @@ (:use net.kryshen.indyvon.core) (:import - (net.kryshen.indyvon.core Size Bounds) (java.awt Graphics Component Dimension Color) (java.awt.geom Rectangle2D$Double) (javax.swing JFrame JPanel JOptionPane))) @@ -49,8 +48,8 @@ (draw-root! layer g (.width size) (.height size) event-dispatcher this))) (getPreferredSize [] - (let [s (root-size layer (font-context this) this)] - (Dimension. (:width s) (:height s)))))] + (let [geom (root-geometry layer (font-context this) this)] + (Dimension. (width geom) (height geom)))))] (.setBackground panel (:back-color *theme*)) (add-observer panel layer (fn [w _] ;; Use the first observer argument
--- a/src/net/kryshen/indyvon/core.clj Tue May 24 18:43:49 2011 +0400 +++ b/src/net/kryshen/indyvon/core.clj Wed Sep 21 02:27:11 2011 +0300 @@ -93,18 +93,88 @@ (def ^{:dynamic true} *theme* (default-theme)) -(defrecord Location [x y]) -(defrecord Size [width height]) -(defrecord Bounds [x y width height]) - ;; ;; Core protocols and types ;; (defprotocol Layer "Basic UI element." - (render! [this]) - (layer-size [this])) + (render! [layer] + "Draws layer in the current *graphics* context.") + (geometry [layer] + "Returns the preferred layer Geometry.")) + +(defprotocol Geometry + "Describes geometry of a Layer. Prefer using the available + implementations (Size, FixedGeometry and NestedGeometry) over + extending this protocol directly as it is likely to be changed in + the future versions." + (width [geom] [geom height]) + (height [geom] [geom width]) + (anchor-x [geom h-align width] + "Returns the x coordinate of the anchor point for the specified + horizontal alignment and width, h-align could be :left, :center + or :right.") + (anchor-y [geom v-align height] + "Returns the y coordinate of the anchor point for the specified + vertical alignment and height, v-align could be :top, :center + or :bottom.")) + +(defrecord Size [width height] + Geometry + (width [_] width) + (width [_ _] width) + (height [_] height) + (height [_ _] height) + (anchor-x [_ h-align width] + (case h-align + :left 0 + :center (/ width 2) + :right width)) + (anchor-y [_ v-align height] + (case v-align + :top 0 + :center (/ height 2) + :bottom height))) + +(defrecord FixedGeometry [ax ay width height] + Geometry + (width [_] width) + (width [_ _] width) + (height [_] height) + (height [_ _] height) + (anchor-x [_ _ _] ax) + (anchor-y [_ _ _] ay)) + +(defrecord NestedGeometry [geometry top left bottom right] + Geometry + (width [_] + (+ left right (width geometry))) + (width [_ h] + (+ left right (width geometry (- h top bottom)))) + (height [_] + (+ top bottom (height geometry))) + (height [_ w] + (+ top bottom (height geometry (- w left right)))) + (anchor-x [_ h-align w] + (+ left (anchor-x geometry h-align (- w left right)))) + (anchor-y [_ v-align h] + (+ top (anchor-y geometry v-align (- h top bottom))))) + +(defrecord ScaledGeometry [geometry sx sy] + Geometry + (width [_] + (* sx (width geometry))) + (width [_ h] + (* sx (width geometry (/ h sy)))) + (height [_] + (* sy (height geometry))) + (height [_ w] + (* sy (height geometry (/ w sx)))) + (anchor-x [_ h-align w] + (* sx (anchor-x geometry h-align (/ w sx)))) + (anchor-y [_ v-align h] + (* sy (anchor-y geometry v-align (/ h sy))))) ;; TODO: modifiers (defrecord MouseEvent [id when x y x-on-screen y-on-screen button @@ -128,33 +198,6 @@ "Returns true if the specified handle received the :mouse-entered event and have not yet received :mouse-exited.")) -(defprotocol Anchored - "Provide anchor point for Layers. Used by viewport." - (anchor [this h-align v-align] - "Anchor point: [x y], h-align could be :left, :center or :right, - v-align is :top, :center or :bottom")) - -(defn default-anchor [layer h-align v-align] - (if (and (= h-align :left) - (= v-align :top)) - (Location. 0 0) - (let [size (layer-size layer)] - (Location. - (case h-align - :left 0 - :center (/ (:width size) 2) - :right (:width size)) - (case v-align - :top 0 - :center (/ (:height size) 2) - :bottom (:height size)))))) - -;; Default implementation of Anchored for any Layer. -(extend-protocol Anchored - net.kryshen.indyvon.core.Layer - (anchor [this h-align v-align] - (default-anchor this h-align v-align))) - (defn- assoc-cons [m key val] (->> (get m key) (cons val) (assoc m key))) @@ -408,8 +451,8 @@ ([layer x y] (draw! layer x y true)) ([layer x y clip?] - (let [size (layer-size layer)] - (draw! layer x y (:width size) (:height size) clip?))) + (let [geom (geometry layer)] + (draw! layer x y (width geom) (height geom) clip?))) ([layer x y width height] (draw! layer x y width height true)) ([layer x y width height clip?] @@ -417,15 +460,23 @@ (with-bounds* x y width height render! layer) (with-bounds-noclip* x y width height render! layer)))) -(defn draw-anchored! +(defn draw-aligned! "Draws layer. Location is relative to the layer's anchor point for the specified alignment." ([layer h-align v-align x y] - (let [anchor (anchor layer h-align v-align)] - (draw! layer (- x (:x anchor)) (- y (:y anchor))))) + (let [geom (geometry layer) + w (width geom) + h (height geom)] + (draw! layer + (- x (anchor-x geom h-align w)) + (- y (anchor-y geom v-align h)) + w h))) ([layer h-align v-align x y w h] - (let [anchor (anchor layer h-align v-align)] - (draw! layer (- x (:x anchor)) (- y (:y anchor)) w h)))) + (let [geom (geometry layer)] + (draw! layer + (- x (anchor-x geom h-align w)) + (- y (anchor-y geom v-align h)) + w h)))) (defn draw-root! "Draws the root layer." @@ -468,14 +519,14 @@ (remove-observers tmp-watcher) (commit event-dispatcher))))))) -(defn root-size +(defn root-geometry ([layer font-context] - (root-size layer font-context nil)) + (root-geometry layer font-context nil)) ([layer font-context target] (binding [*root* layer *target* target *font-context* font-context] - (layer-size layer)))) + (geometry layer)))) ;; ;; Event handling.
--- a/src/net/kryshen/indyvon/demo.clj Tue May 24 18:43:49 2011 +0400 +++ b/src/net/kryshen/indyvon/demo.clj Wed Sep 21 02:27:11 2011 +0300 @@ -23,7 +23,6 @@ (:use (net.kryshen.indyvon core layers component)) (:import - (net.kryshen.indyvon.core Size) (java.awt Color) (javax.swing JFrame))) @@ -121,10 +120,10 @@ (:mouse-pressed _ (repaint)) (:mouse-released _ (repaint)) (:mouse-clicked _ (apply callback args)))) - (layer-size [button] - (let [face-size (layer-size face)] - (Size. (+ (:width face-size) shadow-offset) - (+ (:height face-size) shadow-offset)))))))) + (geometry [button] + (let [face-geom (geometry face)] + (->Size (+ (width face-geom) shadow-offset) + (+ (height face-geom) shadow-offset)))))))) (def button1 (animated-button (label "Animated button 1") println "Animated button 1 clicked")) @@ -147,8 +146,8 @@ (println e)) (:mouse-moved e (println e)))) - (layer-size [layer] - (Size. 30 20)))) + (geometry [layer] + (->Size 30 20)))) (def test-layer1b (border test-layer1 2 3)) @@ -162,8 +161,8 @@ (with-rotate 0.5 0 0 (draw! test-layer1b 30 25)) (draw! test-layer1 55 5)) - (layer-size [layer] - (Size. 70 65)))) + (geometry [layer] + (->Size 70 65)))) (def test-layer2m (miniature test-layer2 30 30)) @@ -191,8 +190,8 @@ (draw-button! :button (label "Immediate button" :center :center) #(println "Button clicked!")))) - (layer-size [layer] - (Size. 400 300)))) + (geometry [layer] + (->Size 400 300)))) ;; Main viewport (def vp (viewport root)) @@ -205,7 +204,7 @@ (fps-layer (decorate-layer vp [_] (draw! vp) - (draw-anchored! + (draw-aligned! (label (str "Drag mouse to pan," \newline "use mouse wheel to zoom.")) :left :bottom 5 (- *height* 5))
--- a/src/net/kryshen/indyvon/layers.clj Tue May 24 18:43:49 2011 +0400 +++ b/src/net/kryshen/indyvon/layers.clj Wed Sep 21 02:27:11 2011 +0300 @@ -22,7 +22,6 @@ (:use (net.kryshen.indyvon core async)) (:import - (net.kryshen.indyvon.core Size Location) (java.lang.ref SoftReference) (java.awt Font Cursor Image Toolkit Point) java.awt.image.ImageObserver @@ -47,14 +46,13 @@ `(align-xy ~inner ~outer ~align :top :center :bottom)) (defmacro decorate-layer - "Decorate Layer and Anchored replacing render! implementation." + "Decorate Layer replacing render! implementation." [layer & render-tail] - `(reify - Layer - (render! ~@render-tail) - (layer-size [t#] (layer-size ~layer)) - Anchored - (anchor [t# xa# ya#] (anchor ~layer xa# ya#)))) + `(let [layer# ~layer] + (reify + Layer + (render! ~@render-tail) + (geometry [t#] (geometry layer#))))) (defn padding "Decorates layer adding padding." @@ -70,10 +68,8 @@ left top (- *width* left right) (- *height* top bottom))) - (layer-size [l] - (let [s (layer-size content)] - (Size. (+ (:width s) left right) - (+ (:height s) top bottom)))))))) + (geometry [l] + (->NestedGeometry (geometry content) top left bottom right)))))) (defn border "Decorate layer with a border." @@ -110,7 +106,6 @@ shadow-x (+ x-offset x) shadow-y (+ y-offset y)] (reify - ;; TODO: Anchored Layer (render! [_] (let [w (- *width* abs-x) @@ -118,10 +113,9 @@ (with-color :shadow-color (.fillRect *graphics* shadow-x shadow-y w h)) (draw! content x y w h))) - (layer-size [_] - (let [s (layer-size content)] - (Size. (+ (:width s) abs-x) - (+ (:height s) abs-y)))))))) + (geometry [_] + (->NestedGeometry (geometry content) + y x shadow-y shadow-x)))))) (defn panel "Opaque layer using theme's alt-back-color." @@ -141,17 +135,17 @@ (reify Layer (render! [_] - (let [widths (map #(:width (layer-size %)) contents) + (let [widths (map #(width (geometry %)) contents) xs (cons 0 (reductions + widths)) widths-sum (last xs) scale (/ *width* widths-sum)] (doseq [[c w x] (map vector contents widths xs)] (draw! c x 0 w *height*)))) - (layer-size [_] - (reduce #(Size. (+ (:width %1) (:width %2)) - (max (:height %1) (:height %2))) - (Size. 0 0) - (map layer-size contents))))) + (geometry [_] + (reduce #(->Size (+ (width %1) (width %2)) + (max (height %1) (height %2))) + (->Size 0 0) + (map geometry contents))))) (defn vbox "Creates layer that draws the specified content layers placing them @@ -160,17 +154,17 @@ (reify Layer (render! [_] - (let [heights (map #(:height (layer-size %)) contents) + (let [heights (map #(height (geometry %)) contents) ys (cons 0 (reductions + heights)) heights-sum (last ys) scale (/ *height* heights-sum)] (doseq [[c h y] (map vector contents heights ys)] (draw! c 0 y *width* h)))) - (layer-size [_] - (reduce #(Size. (max (:width %1) (:width %2)) - (+ (:height %1) (:height %2))) - (Size. 0 0) - (map layer-size contents))))) + (geometry [_] + (reduce #(->Size (max (width %1) (width %2)) + (+ (height %1) (height %2))) + (->Size 0 0) + (map geometry contents))))) (defn- re-split [^java.util.regex.Pattern re s] (seq (.split re s))) @@ -223,11 +217,11 @@ x (align-x (.getAdvance layout) w h-align)] (.draw layout *graphics* x (+ y ascent)) (recur (next layouts) (+ y lh))))))) - (layer-size [layer] + (geometry [layer] (let [layouts (layout-text lines (:font *theme*) *font-context*) - width (text-width layouts) - height (text-height layouts)] - (Size. width height))))))) + w (text-width layouts) + h (text-height layouts)] + (->Size w h))))))) (defn- ^ImageObserver image-observer [layer] (reify @@ -250,13 +244,13 @@ (render! [layer] (repaint-on-update layer) (.drawImage *graphics* image 0 0 (image-observer layer))) - (layer-size [layer] + (geometry [layer] (let [observer (image-observer layer) width (.getWidth image observer) height (.getHeight image observer) width (if (pos? width) width 1) height (if (pos? height) height 1)] - (Size. width height)))))) + (->Size width height)))))) (def ^{:dynamic true} *miniature-thread-priority* 2) @@ -268,24 +262,23 @@ (defn miniature "Creates layer that asynchronously renders view of the content scaled to the specified size." - [content width height] + [content mw mh] (async-layer (reify Layer (render! [this] - (let [size (layer-size content) - s (scaling (:width size) (:height size) width height)] + (let [geom (geometry content) + cw (width geom) + ch (height geom) + s (scaling cw ch mw mh)] (.scale *graphics* s s) (draw! content - (align-x (:width size) (/ width s) :center) - (align-y (:height size) (/ height s) :center) - (:width size) (:height size)))) - (layer-size [this] - (Size. width height))) - ;; (let [size (layer-size content) - ;; s (scaling (:width size) (:height size) width height)] - ;; (Size. (* (:width size) s) (* (:height size) s))))) - width height *miniature-thread-priority*)) + (align-x cw (/ mw s) :center) + (align-y ch (/ mh s) :center) + cw ch))) + (geometry [_] + (->Size mw mh))) + mw mh *miniature-thread-priority*)) ;;(defn- translate [^AffineTransform transform ^double x ^double y] ;; (doto ^AffineTransform (.clone transform) @@ -309,17 +302,22 @@ ;; State (refs) transform fix-x fix-y - last-width last-height last-anchor] + last-width last-height + last-anchor-x last-anchor-y] Layer (render! [layer] (repaint-on-update layer) (with-handlers layer - (let [anchor (anchor content h-align v-align)] + (let [geom (geometry content) + cw (width geom) + ch (height geom) + ax (anchor-x geom h-align cw) + ay (anchor-y geom v-align ch)] (dosync (let [ax1 (align-x @last-width *width* h-align) ay1 (align-y @last-height *height* v-align) - ax2 (- (:x @last-anchor) (:x anchor)) - ay2 (- (:y @last-anchor) (:y anchor))] + ax2 (- @last-anchor-x ax) + ay2 (- @last-anchor-y ay)] (if-not (and (zero? ax1) (zero? ay1) (zero? ax2) (zero? ay2)) (ref-set transform (doto (AffineTransform/getTranslateInstance ax1 ay1) @@ -327,10 +325,11 @@ (.translate ax2 ay2))))) (ref-set last-width *width*) (ref-set last-height *height*) - (ref-set last-anchor anchor)) + (ref-set last-anchor-x ax) + (ref-set last-anchor-y ay)) ;; TODO: notify observers when size changes. (with-transform @transform - (draw! content 0 0 false))) + (draw! content 0 0 cw ch false))) (:mouse-pressed e (dosync (ref-set fix-x (:x-on-screen e)) @@ -364,8 +363,8 @@ *viewport-max-scale*) (ref-set transform scaled)))) (update layer)))) - (layer-size [layer] - (layer-size content))) + (geometry [_] + (geometry content))) (defn viewport "Creates scrollable viewport layer." @@ -376,31 +375,32 @@ (ref (AffineTransform.)) ; transform (ref 0) (ref 0) ; fix-x fix-y (ref 0) (ref 0) ; last-width last-height - (ref (Location. 0 0))))) ; last-anchor + (ref 0) (ref 0)))) ; last-anchor-x last-anchor-y (defn reset-viewport [viewport] (dosync (ref-set (:last-width viewport) 0) (ref-set (:last-height viewport) 0) - (ref-set (:last-anchor viewport) (Location. 0 0)) + (ref-set (:last-anchor-x viewport) 0) + (ref-set (:last-anchor-y viewport) 0) (ref-set (:transform viewport) (AffineTransform.))) (update viewport)) (defn viewport-miniature "Creates miniature view of the viewport's contents." - [viewport width height] - (let [miniature (miniature (:content viewport) width height)] + [viewport m-width m-height] + (let [miniature (miniature (:content viewport) m-width m-height)] (decorate-layer miniature [l] (repaint-on-update viewport) - (let [size (layer-size (:content viewport)) - s (scaling (:width size) (:height size) width height) + (let [geom (geometry (:content viewport)) + s (scaling (width geom) (height geom) m-width m-height) [vp-tr w h] (dosync [@(:transform viewport) @(:last-width viewport) @(:last-height viewport)]) vp-inverse (.createInverse ^AffineTransform vp-tr) - ox (align-x (:width size) (/ width s) :center) - oy (align-y (:height size) (/ height s) :center) + ox (align-x (width geom) (/ m-width s) :center) + oy (align-y (height geom) (/ m-height s) :center) transform (doto (AffineTransform.) (.scale s s) (.translate ox oy) @@ -437,15 +437,10 @@ (repaint-on-update l) (if-let [layer @layer-ref] (render! layer))) - (layer-size [_] + (geometry [_] (if-let [layer @layer-ref] - (layer-size layer) - (Size. 1 1))) - Anchored - (anchor [_ x-align y-align] - (if-let [layer @layer-ref] - (anchor layer x-align y-align) - (Location. 0 0))))] + (geometry layer) + (->Size 1 1))))] (add-watch layer-ref l (fn [_ _ _ _] (update l))) l)) @@ -467,16 +462,12 @@ (apply array-map map-or-keyvals))] (reify Layer - (render! [t] + (render! [_] (with-theme theme (render! layer))) - (layer-size [t] + (geometry [_] (with-theme theme - (layer-size layer))) - Anchored - (anchor [t xa ya] - (with-theme theme - (anchor layer xa ya)))))) + (geometry layer)))))) (defn hinted [layer & map-or-keyvals] (let [hints (if (== (count map-or-keyvals) 1) @@ -553,7 +544,17 @@ ([layer transform x y w h] (let [p (to-graphics-coords transform x y)] (draw! layer (.x p) (.y p) w h)))) - + +(defn- draw-relative-aligned! + [layer transform h-align v-align x y] + (let [geom (geometry layer) + w (width geom) + h (height geom) + p (to-graphics-coords transform x y) + x (- (.x p) (anchor-x geom h-align w)) + y (- (.y p) (anchor-y geom v-align h))] + (draw! layer x y w h))) + (defn overlay! "Draws layer in the overlayer context above the other layers." ([layer] @@ -563,6 +564,11 @@ ([layer x y w h] (overlay* draw-relative! layer (.getTransform *graphics*) x y w h))) +(defn overlay-aligned! [layer h-align v-align x y] + (overlay* draw-relative-aligned! + layer (.getTransform *graphics*) + h-align v-align x y)) + (defn overlayer [content] (decorate-layer content [_] @@ -570,3 +576,15 @@ (render! content) (doseq [f *above*] (f))))) + +(defn overlayer* + [content] + (decorate-layer content [_] + (binding [*above* []] + (render! content) + (loop [above *above*] + (when (seq above) + (var-set #'*above* []) + (doseq [f above] + (f)) + (recur *above*))))))