2008-07-11 01:47:16 -04:00
|
|
|
! Copyright (C) 2008 Slava Pestov.
|
|
|
|
! See http://factorcode.org/license.txt for BSD license.
|
2014-11-30 01:12:16 -05:00
|
|
|
USING: accessors fry kernel models timers ;
|
2008-07-04 18:58:37 -04:00
|
|
|
IN: models.delay
|
|
|
|
|
2010-06-10 17:39:13 -04:00
|
|
|
TUPLE: delay < model model timeout timer ;
|
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
|
2014-11-30 01:12:16 -05:00
|
|
|
[ add-dependency ] keep ;
|
2008-07-04 18:58:37 -04:00
|
|
|
|
2010-05-21 21:42:12 -04:00
|
|
|
: stop-delay ( delay -- )
|
2010-06-10 17:39:13 -04:00
|
|
|
timer>> [ stop-timer ] when* ;
|
2008-07-04 18:58:37 -04:00
|
|
|
|
|
|
|
: start-delay ( delay -- )
|
2014-11-30 01:12:16 -05:00
|
|
|
[ '[ _ f >>timer update-delay-model ] ]
|
|
|
|
[ timeout>> later ]
|
|
|
|
[ timer<< ] tri ;
|
2008-07-04 18:58:37 -04:00
|
|
|
|
2010-05-21 21:42:12 -04:00
|
|
|
M: delay model-changed nip dup stop-delay start-delay ;
|
2008-07-04 18:58:37 -04:00
|
|
|
|
|
|
|
M: delay model-activated update-delay-model ;
|