steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Clean up timer code

slava 2006-10-09 17:38:53 +00:00
parent ea73010a04
commit d034d0d14e
3 changed files with 12 additions and 20 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
library/ui/gadgets.factor
View File

@ -124,13 +124,13 @@ TUPLE: timer-gadget quot ;
C: timer-gadget ( gadget -- gadget )
[ set-gadget-delegate ] keep ;
M: timer-gadget tick nip timer-gadget-quot call ;
M: timer-gadget tick timer-gadget-quot call ;
: start-timer-gadget ( gadget quot -- )
2dup call
over >r curry r>
[ set-timer-gadget-quot ] keep
100 add-timer ; inline
100 200 add-timer ; inline
: stop-timer-gadget ( gadget -- )
dup remove-timer f swap set-timer-gadget-quot ;

6
library/ui/gadgets/buttons.factor
View File

@ -53,12 +53,6 @@ C: button ( gadget quot -- button )
: <bevel-button> ( gadget quot -- button )
<button> dup bevel-button-theme ;
: repeat-button-down ( button -- )
dup 100 add-timer button-clicked ;
: repeat-button-up ( button -- )
dup button-update remove-timer ;
TUPLE: repeat-button ;
repeat-button H{

22
library/ui/timers.factor
View File

@ -3,31 +3,29 @@
IN: gadgets
USING: hashtables kernel math namespaces sequences ;
TUPLE: timer object delay last ;
TUPLE: timer object delay next ;
C: timer ( object delay -- timer )
C: timer ( object delay initial -- timer )
[ >r millis + r> set-timer-next ] keep
[ set-timer-delay ] keep
[ set-timer-object ] keep
millis over set-timer-last ;
[ set-timer-object ] keep ;
GENERIC: tick ( ms object -- )
GENERIC: tick ( object -- )
: timers \ timers get-global ;
: init-timers ( -- ) H{ } clone \ timers set-global ;
: add-timer ( object delay -- )
over >r <timer> r> timers set-hash ;
: add-timer ( object delay initial -- )
pick >r <timer> r> timers set-hash ;
: remove-timer ( object -- ) timers remove-hash ;
: next-time ( timer -- ms ) dup timer-delay swap timer-last + ;
: advance-timer ( ms timer -- delay )
[ timer-last [-] ] 2keep set-timer-last ;
: advance-timer ( ms timer -- )
[ timer-delay + ] keep set-timer-next ;
: do-timer ( ms timer -- )
dup next-time pick <=
dup timer-next pick <=
[ [ advance-timer ] keep timer-object tick ] [ 2drop ] if ;
: do-timers ( -- )