summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--2d/game-loop.scm35
-rw-r--r--2d/game.scm25
-rw-r--r--examples/simple.scm30
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)