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 diff
     1.1 --- a/src/indyvon/core.clj	Tue Nov 18 00:41:05 2014 +0300
     1.2 +++ b/src/indyvon/core.clj	Tue Nov 18 17:00:35 2014 +0300
     1.3 @@ -181,6 +181,31 @@
     1.4    (anchor-y [_ v-align h]
     1.5      (* sy (anchor-y geometry v-align (/ h sy)))))
     1.6  
     1.7 +(defrecord TransposedGeometry [geometry]
     1.8 +  Geometry
     1.9 +  (width [_]
    1.10 +    (height geometry))
    1.11 +  (width [_ h]
    1.12 +    (height geometry h))
    1.13 +  (height [_]
    1.14 +    (width geometry))
    1.15 +  (height [_ w]
    1.16 +    (width geometry w))
    1.17 +  (anchor-x [_ h-align w]
    1.18 +    (anchor-y geometry
    1.19 +              (get {:left :top
    1.20 +                    :center :center
    1.21 +                    :right :bottom}
    1.22 +                   h-align)
    1.23 +              w))
    1.24 +  (anchor-y [_ v-align h]
    1.25 +    (anchor-x geometry
    1.26 +              (get {:top :left
    1.27 +                    :center :center
    1.28 +                    :bottom :right}
    1.29 +                   v-align)
    1.30 +              h)))
    1.31 +
    1.32  ;; (defn ^:private to-integer
    1.33  ;;   ^long [align x]
    1.34  ;;   (if (integer? x)
    1.35 @@ -560,19 +585,16 @@
    1.36    "Draws the View.  Location is relative to the view's anchor point
    1.37    for the specified alignment."
    1.38    ([view h-align v-align x y]
    1.39 -     (let [geom (geometry view)
    1.40 -           w (width geom)
    1.41 -           h (height geom)]
    1.42 -       (draw! view
    1.43 -              (- x (anchor-x geom h-align w))
    1.44 -              (- y (anchor-y geom v-align h))
    1.45 -              w h)))
    1.46 +     (draw-aligned! view (geometry view) h-align v-align x y))
    1.47 +  ([view geom h-align v-align x y]
    1.48 +     (draw-aligned! view geom h-align v-align x y (width geom) (height geom)))
    1.49    ([view h-align v-align x y w h]
    1.50 -     (let [geom (geometry view)]
    1.51 -       (draw! view
    1.52 -              (- x (anchor-x geom h-align w))
    1.53 -              (- y (anchor-y geom v-align h))
    1.54 -              w h))))
    1.55 +     (draw-aligned! view (geometry view) h-align v-align x y w h))
    1.56 +  ([view geom h-align v-align x y w h]
    1.57 +     (draw! view
    1.58 +            (- x (anchor-x geom h-align w))
    1.59 +            (- y (anchor-y geom v-align h))
    1.60 +            w h)))
    1.61  
    1.62  ;;
    1.63  ;; Event handling.
     2.1 --- a/src/indyvon/views.clj	Tue Nov 18 00:41:05 2014 +0300
     2.2 +++ b/src/indyvon/views.clj	Tue Nov 18 17:00:35 2014 +0300
     2.3 @@ -119,57 +119,51 @@
     2.4           (.fill *graphics* (Rectangle2D$Double. 0.0 0.0 *width* *height*)))
     2.5         (render! content))))
     2.6  
     2.7 -(defn hbox-proportional [& contents]
     2.8 -  (apply hbox* true contents))
     2.9 +(defrecord Box [proportional? translate-geometry contents]
    2.10 +  View
    2.11 +  (render! [_]
    2.12 +    (let [context-size (translate-geometry (->Size *width* *height*))
    2.13 +          dimxs (map (comp width translate-geometry geometry) contents)
    2.14 +          xs (cons 0 (reductions + dimxs))
    2.15 +          dimxs-sum (last xs)
    2.16 +          scale (if proportional? (/ (width context-size) dimxs-sum) 1)]
    2.17 +      (doseq [[c w x] (map vector contents dimxs xs)]
    2.18 +        (draw-aligned! c
    2.19 +                       (translate-geometry
    2.20 +                        (->FixedGeometry (- (* scale x)) 0
    2.21 +                                         (* scale w) (height context-size)))
    2.22 +                       :left :top
    2.23 +                       0 0))))
    2.24 +  (geometry [_]
    2.25 +    (translate-geometry
    2.26 +     (reduce #(->Size (+ (width %1) (width %2))
    2.27 +                      (max (height %1) (height %2)))
    2.28 +             (->Size 0 0)
    2.29 +             (map (comp translate-geometry geometry) contents)))))
    2.30 +
    2.31 +(defn- hbox* [proportional? contents]
    2.32 +  (->Box proportional? #'identity contents))
    2.33 +
    2.34 +(defn- vbox* [proportional? contents]
    2.35 +  (->Box proportional? #'->TransposedGeometry contents))
    2.36  
    2.37  (defn hbox
    2.38    "Creates a view that draws the specified content views placing them
    2.39    horizontally."
    2.40    [& contents]
    2.41 -  (apply hbox* false contents))
    2.42 +  (hbox* false contents))
    2.43  
    2.44 -(defn- hbox*
    2.45 -  [proportional? & contents]
    2.46 -  (reify
    2.47 -    View
    2.48 -    (render! [_]
    2.49 -      (let [widths (map #(width (geometry %)) contents)
    2.50 -            xs (cons 0 (reductions + widths))
    2.51 -            widths-sum (last xs)
    2.52 -            scale (if proportional? (/ *width* widths-sum) 1)]
    2.53 -        (doseq [[c w x] (map vector contents widths xs)]
    2.54 -          (draw! c (* scale x) 0 (* scale w) *height*))))
    2.55 -    (geometry [_]
    2.56 -      (reduce #(->Size (+ (width %1) (width %2))
    2.57 -                       (max (height %1) (height %2)))
    2.58 -              (->Size 0 0)
    2.59 -              (map geometry contents)))))
    2.60 -
    2.61 -(defn vbox-proportional [& contents]
    2.62 -  (apply vbox* true contents))
    2.63 +(defn hbox-proportional [& contents]
    2.64 +  (hbox* true contents))
    2.65  
    2.66  (defn vbox
    2.67    "Creates a view that draws the specified content views placing them
    2.68    horizontally."
    2.69    [& contents]
    2.70 -  (apply vbox* false contents))
    2.71 +  (vbox* false contents))
    2.72  
    2.73 -(defn vbox*
    2.74 -  [proportional? & contents]
    2.75 -  (reify
    2.76 -   View
    2.77 -   (render! [_]
    2.78 -     (let [heights (map #(height (geometry %)) contents)
    2.79 -           ys (cons 0 (reductions + heights))
    2.80 -           heights-sum (last ys)
    2.81 -           scale (if proportional? (/ *height* heights-sum) 1)]
    2.82 -       (doseq [[c h y] (map vector contents heights ys)]
    2.83 -         (draw! c 0 (* scale y) *width* (* scale h)))))
    2.84 -   (geometry [_]
    2.85 -     (reduce #(->Size (max (width %1) (width %2))
    2.86 -                      (+ (height %1) (height %2)))
    2.87 -             (->Size 0 0)
    2.88 -             (map geometry contents)))))
    2.89 +(defn vbox-proportional [& contents]
    2.90 +  (vbox* true contents))
    2.91  
    2.92  (defn- re-split [^java.util.regex.Pattern re s]
    2.93    (seq (.split re s)))