diff options
| -rw-r--r-- | 2d/game-loop.scm | 35 | ||||
| -rw-r--r-- | 2d/game.scm | 25 | ||||
| -rw-r--r-- | examples/simple.scm | 30 |
3 files changed, 47 insertions, 43 deletions
diff --git a/2d/game-loop.scm b/2d/game-loop.scm index ab81b5a..8dcc65c 100644 --- a/2d/game-loop.scm +++ b/2d/game-loop.scm @@ -42,8 +42,9 @@ on-mouse-motion-hook on-mouse-button-down-hook on-mouse-button-up-hook + current-fps run-game-loop - current-fps)) + quit-game-loop!)) ;;; ;;; Constants @@ -57,6 +58,7 @@ ;;; (define *fps* 0) +(define *running* #f) ;;; ;;; Hooks @@ -200,23 +202,30 @@ INPUT, OUTPUT, and ERROR ports." (define (game-loop last-time next-time accumulator) "Runs input, render, and update hooks." - (handle-events) - (let* ((time (SDL:get-ticks)) - (dt (- time last-time)) - (accumulator (+ accumulator dt)) - (remainder (update accumulator))) - (run-repl) - (render) - (accumulate-fps! dt) - (SDL:delay (time-left (SDL:get-ticks) next-time)) - (game-loop time - (+ next-time tick-interval) - remainder))) + (when *running* + (handle-events) + (let* ((time (SDL:get-ticks)) + (dt (- time last-time)) + (accumulator (+ accumulator dt)) + (remainder (update accumulator))) + (run-repl) + (render) + (accumulate-fps! dt) + (SDL:delay (time-left (SDL:get-ticks) next-time)) + (game-loop time + (+ next-time tick-interval) + remainder)))) (define (run-game-loop) "Spawns a REPL server and starts the main game loop." + (set! *running* #t) (spawn-server) ;;(lock-mutex game-loop-mutex) (agenda-schedule show-fps) (let ((time (SDL:get-ticks))) (game-loop time (+ time tick-interval) 0))) + +(define (quit-game-loop!) + "Tell the game loop to finish up the current frame and then +terminate." + (set! *running* #f)) diff --git a/2d/game.scm b/2d/game.scm index e20638c..cb043ec 100644 --- a/2d/game.scm +++ b/2d/game.scm @@ -25,16 +25,11 @@ #:use-module (srfi srfi-9) #:use-module (2d game-loop) #:use-module (2d window) - #:use-module (2d vector2) - #:export (<game> - make-game - define-game - game? - game-title - game-resolution - game-fullscreen? - game-first-scene - run-game)) + #:use-module (2d vector2)) + +;;; +;;; Games +;;; (define-record-type <game> (%make-game title resolution fullscreen first-scene) @@ -64,3 +59,13 @@ value." (game-fullscreen? game)) (run-game-loop) (close-window)) + +(export <game> + make-game + define-game + game? + game-title + game-resolution + game-fullscreen? + game-first-scene + run-game) diff --git a/examples/simple.scm b/examples/simple.scm index 6a4e928..c33b7a2 100644 --- a/examples/simple.scm +++ b/examples/simple.scm @@ -1,38 +1,28 @@ (use-modules (2d sprite) + (2d game) (2d game-loop) - (2d window) (2d helpers) (2d vector2)) -(define window-width 800) -(define window-height 600) - -;; Open the window. -(open-window window-width window-height) - (define sprite - (load-sprite "images/sprite.png" - #:position (vector2 (/ window-width 2) - (/ window-height 2)))) - -(define (quit-demo) - (close-window) - (quit)) + (delay (load-sprite "images/sprite.png" + #:position (vector2 320 240)))) (define (key-down key mod unicode) (cond ((any-equal? key 'escape 'q) - (quit-demo)))) + (quit-game-loop!)))) ;; Draw our sprite (define (render) - (draw-sprite sprite)) + (draw-sprite (force sprite))) ;; Register callbacks. (add-hook! on-quit-hook (lambda () (quit-demo))) (add-hook! on-render-hook (lambda () (render))) -(add-hook! on-key-down-hook (lambda (key mod unicode) (key-down key mod unicode))) +(add-hook! on-key-down-hook (lambda (key mod unicode) + (key-down key mod unicode))) +(define-game simple + #:title "Simple Demo") -;; Start the game loop. -;; The render callback will be called through this procedure. -(run-game-loop) +(run-game simple) |