extra/timers/timers.factor

   1 ! Copyright (C) 2005, 2006 Slava Pestov.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: assocs kernel math namespaces sequences system ;
   4 IN: timers
   5
   6 TUPLE: timer object delay next ;
   7
   8 : <timer> ( object delay initial -- timer )
   9     millis + timer construct-boa ;
  10
  11 GENERIC: tick ( object -- )
  12
  13 : timers \ timers get-global ;
  14
  15 : init-timers ( -- ) H{ } clone \ timers set-global ;
  16
  17 : add-timer ( object delay initial -- )
  18     pick >r <timer> r> timers set-at ;
  19
  20 : remove-timer ( object -- ) timers delete-at ;
  21
  22 : advance-timer ( ms timer -- )
  23     [ timer-delay + ] keep set-timer-next ;
  24
  25 : do-timer ( ms timer -- )
  26     dup timer-next pick <=
  27     [ [ advance-timer ] keep timer-object tick ] [ 2drop ] if ;
  28
  29 : do-timers ( -- )
  30     millis timers values [ do-timer ] curry* each ;