1 ! Copyright (C) 2006, 2008 Slava Pestov.
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: arrays kernel math namespaces sequences words io
4 io.streams.string math.vectors ui.gadgets columns accessors
10 { gap initial: { 0 0 } }
11 { fill? initial: t } ;
13 : new-grid ( children class -- grid )
15 [ (>>grid) ] [ >r concat r> swap add-gadgets drop ] [ nip ] 2tri ;
18 : <grid> ( children -- grid )
21 : grid-child ( grid i j -- gadget ) rot grid>> nth nth ;
23 : grid-add ( grid child i j -- grid )
25 >r >r 2dup swap add-gadget drop r> r>
26 3dup grid-child unparent rot grid>> nth set-nth ;
28 : grid-remove ( grid i j -- grid ) <gadget> -rot grid-add ;
30 : pref-dim-grid ( grid -- dims )
31 grid>> [ [ pref-dim ] map ] map ;
33 : (compute-grid) ( grid -- seq ) [ max-dim ] map ;
35 : compute-grid ( grid -- horiz vert )
36 pref-dim-grid dup flip (compute-grid) swap (compute-grid) ;
38 : (pair-up) ( horiz vert -- dim )
39 >r first r> second 2array ;
41 : pair-up ( horiz vert -- dims )
42 [ [ (pair-up) ] curry map ] with map ;
44 : add-gaps ( gap seq -- newseq )
47 : gap-sum ( gap seq -- newseq )
48 dupd add-gaps dim-sum v+ ;
51 dup gap>> swap compute-grid >r over r>
52 gap-sum >r gap-sum r> (pair-up) ;
54 : do-grid ( dims grid quot -- )
56 [ [ pick call ] 2each ] 2each
59 : grid-positions ( grid dims -- locs )
60 >r gap>> dup r> add-gaps swap [ v+ ] accumulate nip ;
62 : position-grid ( grid horiz vert -- )
64 >r over r> grid-positions >r grid-positions r>
65 pair-up r> [ (>>loc) ] do-grid ;
67 : resize-grid ( grid horiz vert -- )
69 pair-up swap [ (>>dim) ] do-grid
71 2drop grid>> [ [ prefer ] each ] each
74 : grid-layout ( grid horiz vert -- )
75 [ position-grid ] 3keep resize-grid ;
77 M: grid layout* dup compute-grid grid-layout ;
79 M: grid children-on ( rect gadget -- seq )
84 [ 0 <column> fast-children-on ] keep
91 [ [ gadget-text ] map ] map format-table
92 [ CHAR: \n , ] [ % ] interleave ;