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

   1 USING: ui.gadgets ui.gadgets.scrollers namespaces tools.test
   2 kernel models models.compose models.range ui.gadgets.viewports
   3 ui.gadgets.labels ui.gadgets.grids ui.gadgets.frames
   4 ui.gadgets.sliders math math.vectors arrays sequences
   5 tools.test.ui math.geometry.rect accessors ;
   6 IN: ui.gadgets.scrollers.tests
   7
   8 [ ] [
   9     <gadget> "g" set
  10     "g" get <scroller> "s" set
  11 ] unit-test
  12
  13 [ { 100 200 } ] [
  14     { 100 200 } "g" get scroll>rect
  15     "s" get follows>> rect-loc
  16 ] unit-test
  17
  18 [ ] [ "s" get scroll>bottom ] unit-test
  19 [ t ] [ "s" get follows>> ] unit-test
  20
  21 [ ] [
  22     <gadget> dup "g" set
  23     10 1 0 100 <range> 20 1 0 100 <range> 2array <compose>
  24     <viewport> "v" set
  25 ] unit-test
  26
  27 "v" get [
  28     [ { 10 20 } ] [ "v" get model>> range-value ] unit-test
  29
  30     [ { 10 20 } ] [ "g" get rect-loc vneg { 3 3 } v+ ] unit-test
  31 ] with-grafted-gadget
  32
  33 [ ] [
  34     <gadget> { 100 100 } >>dim
  35     dup "g" set <scroller> "s" set
  36 ] unit-test
  37
  38 [ ] [ "s" get { 50 50 } >>dim drop ] unit-test
  39
  40 [ ] [ "s" get layout ] unit-test
  41
  42 "s" get [
  43     [ { 34 34 } ] [ "s" get viewport>> rect-dim ] unit-test
  44
  45     [ { 106 106 } ] [ "s" get viewport>> viewport-dim ] unit-test
  46
  47     [ ] [ { 0 0 } "s" get scroll ] unit-test
  48
  49     [ { 0 0 } ] [ "s" get model>> range-min-value ] unit-test
  50
  51     [ { 106 106 } ] [ "s" get model>> range-max-value ] unit-test
  52
  53     [ ] [ { 10 20 } "s" get scroll ] unit-test
  54
  55     [ { 10 20 } ] [ "s" get model>> range-value ] unit-test
  56
  57     [ { 10 20 } ] [ "s" get viewport>> model>> range-value ] unit-test
  58
  59     [ { 10 20 } ] [ "g" get rect-loc vneg { 3 3 } v+ ] unit-test
  60 ] with-grafted-gadget
  61
  62 <gadget> { 600 400 } >>dim "g1" set
  63 <gadget> { 600 10 } >>dim "g2" set
  64 "g1" get "g2" get add-gadget drop
  65
  66 "g1" get <scroller>
  67 { 300 300 } >>dim
  68 dup layout
  69 "s" set
  70
  71 [ t ] [
  72     10 [
  73         drop
  74         "g2" get scroll>gadget
  75         "s" get layout
  76         "s" get scroller-value
  77     ] map [ { 3 0 } = ] all?
  78 ] unit-test
  79
  80 [ ] [ "Hi" <label> dup "l" set <scroller> "s" set ] unit-test
  81
  82 [ t ] [ "l" get find-scroller "s" get eq? ] unit-test
  83 [ t ] [ "l" get dup find-scroller viewport>> swap child? ] unit-test
  84 [ t ] [ "l" get find-scroller* "s" get eq? ] unit-test
  85 [ f ] [ "s" get viewport>> find-scroller* ] unit-test
  86 [ t ] [ "s" get @right grid-child slider? ] unit-test
  87 [ f ] [ "s" get @right grid-child find-scroller* ] unit-test
  88
  89 \ <scroller> must-infer