/extra/game/loop/loop.factor
http://github.com/abeaumont/factor · Factor · 101 lines · 73 code · 27 blank · 1 comment · 22 complexity · 4707c5d24dec5102d8d221abe456633b MD5 · raw file
- ! (c)2009 Joe Groff bsd license
- USING: accessors timers alien.c-types calendar classes.struct
- continuations destructors fry kernel math math.order memory
- namespaces sequences system ui ui.gadgets.worlds vm
- vocabs.loader arrays locals ;
- IN: game.loop
- TUPLE: game-loop
- { tick-interval-nanos integer read-only }
- tick-delegate
- draw-delegate
- { running? boolean }
- { tick# integer }
- { frame# integer }
- tick-timer
- draw-timer
- benchmark-data ;
- GENERIC: tick* ( delegate -- )
- GENERIC: draw* ( tick-slice delegate -- )
- DEFER: stop-loop
- TUPLE: game-loop-error game-loop error ;
- : ?ui-error ( error -- )
- ui-running? [ ui-error ] [ rethrow ] if ;
- : game-loop-error ( game-loop error -- )
- [ drop stop-loop ] [ \ game-loop-error boa ?ui-error ] 2bi ;
- : fps ( fps -- nanos )
- [ 1,000,000,000 ] dip /i ; inline
- <PRIVATE
- : last-tick-percent-offset ( loop -- float )
- [ draw-timer>> iteration-start-nanos>> nano-count swap - ]
- [ tick-interval-nanos>> ] bi /f 1.0 min ;
- GENERIC# record-benchmarking 1 ( loop quot -- )
- M: object record-benchmarking
- call( loop -- ) ;
- : redraw ( loop -- )
- [ 1 + ] change-frame#
- [
- [ last-tick-percent-offset ] [ draw-delegate>> ] bi
- draw*
- ] record-benchmarking ;
- : tick ( loop -- )
- [ tick-delegate>> tick* ] record-benchmarking ;
- : increment-tick ( loop -- )
- [ 1 + ] change-tick#
- drop ;
- PRIVATE>
- :: when-running ( loop quot -- )
- [
- loop
- dup running?>> quot [ drop ] if
- ] [
- loop game-loop-error
- ] recover ; inline
- : tick-iteration ( loop -- )
- [ [ tick ] [ increment-tick ] bi ] when-running ;
- : frame-iteration ( loop -- )
- [ redraw ] when-running ;
- : start-loop ( loop -- )
- t >>running?
- dup
- [ '[ _ tick-iteration ] f ]
- [ tick-interval-nanos>> nanoseconds ] bi <timer> >>tick-timer
- dup '[ _ frame-iteration ] f 1 milliseconds <timer> >>draw-timer
- [ tick-timer>> ] [ draw-timer>> ] bi [ start-timer ] bi@ ;
- : stop-loop ( loop -- )
- f >>running?
- [ tick-timer>> ] [ draw-timer>> ] bi [ stop-timer ] bi@ ;
- : <game-loop*> ( tick-interval-nanos tick-delegate draw-delegate -- loop )
- f 0 0 f f f game-loop boa ;
- : <game-loop> ( tick-interval-nanos delegate -- loop )
- dup <game-loop*> ; inline
- M: game-loop dispose
- stop-loop ;
- { "game.loop" "prettyprint" } "game.loop.prettyprint" require-when
- { "game.loop" "tools.memory" } "game.loop.benchmark" require-when