Correctly compute pref-dim of gadgets with baseline alignment

basis/ui/gadgets/gadgets.factor

@@ -196,11 +196,17 @@ GENERIC: baseline ( gadget -- y )
 
 M: gadget baseline pref-dim second ;
 
+: (baseline-align) ( baselines -- ys )
+    [ { } ] [ [ supremum ] keep [ - ] with map ] if-empty ;
+
 : baseline-align ( gadgets -- ys )
-    [ { } ] [
-        [ baseline ] map [ supremum ] keep
-        [ - ] with map
-    ] if-empty ;
+    [ baseline ] map (baseline-align) ;
+
+: (baseline-metrics) ( baselines sizes -- ascent descent )
+    { 0 0 } [ second over - 2array vmax ] 2reduce first2 ;
+
+: baseline-metrics ( children sizes -- ascent descent )
+    [ [ baseline ] map ] dip (baseline-metrics) ;
 
 GENERIC: layout* ( gadget -- )
 

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

@@ -1,8 +1,7 @@
+USING: ui.gadgets.packs ui.gadgets.packs.private ui.gadgets.labels
+ui.gadgets ui.gadgets.debug ui.render kernel namespaces tools.test
+math.parser sequences math.geometry.rect accessors ;
 IN: ui.gadgets.packs.tests
-USING: ui.gadgets.packs ui.gadgets.packs.private
-ui.gadgets.labels ui.gadgets ui.render
-kernel namespaces tools.test math.parser sequences math.geometry.rect
-accessors ;
 
 [ t ] [
     { 0 0 } { 100 100 } <rect> clip set
@@ -21,15 +20,6 @@ accessors ;
     orient
 ] unit-test
 
-TUPLE: baseline-gadget < gadget baseline ;
-
-M: baseline-gadget baseline baseline>> ;
-
-: <baseline-gadget> ( baseline dim -- gadget )
-    baseline-gadget new-gadget
-    swap >>dim
-    swap >>baseline ;
-
 <shelf> +baseline+ >>align
     5 { 10 10 } <baseline-gadget> add-gadget
     10 { 10 10 } <baseline-gadget> add-gadget

basis/ui/gadgets/packs/packs.factor

@@ -61,11 +61,15 @@ PRIVATE>
 
 <PRIVATE
 
-: gap-dims ( gadget sizes -- seeq )
+: gap-dims ( pack sizes -- seeq )
     [ gap>> ] [ [ length 1 [-] ] [ dim-sum ] bi ] bi* [ v*n ] dip v+ ;
 
-: pack-pref-dim ( gadget sizes -- dim )
-    [ nip max-dim ] [ gap-dims ] [ drop orientation>> ] 2tri set-axis ;
+: max-pack-dim ( pack sizes -- dim )
+    over align>> +baseline+ eq?
+    [ [ children>> ] dip baseline-metrics + 0 swap 2array ] [ nip max-dim ] if ;
+
+: pack-pref-dim ( pack sizes -- dim )
+    [ max-pack-dim ] [ gap-dims ] [ drop orientation>> ] 2tri set-axis ;
 
 M: pack pref-dim*
     dup children>> pref-dims pack-pref-dim ;

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

@@ -1,6 +1,7 @@
 IN: ui.gadgets.paragraphs.tests
 USING: ui.gadgets.paragraphs ui.gadgets.paragraphs.private
-ui.gadgets accessors tools.test namespaces sequences kernel ;
+ui.gadgets ui.gadgets.debug accessors tools.test namespaces
+sequences kernel ;
 
 TUPLE: fake-break < gadget ;
 
@@ -16,7 +17,7 @@ INSTANCE: fake-break word-break
 <gadget> { 50 20 } >>dim dup "c" set add-gadget
 "p" set
 
-[ { 4 1 } ] [ "p" get wrap-paragraph [ length ] map ] unit-test
+[ { 4 1 } ] [ "p" get wrap-paragraph [ words>> length ] map ] unit-test
 
 [ { 85 50 } ] [ "p" get pref-dim ] unit-test
 
@@ -28,4 +29,24 @@ INSTANCE: fake-break word-break
 
 [ { 45 15 } ] [ "b" get loc>> ] unit-test
 
-[ { 0 30 } ] [ "c" get loc>> ] unit-test
+[ { 0 30 } ] [ "c" get loc>> ] unit-test
+
+100 <paragraph>
+15 { 40 30 } <baseline-gadget> dup "a" set add-gadget
+<fake-break> add-gadget
+10 { 40 30 } <baseline-gadget> dup "b" set add-gadget
+<fake-break> add-gadget
+20 { 40 30 } <baseline-gadget> dup "c" set add-gadget
+"p" set
+
+[ { 85 65 } ] [ "p" get pref-dim ] unit-test
+
+[ ] [ "p" get prefer ] unit-test
+
+[ ] [ "p" get layout ] unit-test
+
+[ { 0 0 } ] [ "a" get loc>> ] unit-test
+
+[ { 45 5 } ] [ "b" get loc>> ] unit-test
+
+[ { 0 35 } ] [ "c" get loc>> ] unit-test

basis/ui/gadgets/paragraphs/paragraphs.factor

@@ -29,17 +29,23 @@ TUPLE: paragraph < gadget margin ;
 : gadget>word ( gadget -- word )
     [ ] [ pref-dim first ] [ word-break? ] tri <word> ;
 
+TUPLE: line words ascent descent ;
+
+: <line> ( words -- line )
+    dup [ key>> ] map dup pref-dims baseline-metrics line boa ;
+
 : wrap-paragraph ( paragraph -- wrapped-paragraph )
-    [ children>> [ gadget>word ] map ] [ margin>> ] bi wrap ;
+    [ children>> [ gadget>word ] map ] [ margin>> ] bi wrap
+    [ <line> ] map ;
 
 : line-width ( wrapped-line -- n )
     [ break?>> ] trim-tail-slice [ width>> ] sigma ;
 
 : max-line-width ( wrapped-paragraph -- x )
-    [ line-width ] [ max ] map-reduce ;
+    [ words>> line-width ] [ max ] map-reduce ;
 
 : line-height ( wrapped-line -- ys )
-    [ key>> pref-dim second ] [ max ] map-reduce ;
+    [ ascent>> ] [ descent>> ] bi + ;
 
 : sum-line-heights ( wrapped-paragraph -- y )
     [ line-height ] sigma ;
@@ -58,6 +64,7 @@ M: paragraph pref-dim*
 
 : layout-line ( wrapped-line y -- )
     [
+        words>>
         [ ]
         [ word-x-coordinates ]
         [ [ key>> ] map baseline-align ] tri