Grid layout now respects baselines when fill attribute is off

Paragraph gadgets now compute a baseline

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

@@ -1,10 +1,14 @@
 USING: ui.gadgets ui.gadgets.grids tools.test kernel arrays
-namespaces math.geometry.rect accessors ;
+namespaces math.geometry.rect accessors ui.gadgets.grids.private
+ui.gadgets.debug sequences ;
 IN: ui.gadgets.grids.tests
 
+[ { { { 1 "a" } { 1 "b" } } { { 2 "a" } { 2 "b" } } } ]
+[ { 1 2 } { "a" "b" } cross-zip ] unit-test
+
 [ { 0 0 } ] [ { } <grid> pref-dim ] unit-test
 
-: 100x100 <gadget> { 100 100 } >>dim ;
+: 100x100 ( -- gadget ) <gadget> { 100 100 } >>dim ;
 
 [ { 100 100 } ] [
     100x100
@@ -45,3 +49,39 @@ IN: ui.gadgets.grids.tests
     "a" get rect-dim
     "b" get rect-dim
 ] unit-test
+
+[ ] [
+    100x100 dup "a" set
+    100x100 dup "b" set
+    100x100 dup "c" set
+    [ 1array ] tri@ 3array
+    <grid>
+    { 10 10 } >>gap "g" set
+] unit-test
+
+[ ] [ "g" get prefer ] unit-test
+[ ] [ "g" get layout ] unit-test
+
+[ { 10 10 } ] [ "a" get loc>> ] unit-test
+[ { 100 100 } ] [ "a" get dim>> ] unit-test
+
+[ { 10 120 } ] [ "b" get loc>> ] unit-test
+[ { 100 100 } ] [ "b" get dim>> ] unit-test
+
+[ { 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
+1array <grid> f >>fill?
+"g" set
+
+[ ] [ "g" get prefer ] unit-test
+
+[ { 20 15 } ] [ "g" get dim>> ] unit-test
+
+[ V{ { 0 5 } { 10 0 } } ] [
+    "g" get
+    dup layout
+    children>> [ loc>> ] map
+] unit-test

basis/ui/gadgets/grids/grids.factor

@@ -1,6 +1,6 @@
 ! Copyright (C) 2006, 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: arrays kernel math namespaces make sequences words io
+USING: arrays kernel math math.order namespaces make sequences words io
 math.vectors ui.gadgets columns accessors strings.tables
 math.geometry.rect locals fry ;
 IN: ui.gadgets.grids
@@ -8,8 +8,7 @@ IN: ui.gadgets.grids
 TUPLE: grid < gadget
 grid
 { gap initial: { 0 0 } }
-{ fill? initial: t }
+{ fill? initial: t } ;
-align ;
 
 : new-grid ( children class -- grid )
     new-gadget
@@ -27,50 +26,82 @@ align ;
 
 : grid-remove ( grid i j -- grid ) [ <gadget> ] 2dip grid-add ;
 
-: pref-dim-grid ( grid -- dims )
+<PRIVATE
-    grid>> [ [ pref-dim ] map ] map ;
 
-: (compute-grid) ( grid -- seq ) [ max-dim ] map ;
+: cross-zip ( seq1 seq2 -- seq1xseq2 )
+    [ [ 2array ] with map ] curry map ;
 
-: compute-grid ( grid -- horiz vert )
+TUPLE: cell pref-dim baseline ;
-    pref-dim-grid [ flip (compute-grid) ] [ (compute-grid) ] bi ;
 
-: (pair-up) ( horiz vert -- dim )
+: <cell> ( gadget -- cell ) [ pref-dim ] [ baseline ] bi cell boa ;
-    [ first ] [ second ] bi* 2array ;
 
-: pair-up ( horiz vert -- dims )
+M: cell baseline baseline>> ;
-    [ [ (pair-up) ] curry map ] with map ;
 
-: add-gaps ( gap seq -- newseq )
+TUPLE: grid-layout grid gap fill? row-heights column-widths ;
-    [ v+ ] with map ;
 
-: gap-sum ( gap seq -- newseq )
+: iterate-cell-dims ( cells quot -- seq )
-    dupd add-gaps dim-sum v+ ;
+    '[ [ pref-dim>> @ ] [ max ] map-reduce ] map ; inline
+
+: row-heights ( grid-layout -- heights )
+    [ grid>> ] [ fill?>> ] bi
+    [ [ second ] iterate-cell-dims ]
+    [ [ dup [ pref-dim>> ] map baseline-metrics + ] map ]
+    if ;
+
+: column-widths ( grid-layout -- widths )
+    grid>> flip [ first ] iterate-cell-dims ;
+
+: <grid-layout> ( grid -- grid-layout )
+    grid-layout new
+        swap
+        [ grid>> [ [ <cell> ] map ] map >>grid ]
+        [ fill?>> >>fill? ]
+        [ gap>> >>gap ]
+        tri
+        dup row-heights >>row-heights
+        dup column-widths >>column-widths ;
+
+: accumulate-cell-dims ( seq gap -- n ns )
+    dup '[ + _ + ] accumulate ;
+
+: accumulate-cell-xs ( grid-layout -- x xs )
+    [ column-widths>> ] [ gap>> first ] bi
+    accumulate-cell-dims ;
+
+: accumulate-cell-ys ( grid-layout -- y ys )
+    [ row-heights>> ] [ gap>> second ] bi
+    accumulate-cell-dims ;
 
 M: grid pref-dim*
-    [ gap>> ] [ compute-grid [ gap-sum ] bi-curry@ ] bi bi (pair-up) ;
+    <grid-layout>
+    [ accumulate-cell-xs drop ]
+    [ accumulate-cell-ys drop ]
+    bi 2array ;
 
-: do-grid ( dims grid quot -- )
+: (compute-cell-locs) ( grid-layout -- locs )
-    [ grid>> ] dip '[ _ 2each ] 2each ; inline
+    [ accumulate-cell-xs nip ]
+    [ accumulate-cell-ys nip ]
+    bi cross-zip flip ;
 
-: grid-positions ( grid dims -- locs )
+: adjust-for-baseline ( row-locs row-cells -- row-locs' )
-    [ gap>> dup ] dip add-gaps swap [ v+ ] accumulate nip ;
+    baseline-align [ 0 swap 2array v+ ] 2map ;
 
-: position-grid ( grid horiz vert -- )
+: cell-locs ( grid-layout -- locs )
-    pick [ [ grid-positions ] bi-curry@ bi pair-up ] dip
+    dup fill?>>
-    [ (>>loc) ] do-grid ;
+    [ (compute-cell-locs) ] [
-
+        [ (compute-cell-locs) ] [ grid>> ] bi
-: resize-grid ( grid horiz vert -- )
+        [ adjust-for-baseline ] 2map
-    pick fill?>> [
-        pair-up swap [ (>>dim) ] do-grid
-    ] [
-        2drop grid>> [ [ prefer ] each ] each
     ] if ;
 
-: grid-layout ( grid horiz vert -- )
+: cell-dims ( grid-layout -- dims )
-    [ position-grid ] [ resize-grid ] 3bi ;
+    dup fill?>>
+    [ [ column-widths>> ] [ row-heights>> ] bi cross-zip flip ]
+    [ grid>> [ [ pref-dim>> ] map ] map ]
+    if ;
 
-M: grid layout* dup compute-grid grid-layout ;
+M: grid layout*
+    [ grid>> ] [ <grid-layout> [ cell-locs ] [ cell-dims ] bi ] bi
+    [ [ [ >>loc ] [ >>dim ] bi* drop ] 3each ] 3each ;
 
 M: grid children-on ( rect gadget -- seq )
     dup children>> empty? [ 2drop f ] [
@@ -83,3 +114,5 @@ M: grid gadget-text*
     grid>>
     [ [ gadget-text ] map ] map format-table
     [ CHAR: \n , ] [ % ] interleave ;
+
+PRIVATE>

basis/ui/gadgets/paragraphs/paragraphs.factor

@@ -74,4 +74,9 @@ M: paragraph layout*
     wrap-paragraph dup line-y-coordinates
     [ layout-line ] 2each ;
 
+M: paragraph baseline
+    children>> [ 0 ] [
+        first [ loc>> second ] [ baseline ] bi +
+    ] if-empty ;
+
 PRIVATE>