basis/ui/gadgets/packs/packs.factor

   1 ! Copyright (C) 2005, 2008 Slava Pestov.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: sequences ui.gadgets kernel math math.functions
   4 math.vectors namespaces math.order accessors math.geometry.rect ;
   5 IN: ui.gadgets.packs
   6
   7 TUPLE: pack < gadget
   8     { align initial: 0 }
   9     { fill  initial: 0 }
  10     { gap   initial: { 0 0 } } ;
  11
  12 : packed-dim-2 ( gadget sizes -- list )
  13     [ over rect-dim over v- rot fill>> v*n v+ ] with map ;
  14
  15 : packed-dims ( gadget sizes -- seq )
  16     2dup packed-dim-2 swap orient ;
  17
  18 : gap-locs ( gap sizes -- seq )
  19     { 0 0 } [ v+ over v+ ] accumulate 2nip ;
  20
  21 : aligned-locs ( gadget sizes -- seq )
  22     [ >r dup align>> swap rect-dim r> v- n*v ] with map ;
  23
  24 : packed-locs ( gadget sizes -- seq )
  25     over gap>> over gap-locs >r dupd aligned-locs r> orient ;
  26
  27 : round-dims ( seq -- newseq )
  28     { 0 0 } swap
  29     [ swap v- dup [ ceiling >fixnum ] map [ swap v- ] keep ] map
  30     nip ;
  31
  32 : pack-layout ( pack sizes -- )
  33     round-dims over children>>
  34     >r dupd packed-dims r> 2dup [ (>>dim) ] 2each
  35     >r packed-locs r> [ (>>loc) ] 2each ;
  36
  37 : <pack> ( orientation -- pack )
  38     pack new-gadget
  39         swap >>orientation ;
  40
  41 : <pile> ( -- pack ) { 0 1 } <pack> ;
  42
  43 : <filled-pile> ( -- pack ) <pile> 1 >>fill ;
  44
  45 : <shelf> ( -- pack ) { 1 0 } <pack> ;
  46
  47 : gap-dims ( gap sizes -- seeq )
  48     [ dim-sum ] keep length 1 [-] rot n*v v+ ;
  49
  50 : pack-pref-dim ( gadget sizes -- dim )
  51     over gap>> over gap-dims >r max-dim r>
  52     rot orientation>> set-axis ;
  53
  54 M: pack pref-dim*
  55     dup children>> pref-dims pack-pref-dim ;
  56
  57 M: pack layout*
  58     dup children>> pref-dims pack-layout ;
  59
  60 M: pack children-on ( rect gadget -- seq )
  61     dup orientation>> swap children>>
  62     [ fast-children-on ] keep <slice> ;