give range models a step parameter; use it on sliders so the thumb can step by any interval

basis/math/functions/functions.factor

@@ -264,5 +264,8 @@ M: real atan fatan ;
 
 : ceiling ( x -- y ) neg floor neg ; foldable
 
+: floor-to ( x step -- y )
+    dup zero? [ drop ] [ [ / floor ] [ * ] bi ] if ;
+
 : lerp ( a b t -- a_t ) [ over - ] dip * + ; inline
 

basis/models/range/range-tests.factor

@@ -3,13 +3,17 @@ USING: arrays generic kernel math models namespaces sequences assocs
 tools.test models.range ;
 
 ! Test <range> 
-: setup-range ( -- range ) 0 0 0 255 <range> ;
+: setup-range ( -- range ) 0 0 0 255 1 <range> ;
+: setup-stepped-range ( -- range ) 0 0 0 255 2 <range> ;
 
 ! clamp-value should not go past range ends
 [ 0   ] [ -10 setup-range clamp-value ] unit-test
 [ 255 ] [ 2000 setup-range clamp-value ] unit-test
 [ 14  ] [ 14 setup-range clamp-value ] unit-test
 
+! step-value
+[ 14  ] [ 15 setup-stepped-range step-value ] unit-test
+
 ! range min/max/page values should be correct
 [ 0 ] [ setup-range range-page-value ] unit-test
 [ 0 ] [ setup-range range-min-value ] unit-test

basis/models/range/range.factor

@@ -1,22 +1,26 @@
 ! Copyright (C) 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors kernel models arrays sequences math math.order
-models.product ;
+models.product generalizations math.functions ;
 FROM: models.product => product ;
 IN: models.range
 
 TUPLE: range < product ;
 
-: <range> ( value page min max -- range )
-    4array [ <model> ] map range new-product ;
+: <range> ( value page min max step -- range )
+    5 narray [ <model> ] map range new-product ;
 
 : range-model ( range -- model ) dependencies>> first ;
 : range-page ( range -- model ) dependencies>> second ;
 : range-min ( range -- model ) dependencies>> third ;
 : range-max ( range -- model ) dependencies>> fourth ;
+: range-step ( range -- model ) dependencies>> 4 swap nth ;
+
+: step-value ( value range -- value' )
+    range-step value>> floor-to ;
 
 M: range range-value
-    [ range-model value>> ] keep clamp-value ;
+    [ range-model value>> ] [ clamp-value ] [ step-value ] tri ;
 
 M: range range-page-value range-page value>> ;
 

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

@@ -21,7 +21,7 @@ IN: ui.gadgets.scrollers.tests
 
 [ ] [
     <gadget> dup "g" set
-    10 1 0 100 <range> 20 1 0 100 <range> 2array <product>
+    10 1 0 100 1 <range> 20 1 0 100 1 <range> 2array <product>
     <viewport> "v" set
 ] unit-test
 

basis/ui/gadgets/scrollers/scrollers.factor

@@ -49,7 +49,7 @@ scroller H{
 } set-gestures
 
 : <scroller-model> ( -- model )
-    0 0 0 0 <range> 0 0 0 0 <range> 2array <product> ;
+    0 0 0 0 1 <range> 0 0 0 0 1 <range> 2array <product> ;
 
 M: viewport pref-dim* gadget-child pref-viewport-dim ;
 

extra/color-picker/color-picker.factor

@@ -26,7 +26,7 @@ M: color-preview model-changed
     horizontal <slider> 1 >>line ;
 
 : <color-sliders> ( -- gadget model )
-    3 [ 0 0 0 255 <range> ] replicate
+    3 [ 0 0 0 255 1 <range> ] replicate
     [ <filled-pile> { 5 5 } >>gap [ <color-slider> add-gadget ] reduce ]
     [ [ range-model ] map <product> ]
     bi ;