New baseline alignment algorithm uses cap-height/2 as graphics baseline instead of ascent/2

basis/ui/baseline-alignment/baseline-alignment-tests.factor

@@ -5,12 +5,13 @@ ui.baseline-alignment ui.baseline-alignment.private ;
 IN: ui.baseline-alignment.tests
 
 ! Test baseline calculations
-[ 10 ] [ 0 10 0 combine-metrics + ] unit-test
+[ 10 0 ] [ 0 10 0 10 combine-metrics ] unit-test
-[ 15 ] [ 0 10 5 combine-metrics + ] unit-test
+[ 10 5 ] [ 0 10 5 10 combine-metrics ] unit-test
-[ 30 ] [ 30 0 0 combine-metrics + ] unit-test
+[ 15 15 ] [ 30 0 0 0 combine-metrics ] unit-test
-[ 35 ] [ 10 0 30 combine-metrics + ] unit-test
+[ 5 30 ] [ 10 0 30 0 combine-metrics ] unit-test
-[ 20 ] [ 5 10 10 combine-metrics + ] unit-test
+[ 10 10 ] [ 5 10 10 10 combine-metrics ] unit-test
-[ 20 ] [ 20 10 0 combine-metrics + ] unit-test
+[ 15 5 ] [ 20 10 0 10 combine-metrics ] unit-test
-[ 55 ] [ 20 10 40 combine-metrics + ] unit-test
+[ 15 40 ] [ 20 10 40 10 combine-metrics ] unit-test
+[ 12 3 ] [ 0 12 3 9 combine-metrics ] unit-test
 
 [ t ] [ \ baseline \ cap-height [ order ] bi@ set= ] unit-test 

basis/ui/baseline-alignment/baseline-alignment.factor

@@ -1,7 +1,7 @@
 ! Copyright (C) 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: arrays kernel locals math math.order math.vectors
-sequences ui.gadgets accessors ;
+sequences ui.gadgets accessors combinators ;
 IN: ui.baseline-alignment
 
 SYMBOL: +baseline+
@@ -27,6 +27,9 @@ TUPLE: gadget-metrics height ascent descent cap-height ;
 : max-ascent ( seq -- n )
     0 [ ascent>> [ max ] when* ] reduce ; inline
 
+: max-cap-height ( seq -- n )
+    0 [ cap-height>> [ max ] when* ] reduce ; inline
+
 : max-descent ( seq -- n )
     0 [ descent>> [ max ] when* ] reduce ; inline
 
@@ -36,32 +39,41 @@ TUPLE: gadget-metrics height ascent descent cap-height ;
 : max-graphics-height ( seq -- y )
     0 [ [ height>> ] [ ascent>> ] bi [ drop ] [ max ] if ] reduce ;
 
