Update code base for new alarms api
parent
09d2a7dbc7
commit
e75b85de30
|
@ -28,7 +28,7 @@ ERROR: wait-timeout ;
|
|||
: wait ( queue timeout status -- )
|
||||
over [
|
||||
[ queue-timeout ] dip suspend
|
||||
[ wait-timeout ] [ cancel-alarm ] if
|
||||
[ wait-timeout ] [ stop-alarm ] if
|
||||
] [
|
||||
[ drop queue ] dip suspend drop
|
||||
] if ; inline
|
||||
|
|
|
@ -17,7 +17,7 @@ GENERIC: cancel-operation ( obj -- )
|
|||
[ '[ _ cancel-operation ] ] dip later ;
|
||||
|
||||
: with-timeout* ( obj timeout quot -- )
|
||||
3dup drop queue-timeout [ nip call ] dip cancel-alarm ;
|
||||
3dup drop queue-timeout [ nip call ] dip stop-alarm ;
|
||||
inline
|
||||
|
||||
: with-timeout ( obj quot -- )
|
||||
|
|
|
@ -14,14 +14,14 @@ TUPLE: delay < model model timeout alarm ;
|
|||
over >>model
|
||||
[ add-dependency ] keep ;
|
||||
|
||||
: cancel-delay ( delay -- )
|
||||
alarm>> [ cancel-alarm ] when* ;
|
||||
: stop-delay ( delay -- )
|
||||
alarm>> [ stop-alarm ] when* ;
|
||||
|
||||
: start-delay ( delay -- )
|
||||
dup
|
||||
[ [ f >>alarm update-delay-model ] curry ] [ timeout>> ] bi later
|
||||
>>alarm drop ;
|
||||
|
||||
M: delay model-changed nip dup cancel-delay start-delay ;
|
||||
M: delay model-changed nip dup stop-delay start-delay ;
|
||||
|
||||
M: delay model-activated update-delay-model ;
|
||||
|
|
|
@ -60,7 +60,7 @@ SYMBOL: blink-interval
|
|||
750 milliseconds blink-interval set-global
|
||||
|
||||
: stop-blinking ( editor -- )
|
||||
[ [ cancel-alarm ] when* f ] change-blink-alarm drop ;
|
||||
[ [ stop-alarm ] when* f ] change-blink-alarm drop ;
|
||||
|
||||
: start-blinking ( editor -- )
|
||||
[ stop-blinking ] [
|
||||
|
|
|
@ -188,13 +188,15 @@ SYMBOL: drag-timer
|
|||
[ drag-gesture ]
|
||||
300 milliseconds
|
||||
100 milliseconds
|
||||
add-alarm drag-timer get-global >box
|
||||
<alarm>
|
||||
[ drag-timer get-global >box ]
|
||||
[ start-alarm ] bi
|
||||
] when ;
|
||||
|
||||
: stop-drag-timer ( -- )
|
||||
hand-buttons get-global empty? [
|
||||
drag-timer get-global ?box
|
||||
[ cancel-alarm ] [ drop ] if
|
||||
[ stop-alarm ] [ drop ] if
|
||||
] when ;
|
||||
|
||||
: fire-motion ( -- )
|
||||
|
|
|
@ -233,7 +233,7 @@ DEFER: update-audio
|
|||
dup al-sources>> [
|
||||
{
|
||||
[ make-engine-current ]
|
||||
[ update-alarm>> [ cancel-alarm ] when* ]
|
||||
[ update-alarm>> [ stop-alarm ] when* ]
|
||||
[ clips>> clone [ dispose ] each ]
|
||||
[ al-sources>> free-sources ]
|
||||
[
|
||||
|
|
|
@ -44,7 +44,7 @@ M: noise-generator dispose
|
|||
] 20 milliseconds every :> alarm
|
||||
"Press Enter to stop the test." print
|
||||
readln drop
|
||||
alarm cancel-alarm
|
||||
alarm stop-alarm
|
||||
engine dispose ;
|
||||
|
||||
MAIN: audio-engine-test
|
||||
|
|
|
@ -4,11 +4,10 @@ kernel math math.order namespaces system ui ui.gadgets.worlds ;
|
|||
IN: game.loop
|
||||
|
||||
TUPLE: game-loop
|
||||
{ tick-interval-micros integer read-only }
|
||||
{ tick-interval-nanos integer read-only }
|
||||
tick-delegate
|
||||
draw-delegate
|
||||
{ last-tick integer }
|
||||
thread
|
||||
{ running? boolean }
|
||||
{ tick-number integer }
|
||||
{ frame-number integer }
|
||||
|
@ -22,11 +21,11 @@ GENERIC: draw* ( tick-slice delegate -- )
|
|||
|
||||
SYMBOL: game-loop
|
||||
|
||||
: since-last-tick ( loop -- microseconds )
|
||||
last-tick>> system-micros swap - ;
|
||||
: since-last-tick ( loop -- nanos )
|
||||
last-tick>> nano-count swap - ;
|
||||
|
||||
: tick-slice ( loop -- slice )
|
||||
[ since-last-tick ] [ tick-interval-micros>> ] bi /f 1.0 min ;
|
||||
[ since-last-tick ] [ tick-interval-nanos>> ] bi /f 1.0 min ;
|
||||
|
||||
CONSTANT: MAX-FRAMES-TO-SKIP 5
|
||||
|
||||
|
@ -40,8 +39,8 @@ TUPLE: game-loop-error game-loop error ;
|
|||
: game-loop-error ( game-loop error -- )
|
||||
[ drop stop-loop ] [ \ game-loop-error boa ?ui-error ] 2bi ;
|
||||
|
||||
: fps ( fps -- micros )
|
||||
1,000,000 swap /i ; inline
|
||||
: fps ( fps -- nanos )
|
||||
1,000,000,000 swap /i ; inline
|
||||
|
||||
<PRIVATE
|
||||
|
||||
|
@ -54,60 +53,60 @@ TUPLE: game-loop-error game-loop error ;
|
|||
|
||||
: increment-tick ( loop -- )
|
||||
[ 1 + ] change-tick-number
|
||||
dup tick-interval-micros>> [ + ] curry change-last-tick
|
||||
dup tick-interval-nanos>> [ + ] curry change-last-tick
|
||||
drop ;
|
||||
|
||||
: ?tick ( loop count -- )
|
||||
[ system-micros >>last-tick drop ] [
|
||||
over [ since-last-tick ] [ tick-interval-micros>> ] bi >=
|
||||
[ nano-count >>last-tick drop ] [
|
||||
over [ since-last-tick ] [ tick-interval-nanos>> ] bi >=
|
||||
[ [ drop increment-tick ] [ drop tick ] [ 1 - ?tick ] 2tri ]
|
||||
[ 2drop ] if
|
||||
] if-zero ;
|
||||
|
||||
: benchmark-micros ( loop -- micros )
|
||||
system-micros swap benchmark-time>> - ;
|
||||
: benchmark-nanos ( loop -- nanos )
|
||||
nano-count swap benchmark-time>> - ;
|
||||
|
||||
PRIVATE>
|
||||
|
||||
: reset-loop-benchmark ( loop -- )
|
||||
system-micros >>benchmark-time
|
||||
: reset-loop-benchmark ( loop -- loop )
|
||||
nano-count >>benchmark-time
|
||||
dup tick-number>> >>benchmark-tick-number
|
||||
dup frame-number>> >>benchmark-frame-number
|
||||
drop ;
|
||||
dup frame-number>> >>benchmark-frame-number ;
|
||||
|
||||
: benchmark-ticks-per-second ( loop -- n )
|
||||
[ tick-number>> ] [ benchmark-tick-number>> - ] [ benchmark-micros ] tri /f ;
|
||||
[ tick-number>> ] [ benchmark-tick-number>> - ] [ benchmark-nanos ] tri /f ;
|
||||
: benchmark-frames-per-second ( loop -- n )
|
||||
[ frame-number>> ] [ benchmark-frame-number>> - ] [ benchmark-micros ] tri /f ;
|
||||
[ frame-number>> ] [ benchmark-frame-number>> - ] [ benchmark-nanos ] tri /f ;
|
||||
|
||||
: (game-tick) ( loop -- )
|
||||
dup running?>>
|
||||
[ [ MAX-FRAMES-TO-SKIP ?tick ] [ redraw ] bi ]
|
||||
[ drop ] if ;
|
||||
|
||||
: game-tick ( alarm loop -- )
|
||||
[ alarm<< ] keep
|
||||
: game-tick ( loop -- )
|
||||
dup game-loop [
|
||||
[ (game-tick) ] [ game-loop-error ] recover
|
||||
] with-variable ;
|
||||
|
||||
: start-loop ( loop -- )
|
||||
system-micros >>last-tick
|
||||
nano-count >>last-tick
|
||||
t >>running?
|
||||
[ reset-loop-benchmark ]
|
||||
[ [ '[ _ game-tick ] ] keep tick-interval-micros>> microseconds every* ]
|
||||
[ thread<< ] tri ;
|
||||
reset-loop-benchmark
|
||||
[
|
||||
[ '[ _ game-tick ] f ]
|
||||
[ tick-interval-nanos>> nanoseconds ] bi
|
||||
<alarm>
|
||||
] keep [ alarm<< ] [ drop start-alarm ] 2bi ;
|
||||
|
||||
: stop-loop ( loop -- )
|
||||
f >>running?
|
||||
f >>thread
|
||||
drop ;
|
||||
alarm>> stop-alarm ;
|
||||
|
||||
: <game-loop*> ( tick-interval-micros tick-delegate draw-delegate -- loop )
|
||||
system-micros f f 0 0 system-micros 0 0 f
|
||||
: <game-loop*> ( tick-interval-nanos tick-delegate draw-delegate -- loop )
|
||||
nano-count f 0 0 nano-count 0 0 f
|
||||
game-loop boa ;
|
||||
|
||||
: <game-loop> ( tick-interval-micros delegate -- loop )
|
||||
: <game-loop> ( tick-interval-nanos delegate -- loop )
|
||||
dup <game-loop*> ; inline
|
||||
|
||||
M: game-loop dispose
|
||||
|
|
|
@ -108,7 +108,7 @@ TUPLE: joystick-demo-gadget < pack axis raxis controller buttons alarm ;
|
|||
|
||||
: kill-update-axes ( gadget -- )
|
||||
COLOR: gray <solid> >>interior
|
||||
[ [ cancel-alarm ] when* f ] change-alarm
|
||||
[ [ stop-alarm ] when* f ] change-alarm
|
||||
relayout-1 ;
|
||||
|
||||
: (update-axes) ( gadget controller-state -- )
|
||||
|
@ -129,7 +129,7 @@ M: joystick-demo-gadget graft*
|
|||
drop ;
|
||||
|
||||
M: joystick-demo-gadget ungraft*
|
||||
alarm>> [ cancel-alarm ] when* ;
|
||||
alarm>> [ stop-alarm ] when* ;
|
||||
|
||||
: joystick-window ( controller -- )
|
||||
[ <joystick-demo-gadget> ] [ product-string ] bi
|
||||
|
|
|
@ -167,7 +167,7 @@ M: key-caps-gadget graft*
|
|||
drop ;
|
||||
|
||||
M: key-caps-gadget ungraft*
|
||||
alarm>> [ cancel-alarm ] when*
|
||||
alarm>> [ stop-alarm ] when*
|
||||
close-game-input ;
|
||||
|
||||
M: key-caps-gadget handle-gesture
|
||||
|
|
|
@ -48,4 +48,4 @@ PRIVATE>
|
|||
] unless ;
|
||||
|
||||
: stop-site-watcher ( -- )
|
||||
running-site-watcher get [ cancel-alarm ] when* ;
|
||||
running-site-watcher get [ stop-alarm ] when* ;
|
||||
|
|
|
@ -55,7 +55,7 @@ M: tetris-gadget graft* ( gadget -- )
|
|||
[ [ tick ] curry 100 milliseconds every ] keep alarm<< ;
|
||||
|
||||
M: tetris-gadget ungraft* ( gadget -- )
|
||||
[ cancel-alarm f ] change-alarm drop ;
|
||||
[ stop-alarm f ] change-alarm drop ;
|
||||
|
||||
: tetris-window ( -- )
|
||||
[
|
||||
|
|
Loading…
Reference in New Issue