/extra/game/loop/loop.factor

  1! (c)2009 Joe Groff bsd license
  2USING: accessors timers alien.c-types calendar classes.struct
  3continuations destructors fry kernel math math.order memory
  4namespaces sequences system ui ui.gadgets.worlds vm
  5vocabs.loader arrays locals ;
  6IN: game.loop
  7
  8TUPLE: game-loop
  9    { tick-interval-nanos integer read-only }
 10    tick-delegate
 11    draw-delegate
 12    { running? boolean }
 13    { tick# integer }
 14    { frame# integer }
 15    tick-timer
 16    draw-timer
 17    benchmark-data ;
 18
 19GENERIC: tick* ( delegate -- )
 20GENERIC: draw* ( tick-slice delegate -- )
 21
 22DEFER: stop-loop
 23
 24TUPLE: game-loop-error game-loop error ;
 25
 26: ?ui-error ( error -- )
 27    ui-running? [ ui-error ] [ rethrow ] if ;
 28
 29: game-loop-error ( game-loop error -- )
 30    [ drop stop-loop ] [ \ game-loop-error boa ?ui-error ] 2bi ;
 31
 32: fps ( fps -- nanos )
 33    [ 1,000,000,000 ] dip /i ; inline
 34
 35<PRIVATE
 36
 37: last-tick-percent-offset ( loop -- float )
 38    [ draw-timer>> iteration-start-nanos>> nano-count swap - ]
 39    [ tick-interval-nanos>> ] bi /f 1.0 min ;
 40
 41GENERIC# record-benchmarking 1 ( loop quot -- )
 42
 43M: object record-benchmarking
 44    call( loop -- ) ;
 45
 46: redraw ( loop -- )
 47    [ 1 + ] change-frame#
 48    [
 49        [ last-tick-percent-offset ] [ draw-delegate>> ] bi
 50        draw*
 51    ] record-benchmarking ;
 52
 53: tick ( loop -- )
 54    [ tick-delegate>> tick* ] record-benchmarking ;
 55
 56: increment-tick ( loop -- )
 57    [ 1 + ] change-tick#
 58    drop ;
 59
 60PRIVATE>
 61
 62:: when-running ( loop quot -- )
 63    [
 64        loop
 65        dup running?>> quot [ drop ] if
 66    ] [
 67        loop game-loop-error
 68    ] recover ; inline
 69
 70: tick-iteration ( loop -- )
 71    [ [ tick ] [ increment-tick ] bi ] when-running ;
 72
 73: frame-iteration ( loop -- )
 74    [ redraw ] when-running ;
 75
 76: start-loop ( loop -- )
 77    t >>running?
 78
 79    dup
 80    [ '[ _ tick-iteration ] f ]
 81    [ tick-interval-nanos>> nanoseconds ] bi <timer> >>tick-timer
 82
 83    dup '[ _ frame-iteration ] f 1 milliseconds <timer> >>draw-timer
 84
 85    [ tick-timer>> ] [ draw-timer>> ] bi [ start-timer ] bi@ ;
 86
 87: stop-loop ( loop -- )
 88    f >>running?
 89    [ tick-timer>> ] [ draw-timer>> ] bi [ stop-timer ] bi@ ;
 90
 91: <game-loop*> ( tick-interval-nanos tick-delegate draw-delegate -- loop )
 92    f 0 0 f f f game-loop boa ;
 93
 94: <game-loop> ( tick-interval-nanos delegate -- loop )
 95    dup <game-loop*> ; inline
 96
 97M: game-loop dispose
 98    stop-loop ;
 99
100{ "game.loop" "prettyprint" } "game.loop.prettyprint" require-when
101{ "game.loop" "tools.memory" } "game.loop.benchmark" require-when