2008-07-11 01:47:16 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								! Copyright (C) 2008 Slava Pestov.
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								! See http://factorcode.org/license.txt for BSD license.
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								USING: accessors kernel models arrays sequences math math.order
							 | 
						
					
						
							
								
									
										
										
										
											2010-05-18 18:36:47 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								models.product generalizations sequences.generalizations
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								math.functions ;
							 | 
						
					
						
							
								
									
										
										
										
											2009-05-14 17:54:16 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								FROM: models.product => product ;
							 | 
						
					
						
							
								
									
										
										
										
											2008-07-04 18:58:37 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								IN: models.range
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2009-02-26 17:15:10 -05:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								TUPLE: range < product ;
							 | 
						
					
						
							
								
									
										
										
										
											2008-07-04 18:58:37 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2009-06-18 21:57:02 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								: <range> ( value page min max step -- range )
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    5 narray [ <model> ] map range new-product ;
							 | 
						
					
						
							
								
									
										
										
										
											2008-07-04 18:58:37 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2008-07-11 01:47:16 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								: range-model ( range -- model ) dependencies>> first ;
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								: range-page ( range -- model ) dependencies>> second ;
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								: range-min ( range -- model ) dependencies>> third ;
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								: range-max ( range -- model ) dependencies>> fourth ;
							 | 
						
					
						
							
								
									
										
										
										
											2009-06-18 21:57:02 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								: range-step ( range -- model ) dependencies>> 4 swap nth ;
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								: step-value ( value range -- value' )
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    range-step value>> floor-to ;
							 | 
						
					
						
							
								
									
										
										
										
											2008-07-04 18:58:37 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								M: range range-value
							 | 
						
					
						
							
								
									
										
										
										
											2009-06-18 21:57:02 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								    [ range-model value>> ] [ clamp-value ] [ step-value ] tri ;
							 | 
						
					
						
							
								
									
										
										
										
											2008-07-04 18:58:37 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2008-07-11 01:47:16 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								M: range range-page-value range-page value>> ;
							 | 
						
					
						
							
								
									
										
										
										
											2008-07-04 18:58:37 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2008-07-11 01:47:16 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								M: range range-min-value range-min value>> ;
							 | 
						
					
						
							
								
									
										
										
										
											2008-07-04 18:58:37 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2008-07-11 01:47:16 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								M: range range-max-value range-max value>> ;
							 | 
						
					
						
							
								
									
										
										
										
											2008-07-04 18:58:37 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								M: range range-max-value*
							 | 
						
					
						
							
								
									
										
										
										
											2008-07-11 01:47:16 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    [ range-max-value ] [ range-page-value ] bi [-] ;
							 | 
						
					
						
							
								
									
										
										
										
											2008-07-04 18:58:37 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								M: range set-range-value
							 | 
						
					
						
							
								
									
										
										
										
											2008-07-11 01:47:16 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    [ clamp-value ] [ range-model ] bi set-model ;
							 | 
						
					
						
							
								
									
										
										
										
											2008-07-04 18:58:37 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								M: range set-range-page-value range-page set-model ;
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								M: range set-range-min-value range-min set-model ;
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								M: range set-range-max-value range-max set-model ;
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								: move-by ( amount range -- )
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    [ range-value + ] keep set-range-value ;
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								: move-by-page ( amount range -- )
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    [ range-page-value * ] keep move-by ;
							 |