basis/ui/gadgets/grids/grids.factor

   1 ! Copyright (C) 2006, 2009 Slava Pestov.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: arrays kernel math namespaces make sequences words io
   4 io.styles math.vectors ui.gadgets columns accessors
   5 math.geometry.rect locals fry ;
   6 IN: ui.gadgets.grids
   7
   8 TUPLE: grid < gadget
   9 grid
  10 { gap initial: { 0 0 } }
  11 { fill? initial: t } ;
  12
  13 : new-grid ( children class -- grid )
  14     new-gadget
  15         swap >>grid
  16         dup grid>> concat add-gadgets ; inline
  17
  18 : <grid> ( children -- grid )
  19     grid new-grid ;
  20
  21 :: grid-child ( grid i j -- gadget ) i j grid grid>> nth nth ;
  22
  23 :: grid-add ( grid child i j -- grid )
  24     grid i j grid-child unparent
  25     grid child add-gadget
  26     child i j grid grid>> nth set-nth ;
  27
  28 : grid-remove ( grid i j -- grid ) [ <gadget> ] 2dip grid-add ;
  29
  30 : pref-dim-grid ( grid -- dims )
  31     grid>> [ [ pref-dim ] map ] map ;
  32
  33 : (compute-grid) ( grid -- seq ) [ max-dim ] map ;
  34
  35 : compute-grid ( grid -- horiz vert )
  36     pref-dim-grid [ flip (compute-grid) ] [ (compute-grid) ] bi ;
  37
  38 : (pair-up) ( horiz vert -- dim )
  39     [ first ] [ second ] bi* 2array ;
  40
  41 : pair-up ( horiz vert -- dims )
  42     [ [ (pair-up) ] curry map ] with map ;
  43
  44 : add-gaps ( gap seq -- newseq )
  45     [ v+ ] with map ;
  46
  47 : gap-sum ( gap seq -- newseq )
  48     dupd add-gaps dim-sum v+ ;
  49
  50 M: grid pref-dim*
  51     dup gap>> swap compute-grid [ over ] dip
  52     [ gap-sum ] 2bi@ (pair-up) ;
  53
  54 : do-grid ( dims grid quot -- )
  55     [ grid>> ] dip '[ _ 2each ] 2each ; inline
  56
  57 : grid-positions ( grid dims -- locs )
  58     [ gap>> dup ] dip add-gaps swap [ v+ ] accumulate nip ;
  59
  60 : position-grid ( grid horiz vert -- )
  61     pick [ [ over ] dip [ grid-positions ] 2bi@ pair-up ] dip
  62     [ (>>loc) ] do-grid ;
  63
  64 : resize-grid ( grid horiz vert -- )
  65     pick fill?>> [
  66         pair-up swap [ (>>dim) ] do-grid
  67     ] [
  68         2drop grid>> [ [ prefer ] each ] each
  69     ] if ;
  70
  71 : grid-layout ( grid horiz vert -- )
  72     [ position-grid ] 3keep resize-grid ;
  73
  74 M: grid layout* dup compute-grid grid-layout ;
  75
  76 M: grid children-on ( rect gadget -- seq )
  77     dup children>> empty?
  78       [ 2drop f ]
  79       [
  80         { 0 1 } swap grid>>
  81         [ 0 <column> fast-children-on ] keep
  82         <slice> concat
  83       ]
  84     if ;
  85
  86 M: grid gadget-text*
  87     grid>>
  88     [ [ gadget-text ] map ] map format-table
  89     [ CHAR: \n , ] [ % ] interleave ;