-: combine-metrics ( graphics-height ascent descent -- ascent' descent' )
+: (align-baselines) ( y max leading -- y' ) [ swap - ] dip + ;
-    [ [ [-] 2 /i ] keep ] dip [ + ] [ max ] bi-curry* bi ;
+
+:: 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 ;
 
 PRIVATE>
 
 :: align-baselines ( gadgets -- ys )
     gadgets [ dup pref-dim <gadget-metrics> ] map
     dup max-ascent :> max-ascent
-    dup max-graphics-height :> max-height
+    dup max-cap-height :> max-cap-height
-    max-height max-ascent [-] 2 /i :> offset-text
+    dup max-graphics-height :> max-graphics-height
-    max-ascent max-height [-] 2 /i :> offset-graphics
+    
+    max-cap-height max-graphics-height + 2 /i :> critical-line
+    critical-line max-ascent [-] :> text-leading
+    max-ascent critical-line [-] :> graphics-leading
+
     [
-        dup ascent>> [
+        dup ascent>>
-            ascent>>
+        [ ascent>> max-ascent text-leading ]
-            max-ascent
+        [ height>> max-graphics-height graphics-leading ] if
-            offset-text
+        (align-baselines)
-        ] [
-            height>>
-            max-height
-            offset-graphics
-        ] if [ swap - ] dip +
     ] map ;
 
 : measure-metrics ( children sizes -- ascent descent )
     [ <gadget-metrics> ] 2map
-    [ max-graphics-height ] [ max-ascent ] [ max-descent ] tri
+    {
+        [ max-graphics-height ]
+        [ max-ascent ]
+        [ max-descent ]
+        [ max-cap-height ]
+    } cleave
     combine-metrics ;
 
 : measure-height ( children sizes -- height )

basis/ui/gadgets/debug/debug.factor

@@ -4,15 +4,16 @@ USING: kernel accessors sequences ui ui.gadgets ui.gadgets.buttons
 ui.baseline-alignment ui.render ;
 IN: ui.gadgets.debug
 
-TUPLE: baseline-gadget < gadget baseline ;
+TUPLE: baseline-gadget < gadget baseline cap-height ;
 
 M: baseline-gadget baseline baseline>> ;
 
-M: baseline-gadget cap-height dim>> second ;
+M: baseline-gadget cap-height cap-height>> ;
 
-: <baseline-gadget> ( baseline dim -- gadget )
+: <baseline-gadget> ( baseline cap-height dim -- gadget )
     baseline-gadget new
         swap >>dim
+        swap >>cap-height
         swap >>baseline ;
 
 ! An intentionally broken gadget -- used to test UI error handling,

basis/ui/gadgets/grids/grids-tests.factor

@@ -71,8 +71,8 @@ IN: ui.gadgets.grids.tests
 [ { 10 230 } ] [ "c" get loc>> ] unit-test
 [ { 100 100 } ] [ "c" get dim>> ] unit-test
 
-5 { 10 10 } <baseline-gadget>
+5 10 { 10 10 } <baseline-gadget>
-10 { 10 10 } <baseline-gadget> 2array
+10 10 { 10 10 } <baseline-gadget> 2array
 1array <grid> f >>fill?
 "g" set
 

basis/ui/gadgets/packs/packs-tests.factor

@@ -23,8 +23,8 @@ IN: ui.gadgets.packs.tests
 
 ! Test baseline alignment
 <shelf> +baseline+ >>align
-    5 { 10 10 } <baseline-gadget> add-gadget
+    5 5 { 10 10 } <baseline-gadget> add-gadget
-    10 { 10 10 } <baseline-gadget> add-gadget
+    10 10 { 10 10 } <baseline-gadget> add-gadget
 "g" set
 
 [ ] [ "g" get prefer ] unit-test
@@ -40,7 +40,7 @@ IN: ui.gadgets.packs.tests
 ! Test mixed baseline and ordinary alignment
 <shelf> +baseline+ >>align
     <gadget> { 20 20 } >>dim add-gadget
-    10 { 10 10 } <baseline-gadget> add-gadget
+    10 10 { 10 10 } <baseline-gadget> add-gadget
 "g" set
 
 [ { 30 20 } ] [ "g" get pref-dim ] unit-test
@@ -53,11 +53,13 @@ IN: ui.gadgets.packs.tests
 
 <shelf> +baseline+ >>align
     <gadget> { 15 15 } >>dim add-gadget
-    5 { 10 10 } <baseline-gadget> add-gadget
+    5 5 { 10 10 } <baseline-gadget> add-gadget
 "g" set
 
 [ { 25 15 } ] [ "g" get pref-dim ] unit-test
 
+[ ] [ "g" get prefer ] unit-test
+
 [ ] [ "g" get layout ] unit-test
 
 [ V{ { 0 0 } { 15 5 } } ] [
@@ -66,13 +68,26 @@ IN: ui.gadgets.packs.tests
 
 <shelf> +baseline+ >>align
     <gadget> { 20 20 } >>dim add-gadget
-    30 { 10 50 } <baseline-gadget> add-gadget
+    30 30 { 10 50 } <baseline-gadget> add-gadget
 "g" set
 
 [ { 30 50 } ] [ "g" get pref-dim ] unit-test
 
+[ ] [ "g" get prefer ] unit-test
+
 [ ] [ "g" get layout ] unit-test
 
 [ V{ { 0 5 } { 20 0 } } ] [
     "g" get children>> [ loc>> ] map
 ] unit-test
+
+<shelf> +baseline+ >>align
+    <gadget> { 30 30 } >>dim add-gadget
+    30 4 { 30 30 } <baseline-gadget> add-gadget
+"g" set
+
+[ { 60 43 } ] [ "g" get pref-dim ] unit-test
+
+[ ] [ "g" get prefer ] unit-test
+
+[ ] [ "g" get layout ] unit-test

basis/ui/gadgets/packs/packs.factor

@@ -84,7 +84,8 @@ M: pack pref-dim*
     children>> dup pref-dims measure-metrics drop ;
 
 : pack-cap-height ( pack -- n )
-    children>> [ f ] [ first cap-height ] if-empty ;
+    children>> [ cap-height ] map sift
+    [ f ] [ supremum ] if-empty ;
 
 PRIVATE>
 

basis/ui/gadgets/paragraphs/paragraphs-tests.factor

@@ -32,11 +32,11 @@ INSTANCE: fake-break word-break
 [ { 0 30 } ] [ "c" get loc>> ] unit-test
 
 100 <paragraph>
-15 { 40 30 } <baseline-gadget> dup "a" set add-gadget
+15 15 { 40 30 } <baseline-gadget> dup "a" set add-gadget
 <fake-break> add-gadget
-10 { 40 30 } <baseline-gadget> dup "b" set add-gadget
+10 10 { 40 30 } <baseline-gadget> dup "b" set add-gadget
 <fake-break> add-gadget
-20 { 40 30 } <baseline-gadget> dup "c" set add-gadget
+20 20 { 40 30 } <baseline-gadget> dup "c" set add-gadget
 "p" set
 
 [ { 85 65 } ] [ "p" get pref-dim ] unit-test