factor/basis/ui/gadgets/grids/grids.factor

! Copyright (C) 2006, 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: arrays kernel math math.order namespaces make sequences words io
math.vectors ui.gadgets columns accessors strings.tables
math.rectangles 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 ] [ concat add-gadgets ] bi ; inline

: <grid> ( children -- grid )
    grid new-grid ;

<PRIVATE

: grid@ ( grid pair -- col# row )
    swap [ first2 ] [ grid>> ] bi* nth ;

PRIVATE>

: grid-child ( grid pair -- gadget ) grid@ nth ;

: grid-add ( grid child pair -- grid )
    [ nip grid-child unparent ] [ drop add-gadget ] [ swapd grid@ set-nth ] 3tri ;

: grid-remove ( grid pair -- grid ) [ <gadget> ] dip grid-add ;

<PRIVATE

: cross-zip ( seq1 seq2 -- seq1xseq2 )
    [ [ 2array ] with map ] curry map ;

TUPLE: cell pref-dim baseline ;

: <cell> ( gadget -- cell ) [ pref-dim ] [ baseline ] bi cell boa ;

M: cell baseline baseline>> ;

TUPLE: grid-layout grid gap fill? row-heights column-widths ;

: iterate-cell-dims ( cells quot -- seq )
    '[ [ 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 ;

: grid-pref-dim ( grid-layout -- dim )
    [ accumulate-cell-xs drop ]
    [ accumulate-cell-ys drop ]
    bi 2array ;

M: grid pref-dim* <grid-layout> grid-pref-dim ;

: (compute-cell-locs) ( grid-layout -- locs )
    [ accumulate-cell-xs nip ]
    [ accumulate-cell-ys nip ]
    bi cross-zip flip ;

: adjust-for-baseline ( row-locs row-cells -- row-locs' )
    baseline-align [ 0 swap 2array v+ ] 2map ;

: cell-locs ( grid-layout -- locs )
    dup fill?>>
    [ (compute-cell-locs) ] [
        [ (compute-cell-locs) ] [ grid>> ] bi
        [ adjust-for-baseline ] 2map
    ] if ;

: cell-dims ( grid-layout -- dims )
    dup fill?>>
    [ [ column-widths>> ] [ row-heights>> ] bi cross-zip flip ]
    [ grid>> [ [ pref-dim>> ] map ] map ]
    if ;

: grid-layout ( children grid-layout -- )
    [ cell-locs ] [ cell-dims ] bi
    [ [ [ >>loc ] [ >>dim ] bi* drop ] 3each ] 3each ;

M: grid layout* [ grid>> ] [ <grid-layout> ] bi 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 ;

PRIVATE>