| 
									
										
										
										
											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 alarms ;
 | 
					
						
							| 
									
										
										
										
											2008-07-04 18:58:37 -04:00
										 |  |  | IN: models.delay | 
					
						
							|  |  |  | 
 | 
					
						
							| 
									
										
										
										
											2008-07-11 01:47:16 -04:00
										 |  |  | TUPLE: delay < model model timeout alarm ;
 | 
					
						
							| 
									
										
										
										
											2008-07-04 18:58:37 -04:00
										 |  |  | 
 | 
					
						
							|  |  |  | : update-delay-model ( delay -- )
 | 
					
						
							| 
									
										
										
										
											2008-08-31 03:51:09 -04:00
										 |  |  |     [ model>> value>> ] keep set-model ;
 | 
					
						
							| 
									
										
										
										
											2008-07-04 18:58:37 -04:00
										 |  |  | 
 | 
					
						
							|  |  |  | : <delay> ( model timeout -- delay )
 | 
					
						
							| 
									
										
										
										
											2008-07-11 01:47:16 -04:00
										 |  |  |     f delay new-model | 
					
						
							|  |  |  |         swap >>timeout | 
					
						
							|  |  |  |         over >>model | 
					
						
							|  |  |  |         [ add-dependency ] keep ;
 | 
					
						
							| 
									
										
										
										
											2008-07-04 18:58:37 -04:00
										 |  |  | 
 | 
					
						
							|  |  |  | : cancel-delay ( delay -- )
 | 
					
						
							| 
									
										
										
										
											2008-08-31 03:51:09 -04:00
										 |  |  |     alarm>> [ cancel-alarm ] when* ;
 | 
					
						
							| 
									
										
										
										
											2008-07-04 18:58:37 -04:00
										 |  |  | 
 | 
					
						
							|  |  |  | : start-delay ( delay -- )
 | 
					
						
							| 
									
										
										
										
											2008-07-11 01:47:16 -04:00
										 |  |  |     dup
 | 
					
						
							|  |  |  |     [ [ f >>alarm update-delay-model ] curry ] [ timeout>> ] bi later | 
					
						
							|  |  |  |     >>alarm drop ;
 | 
					
						
							| 
									
										
										
										
											2008-07-04 18:58:37 -04:00
										 |  |  | 
 | 
					
						
							|  |  |  | M: delay model-changed nip dup cancel-delay start-delay ;
 | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | M: delay model-activated update-delay-model ;
 |