1 ! Copyright (C) 2008 Slava Pestov.
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: accessors kernel models arrays sequences math math.order
4 models.product generalizations sequences.generalizations
6 FROM: models.product => product ;
9 TUPLE: range < product ;
11 : <range> ( value page min max step -- range )
12 5 narray [ <model> ] map range new-product ;
14 : range-model ( range -- model ) dependencies>> first ;
15 : range-page ( range -- model ) dependencies>> second ;
16 : range-min ( range -- model ) dependencies>> third ;
17 : range-max ( range -- model ) dependencies>> fourth ;
18 : range-step ( range -- model ) dependencies>> 4 swap nth ;
20 : step-value ( value range -- value' )
21 range-step value>> floor-to ;
24 [ range-model value>> ] [ clamp-value ] [ step-value ] tri ;
26 M: range range-page-value range-page value>> ;
28 M: range range-min-value range-min value>> ;
30 M: range range-max-value range-max value>> ;
32 M: range range-max-value*
33 [ range-max-value ] [ range-page-value ] bi [-] ;
35 M: range set-range-value
36 [ clamp-value ] [ range-model ] bi set-model ;
38 M: range set-range-page-value range-page set-model ;
40 M: range set-range-min-value range-min set-model ;
42 M: range set-range-max-value range-max set-model ;
44 : move-by ( amount range -- )
45 [ range-value + ] keep set-range-value ;
47 : move-by-page ( amount range -- )
48 [ range-page-value * ] keep move-by ;