extra/ui/gadgets/gadgets-tests.factor

   1 IN: temporary
   2 USING: ui.gadgets ui.gadgets.packs ui.gadgets.worlds tools.test
   3 namespaces models kernel ;
   4
   5 [ T{ rect f { 10 10 } { 20 20 } } ]
   6 [
   7     T{ rect f { 10 10 } { 50 50 } }
   8     T{ rect f { -10 -10 } { 40 40 } }
   9     rect-intersect
  10 ] unit-test
  11
  12 [ T{ rect f { 200 200 } { 0 0 } } ]
  13 [
  14     T{ rect f { 100 100 } { 50 50 } }
  15     T{ rect f { 200 200 } { 40 40 } }
  16     rect-intersect
  17 ] unit-test
  18
  19 [ f ] [
  20     T{ rect f { 100 100 } { 50 50 } }
  21     T{ rect f { 200 200 } { 40 40 } }
  22     intersects?
  23 ] unit-test
  24
  25 [ t ] [
  26     T{ rect f { 100 100 } { 50 50 } }
  27     T{ rect f { 120 120 } { 40 40 } }
  28     intersects?
  29 ] unit-test
  30
  31 [ f ] [
  32     T{ rect f { 1000 100 } { 50 50 } }
  33     T{ rect f { 120 120 } { 40 40 } }
  34     intersects?
  35 ] unit-test
  36
  37 TUPLE: fooey ;
  38
  39 C: <fooey> fooey
  40
  41 [ ] [ <gadget> <fooey> set-gadget-delegate ] unit-test
  42 [ ] [ f <fooey> set-gadget-delegate ] unit-test
  43
  44 [ { 300 300 } ]
  45 [
  46     ! c contains b contains a
  47     <gadget> "a" set
  48     <gadget> "b" set
  49     "a" get "b" get add-gadget
  50     <gadget> "c" set
  51     "b" get "c" get add-gadget
  52
  53     ! position a and b
  54     { 100 200 } "a" get set-rect-loc
  55     { 200 100 } "b" get set-rect-loc
  56
  57     ! give c a loc, it doesn't matter
  58     { -1000 23 } "c" get set-rect-loc
  59
  60     ! what is the location of a inside c?
  61     "a" get "c" get relative-loc
  62 ] unit-test
  63
  64 <gadget> "g1" set
  65 { 10 10 } "g1" get set-rect-loc
  66 { 30 30 } "g1" get set-rect-dim
  67 <gadget> "g2" set
  68 { 20 20 } "g2" get set-rect-loc
  69 { 50 500 } "g2" get set-rect-dim
  70 <gadget> "g3" set
  71 { 100 200 } "g3" get set-rect-dim
  72
  73 "g1" get "g2" get add-gadget
  74 "g2" get "g3" get add-gadget
  75
  76 [ { 30 30 } ] [ "g1" get screen-loc ] unit-test
  77 [ { 30 30 } ] [ "g1" get screen-rect rect-loc ] unit-test
  78 [ { 30 30 } ] [ "g1" get screen-rect rect-dim ] unit-test
  79 [ { 20 20 } ] [ "g2" get screen-loc ] unit-test
  80 [ { 20 20 } ] [ "g2" get screen-rect rect-loc ] unit-test
  81 [ { 50 180 } ] [ "g2" get screen-rect rect-dim ] unit-test
  82 [ { 0 0 } ] [ "g3" get screen-loc ] unit-test
  83 [ { 0 0 } ] [ "g3" get screen-rect rect-loc ] unit-test
  84 [ { 100 200 } ] [ "g3" get screen-rect rect-dim ] unit-test
  85
  86 <gadget> "g1" set
  87 { 300 300 } "g1" get set-rect-dim
  88 <gadget> "g2" set
  89 "g2" get "g1" get add-gadget
  90 { 20 20 } "g2" get set-rect-loc
  91 { 20 20 } "g2" get set-rect-dim
  92 <gadget> "g3" set
  93 "g3" get "g1" get add-gadget
  94 { 100 100 } "g3" get set-rect-loc
  95 { 20 20 } "g3" get set-rect-dim
  96
  97 [ t ] [ { 30 30 } "g2" get inside? ] unit-test
  98
  99 [ t ] [ { 30 30 } "g1" get (pick-up) "g2" get eq? ] unit-test
 100
 101 [ t ] [ { 30 30 } "g1" get pick-up "g2" get eq? ] unit-test
 102
 103 [ t ] [ { 110 110 } "g1" get pick-up "g3" get eq? ] unit-test
 104
 105 <gadget> "g4" set
 106 "g4" get "g2" get add-gadget
 107 { 5 5 } "g4" get set-rect-loc
 108 { 1 1 } "g4" get set-rect-dim
 109
 110 [ t ] [ { 25 25 } "g1" get pick-up "g4" get eq? ] unit-test