library/ui/timers.factor

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