basis/ui/gadgets/grids/grids-tests.factor

   1 USING: ui.gadgets ui.gadgets.grids tools.test kernel arrays
   2 namespaces math.rectangles accessors ui.gadgets.grids.private
   3 ui.gadgets.debug sequences classes ;
   4 IN: ui.gadgets.grids.tests
   5
   6 { { 0 0 } } [ { } <grid> pref-dim ] unit-test
   7
   8 : 100x100 ( -- gadget ) <gadget> { 100 100 } >>dim ;
   9
  10 : 200x200 ( -- gadget ) <gadget> { 200 200 } >>dim ;
  11
  12 { { 100 100 } } [
  13     100x100
  14     1array 1array <grid> pref-dim
  15 ] unit-test
  16
  17 { { 100 100 } } [
  18     100x100
  19     1array 1array <grid> pref-dim
  20 ] unit-test
  21
  22 { { 200 100 } } [
  23     100x100
  24     100x100
  25     2array 1array <grid> pref-dim
  26 ] unit-test
  27
  28 { { 100 200 } } [
  29     100x100
  30     100x100
  31     [ 1array ] bi@ 2array <grid> pref-dim
  32 ] unit-test
  33
  34 { } [
  35     100x100
  36     100x100
  37     [ 1array ] bi@ 2array <grid> layout
  38 ] unit-test
  39
  40 { { 230 120 } { 100 100 } { 100 100 } } [
  41     100x100 dup "a" set
  42     100x100 dup "b" set
  43     2array 1array <grid>
  44     { 10 10 } >>gap
  45     dup prefer
  46     dup layout
  47     dim>>
  48     "a" get dim>>
  49     "b" get dim>>
  50 ] unit-test
  51
  52 { } [
  53     100x100 dup "a" set
  54     100x100 dup "b" set
  55     100x100 dup "c" set
  56     [ 1array ] tri@ 3array
  57     <grid>
  58     { 10 10 } >>gap "g" set
  59 ] unit-test
  60
  61 { } [ "g" get prefer ] unit-test
  62 { } [ "g" get layout ] unit-test
  63
  64 { { 10 10 } } [ "a" get loc>> ] unit-test
  65 { { 100 100 } } [ "a" get dim>> ] unit-test
  66
  67 { { 10 120 } } [ "b" get loc>> ] unit-test
  68 { { 100 100 } } [ "b" get dim>> ] unit-test
  69
  70 { { 10 230 } } [ "c" get loc>> ] unit-test
  71 { { 100 100 } } [ "c" get dim>> ] unit-test
  72
  73 5 10 { 10 10 } <baseline-gadget>
  74 10 10 { 10 10 } <baseline-gadget> 2array
  75 1array <grid> f >>fill?
  76 "g" set
  77
  78 { } [ "g" get prefer ] unit-test
  79
  80 { { 20 15 } } [ "g" get dim>> ] unit-test
  81
  82 { V{ { 0 5 } { 10 0 } } } [
  83     "g" get
  84     dup layout
  85     children>> [ loc>> ] map
  86 ] unit-test
  87
  88 ! children-on logic was insufficient
  89 { } [
  90     100x100 dup "a" set 200x200 2array
  91     100x100 dup "b" set 200x200 2array 2array <grid> f >>fill? "g" set
  92 ] unit-test
  93
  94 { } [ "g" get prefer ] unit-test
  95 { } [ "g" get layout ] unit-test
  96
  97 { { 0 50 } } [ "a" get loc>> ] unit-test
  98 { { 0 250 } } [ "b" get loc>> ] unit-test
  99
 100 { gadget { 200 200 } }
 101 [ { 120 20 } "g" get pick-up [ class-of ] [ dim>> ] bi ] unit-test
 102
 103 { gadget { 200 200 } }
 104 [ { 120 220 } "g" get pick-up [ class-of ] [ dim>> ] bi ] unit-test