2006-01-20 01:26:50 -05:00
|
|
|
! Copyright (C) 2005, 2006 Slava Pestov.
|
|
|
|
! See http://factorcode.org/license.txt for BSD license.
|
|
|
|
IN: gadgets
|
2006-03-15 18:24:59 -05:00
|
|
|
USING: hashtables kernel math namespaces sequences ;
|
2006-01-20 01:26:50 -05:00
|
|
|
|
2006-10-09 13:38:53 -04:00
|
|
|
TUPLE: timer object delay next ;
|
2006-01-20 01:26:50 -05:00
|
|
|
|
2006-10-09 13:38:53 -04:00
|
|
|
C: timer ( object delay initial -- timer )
|
|
|
|
[ >r millis + r> set-timer-next ] keep
|
2006-01-20 01:26:50 -05:00
|
|
|
[ set-timer-delay ] keep
|
2006-10-09 13:38:53 -04:00
|
|
|
[ set-timer-object ] keep ;
|
2006-01-20 01:26:50 -05:00
|
|
|
|
2006-10-09 13:38:53 -04:00
|
|
|
GENERIC: tick ( object -- )
|
2006-01-20 01:26:50 -05:00
|
|
|
|
2006-03-19 00:30:57 -05:00
|
|
|
: timers \ timers get-global ;
|
2006-03-15 18:24:59 -05:00
|
|
|
|
2006-06-02 16:28:57 -04:00
|
|
|
: init-timers ( -- ) H{ } clone \ timers set-global ;
|
|
|
|
|
2006-10-09 13:38:53 -04:00
|
|
|
: add-timer ( object delay initial -- )
|
|
|
|
pick >r <timer> r> timers set-hash ;
|
2006-01-20 01:26:50 -05:00
|
|
|
|
|
|
|
: remove-timer ( object -- ) timers remove-hash ;
|
|
|
|
|
2006-10-09 13:38:53 -04:00
|
|
|
: advance-timer ( ms timer -- )
|
|
|
|
[ timer-delay + ] keep set-timer-next ;
|
2006-01-20 01:26:50 -05:00
|
|
|
|
|
|
|
: do-timer ( ms timer -- )
|
2006-10-09 13:38:53 -04:00
|
|
|
dup timer-next pick <=
|
2006-06-09 21:55:37 -04:00
|
|
|
[ [ advance-timer ] keep timer-object tick ] [ 2drop ] if ;
|
2006-01-20 01:26:50 -05:00
|
|
|
|
|
|
|
: do-timers ( -- )
|
|
|
|
millis timers hash-values [ do-timer ] each-with ;
|