90 lines
2.3 KiB
Factor
90 lines
2.3 KiB
Factor
! Copyright (C) 2006, 2008 Slava Pestov.
|
|
! See http://factorcode.org/license.txt for BSD license.
|
|
USING: arrays kernel math namespaces make sequences words io
|
|
io.streams.string math.vectors ui.gadgets columns accessors
|
|
math.geometry.rect locals fry ;
|
|
IN: ui.gadgets.grids
|
|
|
|
TUPLE: grid < gadget
|
|
grid
|
|
{ gap initial: { 0 0 } }
|
|
{ fill? initial: t } ;
|
|
|
|
: new-grid ( children class -- grid )
|
|
new-gadget
|
|
swap >>grid
|
|
dup grid>> concat add-gadgets ; inline
|
|
|
|
: <grid> ( children -- grid )
|
|
grid new-grid ;
|
|
|
|
:: grid-child ( grid i j -- gadget ) i j grid grid>> nth nth ;
|
|
|
|
:: grid-add ( grid child i j -- grid )
|
|
grid i j grid-child unparent
|
|
grid child add-gadget
|
|
child i j grid grid>> nth set-nth ;
|
|
|
|
: grid-remove ( grid i j -- grid ) [ <gadget> ] 2dip grid-add ;
|
|
|
|
: pref-dim-grid ( grid -- dims )
|
|
grid>> [ [ pref-dim ] map ] map ;
|
|
|
|
: (compute-grid) ( grid -- seq ) [ max-dim ] map ;
|
|
|
|
: compute-grid ( grid -- horiz vert )
|
|
pref-dim-grid [ flip (compute-grid) ] [ (compute-grid) ] bi ;
|
|
|
|
: (pair-up) ( horiz vert -- dim )
|
|
[ first ] [ second ] bi* 2array ;
|
|
|
|
: pair-up ( horiz vert -- dims )
|
|
[ [ (pair-up) ] curry map ] with map ;
|
|
|
|
: add-gaps ( gap seq -- newseq )
|
|
[ v+ ] with map ;
|
|
|
|
: gap-sum ( gap seq -- newseq )
|
|
dupd add-gaps dim-sum v+ ;
|
|
|
|
M: grid pref-dim*
|
|
dup gap>> swap compute-grid [ over ] dip
|
|
[ gap-sum ] 2bi@ (pair-up) ;
|
|
|
|
: do-grid ( dims grid quot -- )
|
|
[ grid>> ] dip '[ _ 2each ] 2each ; inline
|
|
|
|
: grid-positions ( grid dims -- locs )
|
|
[ gap>> dup ] dip add-gaps swap [ v+ ] accumulate nip ;
|
|
|
|
: position-grid ( grid horiz vert -- )
|
|
pick [ [ over ] dip [ grid-positions ] 2bi@ pair-up ] dip
|
|
[ (>>loc) ] do-grid ;
|
|
|
|
: resize-grid ( grid horiz vert -- )
|
|
pick fill?>> [
|
|
pair-up swap [ (>>dim) ] do-grid
|
|
] [
|
|
2drop grid>> [ [ prefer ] each ] each
|
|
] if ;
|
|
|
|
: grid-layout ( grid horiz vert -- )
|
|
[ position-grid ] 3keep resize-grid ;
|
|
|
|
M: grid layout* dup compute-grid grid-layout ;
|
|
|
|
M: grid children-on ( rect gadget -- seq )
|
|
dup children>> empty?
|
|
[ 2drop f ]
|
|
[
|
|
{ 0 1 } swap grid>>
|
|
[ 0 <column> fast-children-on ] keep
|
|
<slice> concat
|
|
]
|
|
if ;
|
|
|
|
M: grid gadget-text*
|
|
grid>>
|
|
[ [ gadget-text ] map ] map format-table
|
|
[ CHAR: \n , ] [ % ] interleave ;
|