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

   1 USING: ui.gadgets ui.gadgets.scrollers namespaces tools.test
   2 kernel models models.product models.range ui.gadgets.viewports
   3 ui.gadgets.labels ui.gadgets.grids ui.gadgets.sliders math
   4 math.vectors arrays sequences ui.gadgets.debug math.rectangles
   5 accessors ui.gadgets.buttons ui.gadgets.packs
   6 ui.gadgets.scrollers.private ;
   7 IN: ui.gadgets.scrollers.tests
   8
   9 { } [
  10     <gadget> "g" set
  11     "g" get <scroller> "s" set
  12 ] unit-test
  13
  14 { { 100 200 } } [
  15     { 100 200 } point>rect "g" get scroll>rect
  16     "s" get follows>> loc>>
  17 ] unit-test
  18
  19 { } [ "s" get scroll>bottom ] unit-test
  20 { t } [ "s" get follows>> ] unit-test
  21
  22 { } [
  23     <gadget> dup "g" set
  24     10 1 0 100 1 <range> 20 1 0 100 1 <range> 2array <product>
  25     <viewport> "v" set
  26 ] unit-test
  27
  28 "v" get [
  29     [ { 10 20 } ] [ "v" get model>> range-value ] unit-test
  30
  31     [ { 10 20 } ] [ "g" get loc>> vneg ] unit-test
  32 ] with-grafted-gadget
  33
  34 { } [
  35     <gadget> { 100 100 } >>dim
  36     dup "g" set <scroller> "s" set
  37 ] unit-test
  38
  39 { } [ "s" get { 50 50 } >>dim drop ] unit-test
  40
  41 { } [ "s" get layout ] unit-test
  42
  43 "s" get [
  44     [ { 34 34 } ] [ "s" get viewport>> dim>> ] unit-test
  45
  46     [ { 100 100 } ] [ "s" get viewport>> gadget-child pref-dim ] unit-test
  47
  48     [ ] [ { 0 0 } "s" get set-scroll-position ] unit-test
  49
  50     [ { 0 0 } ] [ "s" get model>> range-min-value ] unit-test
  51
  52     [ { 100 100 } ] [ "s" get model>> range-max-value ] unit-test
  53
  54     [ ] [ { 10 20 } "s" get set-scroll-position ] unit-test
  55
  56     [ { 10 20 } ] [ "s" get model>> range-value ] unit-test
  57
  58     [ { 10 20 } ] [ "s" get viewport>> model>> range-value ] unit-test
  59
  60     [ { 10 20 } ] [ "g" get loc>> vneg ] unit-test
  61 ] with-grafted-gadget
  62
  63 <gadget> { 600 400 } >>dim "g1" set
  64 <gadget> { 600 10 } >>dim "g2" set
  65 "g1" get "g2" get add-gadget drop
  66
  67 "g1" get <scroller>
  68 { 300 300 } >>dim
  69 dup layout
  70 "s" set
  71
  72 { t } [
  73     10 <iota> [
  74         drop
  75         "g2" get scroll>gadget
  76         "s" get layout
  77         "s" get scroll-position
  78     ] map [ { 0 0 } = ] all?
  79 ] unit-test
  80
  81 { } [ "Hi" <label> dup "l" set <scroller> "s" set ] unit-test
  82
  83 { t } [ "l" get find-scroller "s" get eq? ] unit-test
  84 { t } [ "l" get dup find-scroller viewport>> swap child? ] unit-test
  85 { t } [ "l" get find-scroller* "s" get eq? ] unit-test
  86 { f } [ "s" get viewport>> find-scroller* ] unit-test
  87 { t } [ "s" get { 1 0 } grid-child slider? ] unit-test
  88 { f } [ "s" get { 1 0 } grid-child find-scroller* ] unit-test
  89
  90 { } [
  91     "Click Me" [ [ scroll>gadget ] [ unparent ] bi ] <border-button>
  92     [ <pile> swap add-gadget <scroller> ] keep
  93     dup quot>> call
  94     layout
  95 ] unit-test
  96
  97 { t } [
  98     <gadget> { 200 200 } >>dim
  99     [ [ scroll>gadget ] [ unparent ] bi ] <border-button>
 100     dup
 101     <pile> swap add-gadget <scroller> { 100 100 } >>dim dup layout
 102     swap dup quot>> call
 103     dup layout
 104     model>> dependencies>> [ range-max value>> ] map
 105     { 0 0 } =
 106 ] unit-test