Fix baseline alignment to work like align=1/2 if there is no text in the layout,...

diff --git a/basis/ui/baseline-alignment/baseline-alignment.factor b/basis/ui/baseline-alignment/baseline-alignment.factor
index e02c6188f5ccd1c0c284f8614ab564c4ba651c6c..1cdaf760dc22ba221feff99beee924317405daed 100644 (file)
--- a/basis/ui/baseline-alignment/baseline-alignment.factor
+++ b/basis/ui/baseline-alignment/baseline-alignment.factor
@@ -24,35 +24,47 @@ TUPLE: gadget-metrics height ascent descent cap-height ;
     [ dup [ 2dup - ] [ f ] if ] dip
     gadget-metrics boa ; inline
 
+: ?supremum ( seq -- n/f )
+    sift [ f ] [ supremum ] if-empty ;
+
 : max-ascent ( seq -- n )
-    0 [ ascent>> [ max ] when* ] reduce ; inline
+    [ ascent>> ] map ?supremum ;
 
 : max-cap-height ( seq -- n )
-    0 [ cap-height>> [ max ] when* ] reduce ; inline
+    [ cap-height>> ] map ?supremum ;
 
 : max-descent ( seq -- n )
-    0 [ descent>> [ max ] when* ] reduce ; inline
+    [ descent>> ] map ?supremum ;
 
 : max-text-height ( seq -- y )
-    0 [ [ height>> ] [ ascent>> ] bi [ max ] [ drop ] if ] reduce ;
+    [ ascent>> ] filter [ height>> ] map ?supremum ;
 
 : max-graphics-height ( seq -- y )
-    0 [ [ height>> ] [ ascent>> ] bi [ drop ] [ max ] if ] reduce ;
-
-: (align-baselines) ( y max leading -- y' ) [ swap - ] dip + ;
+    [ ascent>> not ] filter [ height>> ] map ?supremum 0 or ;
 
 :: combine-metrics ( graphics-height ascent descent cap-height -- ascent' descent' )
-    cap-height 2 / :> mid-line 
-    graphics-height 2 /
-    [ ascent mid-line - max mid-line + >integer ]
-    [ descent mid-line + max mid-line - >integer ] bi ;
+    ascent [
+        cap-height 2 / :> mid-line 
+        graphics-height 2 /
+        [ ascent mid-line - max mid-line + >integer ]
+        [ descent mid-line + max mid-line - >integer ] bi
+    ] [ f f ] if ;
+
+: (measure-metrics) ( children sizes -- graphics-height ascent descent cap-height )
+    [ <gadget-metrics> ] 2map
+    {
+        [ max-graphics-height ]
+        [ max-ascent ]
+        [ max-descent ]
+        [ max-cap-height ]
+    } cleave ;
 
 PRIVATE>
 
 :: align-baselines ( gadgets -- ys )
     gadgets [ dup pref-dim <gadget-metrics> ] map
-    dup max-ascent :> max-ascent
-    dup max-cap-height :> max-cap-height
+    dup max-ascent 0 or :> max-ascent
+    dup max-cap-height 0 or :> max-cap-height
     dup max-graphics-height :> max-graphics-height
     
     max-cap-height max-graphics-height + 2 /i :> critical-line
@@ -61,20 +73,12 @@ PRIVATE>
 
     [
         dup ascent>>
-        [ ascent>> max-ascent text-leading ]
-        [ height>> max-graphics-height graphics-leading ] if
-        (align-baselines)
+        [ ascent>> max-ascent swap - text-leading ]
+        [ height>> max-graphics-height swap - 2/ graphics-leading ] if +
     ] map ;
 
 : measure-metrics ( children sizes -- ascent descent )
-    [ <gadget-metrics> ] 2map
-    {
-        [ max-graphics-height ]
-        [ max-ascent ]
-        [ max-descent ]
-        [ max-cap-height ]
-    } cleave
-    combine-metrics ;
+    (measure-metrics) combine-metrics ;
 
 : measure-height ( children sizes -- height )
-    measure-metrics + ;
\ No newline at end of file
+    (measure-metrics) dup [ combine-metrics + ] [ 3drop ] if ;
\ No newline at end of file

diff --git a/basis/ui/gadgets/packs/packs-tests.factor b/basis/ui/gadgets/packs/packs-tests.factor
index cae7d12dc3feae0396edfaafcae67ecb2859de3f..153579643dac52f28df0a655104b2ac603d487f4 100644 (file)
--- a/basis/ui/gadgets/packs/packs-tests.factor
+++ b/basis/ui/gadgets/packs/packs-tests.factor
@@ -90,4 +90,43 @@ IN: ui.gadgets.packs.tests
 
 [ ] [ "g" get prefer ] unit-test
 
-[ ] [ "g" get layout ] unit-test
\ No newline at end of file
+[ ] [ "g" get layout ] unit-test
+
+! Baseline alignment without any text gadgets should behave like align=1/2
+<shelf> +baseline+ >>align
+    <gadget> { 30 30 } >>dim add-gadget
+    <gadget> { 30 20 } >>dim add-gadget
+"g" set
+
+[ { 60 30 } ] [ "g" get pref-dim ] unit-test
+
+[ ] [ "g" get prefer ] unit-test
+
+[ ] [ "g" get layout ] unit-test
+
+[ V{ { 0 0 } { 30 5 } } ]
+[ "g" get children>> [ loc>> ] map ] unit-test
+
+<shelf> +baseline+ >>align
+<gadget> { 30 30 } >>dim add-gadget
+10 10 { 10 10 } <baseline-gadget> add-gadget
+"g" set
+
+[ ] [ "g" get prefer ] unit-test
+
+[ ] [ "g" get layout ] unit-test
+
+[ V{ { 0 0 } { 30 10 } } ]
+[ "g" get children>> [ loc>> ] map ] unit-test
+
+<shelf> +baseline+ >>align
+<shelf> <gadget> { 30 30 } >>dim add-gadget add-gadget
+10 10 { 10 10 } <baseline-gadget> add-gadget
+"g" set
+
+[ ] [ "g" get prefer ] unit-test
+
+[ ] [ "g" get layout ] unit-test
+
+[ V{ { 0 0 } { 30 10 } } ]
+[ "g" get children>> [ loc>> ] map ] unit-test
\ No newline at end of file

diff --git a/basis/ui/gadgets/packs/packs.factor b/basis/ui/gadgets/packs/packs.factor
index 95f04dfe4dc13c1f29c8839a6e7848503fa52aa8..f47b374aeb30aad2559ff958d63b5bc92ef12866 100644 (file)
--- a/basis/ui/gadgets/packs/packs.factor
+++ b/basis/ui/gadgets/packs/packs.factor
@@ -1,8 +1,8 @@
 ! Copyright (C) 2005, 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: sequences ui.gadgets ui.baseline-alignment kernel math
-math.functions math.vectors math.order math.rectangles namespaces
-accessors fry combinators arrays ;
+USING: sequences ui.gadgets ui.baseline-alignment
+ui.baseline-alignment.private kernel math math.functions math.vectors
+math.order math.rectangles namespaces accessors fry combinators arrays ;
 IN: ui.gadgets.packs
 
 TUPLE: pack < gadget
@@ -84,8 +84,7 @@ M: pack pref-dim*
     children>> dup pref-dims measure-metrics drop ;
 
 : pack-cap-height ( pack -- n )
-    children>> [ cap-height ] map sift
-    [ f ] [ supremum ] if-empty ;
+    children>> [ cap-height ] map ?supremum ;
 
 PRIVATE>