/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

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