changeset 160:d149f03d1feb

Reworked implementation of hbox and vbox (DRY).
author Mikhail Kryshen <mikhail@kryshen.net>
date Tue, 18 Nov 2014 17:00:35 +0300
parents 2a93c3ca0244
children acda6344bcb7
files src/indyvon/core.clj src/indyvon/views.clj
diffstat 2 files changed, 67 insertions(+), 51 deletions(-) [+]
line wrap: on
line diff
--- a/src/indyvon/core.clj	Tue Nov 18 00:41:05 2014 +0300
+++ b/src/indyvon/core.clj	Tue Nov 18 17:00:35 2014 +0300
@@ -181,6 +181,31 @@
   (anchor-y [_ v-align h]
     (* sy (anchor-y geometry v-align (/ h sy)))))
 
+(defrecord TransposedGeometry [geometry]
+  Geometry
+  (width [_]
+    (height geometry))
+  (width [_ h]
+    (height geometry h))
+  (height [_]
+    (width geometry))
+  (height [_ w]
+    (width geometry w))
+  (anchor-x [_ h-align w]
+    (anchor-y geometry
+              (get {:left :top
+                    :center :center
+                    :right :bottom}
+                   h-align)
+              w))
+  (anchor-y [_ v-align h]
+    (anchor-x geometry
+              (get {:top :left
+                    :center :center
+                    :bottom :right}
+                   v-align)
+              h)))
+
 ;; (defn ^:private to-integer
 ;;   ^long [align x]
 ;;   (if (integer? x)
@@ -560,19 +585,16 @@
   "Draws the View.  Location is relative to the view's anchor point
   for the specified alignment."
   ([view h-align v-align x y]
-     (let [geom (geometry view)
-           w (width geom)
-           h (height geom)]
-       (draw! view
-              (- x (anchor-x geom h-align w))
-              (- y (anchor-y geom v-align h))
-              w h)))
+     (draw-aligned! view (geometry view) h-align v-align x y))
+  ([view geom h-align v-align x y]
+     (draw-aligned! view geom h-align v-align x y (width geom) (height geom)))
   ([view h-align v-align x y w h]
-     (let [geom (geometry view)]
-       (draw! view
-              (- x (anchor-x geom h-align w))
-              (- y (anchor-y geom v-align h))
-              w h))))
+     (draw-aligned! view (geometry view) h-align v-align x y w h))
+  ([view geom h-align v-align x y w h]
+     (draw! view
+            (- x (anchor-x geom h-align w))
+            (- y (anchor-y geom v-align h))
+            w h)))
 
 ;;
 ;; Event handling.
--- a/src/indyvon/views.clj	Tue Nov 18 00:41:05 2014 +0300
+++ b/src/indyvon/views.clj	Tue Nov 18 17:00:35 2014 +0300
@@ -119,57 +119,51 @@
          (.fill *graphics* (Rectangle2D$Double. 0.0 0.0 *width* *height*)))
        (render! content))))
 
-(defn hbox-proportional [& contents]
-  (apply hbox* true contents))
+(defrecord Box [proportional? translate-geometry contents]
+  View
+  (render! [_]
+    (let [context-size (translate-geometry (->Size *width* *height*))
+          dimxs (map (comp width translate-geometry geometry) contents)
+          xs (cons 0 (reductions + dimxs))
+          dimxs-sum (last xs)
+          scale (if proportional? (/ (width context-size) dimxs-sum) 1)]
+      (doseq [[c w x] (map vector contents dimxs xs)]
+        (draw-aligned! c
+                       (translate-geometry
+                        (->FixedGeometry (- (* scale x)) 0
+                                         (* scale w) (height context-size)))
+                       :left :top
+                       0 0))))
+  (geometry [_]
+    (translate-geometry
+     (reduce #(->Size (+ (width %1) (width %2))
+                      (max (height %1) (height %2)))
+             (->Size 0 0)
+             (map (comp translate-geometry geometry) contents)))))
+
+(defn- hbox* [proportional? contents]
+  (->Box proportional? #'identity contents))
+
+(defn- vbox* [proportional? contents]
+  (->Box proportional? #'->TransposedGeometry contents))
 
 (defn hbox
   "Creates a view that draws the specified content views placing them
   horizontally."
   [& contents]
-  (apply hbox* false contents))
+  (hbox* false contents))
 
-(defn- hbox*
-  [proportional? & contents]
-  (reify
-    View
-    (render! [_]
-      (let [widths (map #(width (geometry %)) contents)
-            xs (cons 0 (reductions + widths))
-            widths-sum (last xs)
-            scale (if proportional? (/ *width* widths-sum) 1)]
-        (doseq [[c w x] (map vector contents widths xs)]
-          (draw! c (* scale x) 0 (* scale w) *height*))))
-    (geometry [_]
-      (reduce #(->Size (+ (width %1) (width %2))
-                       (max (height %1) (height %2)))
-              (->Size 0 0)
-              (map geometry contents)))))
-
-(defn vbox-proportional [& contents]
-  (apply vbox* true contents))
+(defn hbox-proportional [& contents]
+  (hbox* true contents))
 
 (defn vbox
   "Creates a view that draws the specified content views placing them
   horizontally."
   [& contents]
-  (apply vbox* false contents))
+  (vbox* false contents))
 
-(defn vbox*
-  [proportional? & contents]
-  (reify
-   View
-   (render! [_]
-     (let [heights (map #(height (geometry %)) contents)
-           ys (cons 0 (reductions + heights))
-           heights-sum (last ys)
-           scale (if proportional? (/ *height* heights-sum) 1)]
-       (doseq [[c h y] (map vector contents heights ys)]
-         (draw! c 0 (* scale y) *width* (* scale h)))))
-   (geometry [_]
-     (reduce #(->Size (max (width %1) (width %2))
-                      (+ (height %1) (height %2)))
-             (->Size 0 0)
-             (map geometry contents)))))
+(defn vbox-proportional [& contents]
+  (vbox* true contents))
 
 (defn- re-split [^java.util.regex.Pattern re s]
   (seq (.split re s)))