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

jamshred: updated to use alarms instead of timers

db4
Alex Chapman 2008-03-04 12:23:36 +11:00
parent 4f815ccc03
commit ebd6715ecf
1 changed files with 11 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

18
extra/jamshred/jamshred.factor
View File

@ -1,11 +1,11 @@
! Copyright (C) 2007 Alex Chapman ! Copyright (C) 2007, 2008 Alex Chapman
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: arrays jamshred.game jamshred.gl kernel math math.constants USING: alarms arrays calendar jamshred.game jamshred.gl kernel math
namespaces sequences timers ui ui.gadgets ui.gestures ui.render math.constants namespaces sequences ui ui.gadgets ui.gestures ui.render
math.vectors ; math.vectors ;
IN: jamshred IN: jamshred
TUPLE: jamshred-gadget jamshred last-hand-loc ; TUPLE: jamshred-gadget jamshred last-hand-loc alarm ;
: <jamshred-gadget> ( jamshred -- gadget ) : <jamshred-gadget> ( jamshred -- gadget )
jamshred-gadget construct-gadget tuck set-jamshred-gadget-jamshred ; jamshred-gadget construct-gadget tuck set-jamshred-gadget-jamshred ;
@ -19,13 +19,17 @@ M: jamshred-gadget pref-dim*
M: jamshred-gadget draw-gadget* ( gadget -- ) M: jamshred-gadget draw-gadget* ( gadget -- )
dup jamshred-gadget-jamshred swap rect-dim first2 draw-jamshred ; dup jamshred-gadget-jamshred swap rect-dim first2 draw-jamshred ;
M: jamshred-gadget tick ( gadget -- ) : tick ( gadget -- )
dup jamshred-gadget-jamshred jamshred-update relayout-1 ; dup jamshred-gadget-jamshred jamshred-update relayout-1 ;
M: jamshred-gadget graft* ( gadget -- ) M: jamshred-gadget graft* ( gadget -- )
10 1 add-timer ; [
[ tick ] curry 10 milliseconds from-now 10 milliseconds add-alarm
] keep set-jamshred-gadget-alarm ;
M: jamshred-gadget ungraft* ( gadget -- ) remove-timer ; M: jamshred-gadget ungraft* ( gadget -- )
[ jamshred-gadget-alarm cancel-alarm f ] keep
set-jamshred-gadget-alarm ;
: jamshred-restart ( jamshred-gadget -- ) : jamshred-restart ( jamshred-gadget -- )
<jamshred> swap set-jamshred-gadget-jamshred ; <jamshred> swap set-jamshred-gadget-jamshred ;