extra/game/loop/loop.factor

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