diff --git a/basis/ui/baseline-alignment/baseline-alignment-tests.factor b/basis/ui/baseline-alignment/baseline-alignment-tests.factor
index ab749e56f0..6ad47c9d1b 100644
--- a/basis/ui/baseline-alignment/baseline-alignment-tests.factor
+++ b/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
-[ 15 ] [ 0 10 5 combine-metrics + ] unit-test
-[ 30 ] [ 30 0 0 combine-metrics + ] unit-test
-[ 35 ] [ 10 0 30 combine-metrics + ] unit-test
-[ 20 ] [ 5 10 10 combine-metrics + ] unit-test
-[ 20 ] [ 20 10 0 combine-metrics + ] unit-test
-[ 55 ] [ 20 10 40 combine-metrics + ] unit-test
+[ 10 0 ] [ 0 10 0 10 combine-metrics ] unit-test
+[ 10 5 ] [ 0 10 5 10 combine-metrics ] unit-test
+[ 15 15 ] [ 30 0 0 0 combine-metrics ] unit-test
+[ 5 30 ] [ 10 0 30 0 combine-metrics ] unit-test
+[ 10 10 ] [ 5 10 10 10 combine-metrics ] unit-test
+[ 15 5 ] [ 20 10 0 10 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
\ No newline at end of file
diff --git a/basis/ui/baseline-alignment/baseline-alignment.factor b/basis/ui/baseline-alignment/baseline-alignment.factor
index f9dec64e82..e02c6188f5 100644
--- a/basis/ui/baseline-alignment/baseline-alignment.factor
+++ b/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' )
- [ [ [-] 2 /i ] keep ] dip [ + ] [ max ] bi-curry* bi ;
+: (align-baselines) ( y max leading -- y' ) [ swap - ] dip + ;
+
+:: 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
- max-height max-ascent [-] 2 /i :> offset-text
- max-ascent max-height [-] 2 /i :> offset-graphics
+ dup max-cap-height :> max-cap-height
+ dup max-graphics-height :> max-graphics-height
+
+ max-cap-height max-graphics-height + 2 /i :> critical-line
+ critical-line max-ascent [-] :> text-leading
+ max-ascent critical-line [-] :> graphics-leading
+
[
- dup ascent>> [
- ascent>>
- max-ascent
- offset-text
- ] [
- height>>
- max-height
- offset-graphics
- ] if [ swap - ] dip +
+ dup ascent>>
+ [ ascent>> max-ascent text-leading ]
+ [ height>> max-graphics-height graphics-leading ] if
+ (align-baselines)
] 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 )
diff --git a/basis/ui/gadgets/debug/debug.factor b/basis/ui/gadgets/debug/debug.factor
index 800fdc850e..d5b4930a0b 100644
--- a/basis/ui/gadgets/debug/debug.factor
+++ b/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,
diff --git a/basis/ui/gadgets/grids/grids-tests.factor b/basis/ui/gadgets/grids/grids-tests.factor
index 852d63c346..fb92cd2ac6 100644
--- a/basis/ui/gadgets/grids/grids-tests.factor
+++ b/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>
-10 { 10 10 } <baseline-gadget> 2array
+5 10 { 10 10 } <baseline-gadget>
+10 10 { 10 10 } <baseline-gadget> 2array
1array <grid> f >>fill?
"g" set
diff --git a/basis/ui/gadgets/packs/packs-tests.factor b/basis/ui/gadgets/packs/packs-tests.factor
index cf95380de2..cae7d12dc3 100644
--- a/basis/ui/gadgets/packs/packs-tests.factor
+++ b/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
- 10 { 10 10 } <baseline-gadget> add-gadget
+ 5 5 { 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
\ No newline at end of file
+] 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
\ No newline at end of file
diff --git a/basis/ui/gadgets/packs/packs.factor b/basis/ui/gadgets/packs/packs.factor
index 2176b63b76..95f04dfe4d 100644
--- a/basis/ui/gadgets/packs/packs.factor
+++ b/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>
diff --git a/basis/ui/gadgets/paragraphs/paragraphs-tests.factor b/basis/ui/gadgets/paragraphs/paragraphs-tests.factor
index 0a759ab11d..fcc121e584 100644
--- a/basis/ui/gadgets/paragraphs/paragraphs-tests.factor
+++ b/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