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 ) C: timer-gadget ( gadget -- gadget )
[ set-gadget-delegate ] keep ; [ 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 -- ) : start-timer-gadget ( gadget quot -- )
2dup call 2dup call
over >r curry r> over >r curry r>
[ set-timer-gadget-quot ] keep [ set-timer-gadget-quot ] keep
100 add-timer ; inline 100 200 add-timer ; inline
: stop-timer-gadget ( gadget -- ) : stop-timer-gadget ( gadget -- )
dup remove-timer f swap set-timer-gadget-quot ; 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 ) : <bevel-button> ( gadget quot -- button )
<button> dup bevel-button-theme ; <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 ; TUPLE: repeat-button ;
repeat-button H{ repeat-button H{

22
library/ui/timers.factor
View File

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