diff --git a/basis/math/functions/functions.factor b/basis/math/functions/functions.factor index 19a8f17a0c..314062591d 100644 --- a/basis/math/functions/functions.factor +++ b/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 diff --git a/basis/models/range/range-tests.factor b/basis/models/range/range-tests.factor index e9119e8452..51f8b06ef5 100644 --- a/basis/models/range/range-tests.factor +++ b/basis/models/range/range-tests.factor @@ -3,13 +3,17 @@ USING: arrays generic kernel math models namespaces sequences assocs tools.test models.range ; ! Test -: setup-range ( -- range ) 0 0 0 255 ; +: setup-range ( -- range ) 0 0 0 255 1 ; +: setup-stepped-range ( -- range ) 0 0 0 255 2 ; ! 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 diff --git a/basis/models/range/range.factor b/basis/models/range/range.factor index c8bc8d8e54..c39c80c7d1 100644 --- a/basis/models/range/range.factor +++ b/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 ; -: ( value page min max -- range ) - 4array [ ] map range new-product ; +: ( value page min max step -- range ) + 5 narray [ ] 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>> ; diff --git a/basis/ui/gadgets/scrollers/scrollers-tests.factor b/basis/ui/gadgets/scrollers/scrollers-tests.factor index 4002c8b40e..5f5cc91846 100644 --- a/basis/ui/gadgets/scrollers/scrollers-tests.factor +++ b/basis/ui/gadgets/scrollers/scrollers-tests.factor @@ -21,7 +21,7 @@ IN: ui.gadgets.scrollers.tests [ ] [ dup "g" set - 10 1 0 100 20 1 0 100 2array + 10 1 0 100 1 20 1 0 100 1 2array "v" set ] unit-test diff --git a/basis/ui/gadgets/scrollers/scrollers.factor b/basis/ui/gadgets/scrollers/scrollers.factor index 0852a6fe5d..8c73226639 100644 --- a/basis/ui/gadgets/scrollers/scrollers.factor +++ b/basis/ui/gadgets/scrollers/scrollers.factor @@ -49,7 +49,7 @@ scroller H{ } set-gestures : ( -- model ) - 0 0 0 0 0 0 0 0 2array ; + 0 0 0 0 1 0 0 0 0 1 2array ; M: viewport pref-dim* gadget-child pref-viewport-dim ; diff --git a/extra/color-picker/color-picker.factor b/extra/color-picker/color-picker.factor index d7919aafd1..56a60d6fc8 100755 --- a/extra/color-picker/color-picker.factor +++ b/extra/color-picker/color-picker.factor @@ -26,7 +26,7 @@ M: color-preview model-changed horizontal 1 >>line ; : ( -- gadget model ) - 3 [ 0 0 0 255 ] replicate + 3 [ 0 0 0 255 1 ] replicate [ { 5 5 } >>gap [ add-gadget ] reduce ] [ [ range-model ] map ] bi ;