summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--chickadee.scm361
-rw-r--r--examples/lines.scm5
-rw-r--r--examples/nine-patch.scm6
-rw-r--r--examples/sprite.scm6
-rw-r--r--examples/text.scm12
-rw-r--r--examples/tiled.scm12
6 files changed, 195 insertions, 207 deletions
diff --git a/chickadee.scm b/chickadee.scm
index e2a705f..eb98443 100644
--- a/chickadee.scm
+++ b/chickadee.scm
@@ -1,5 +1,5 @@
;;; Chickadee Game Toolkit
-;;; Copyright © 2016 David Thompson <davet@gnu.org>
+;;; Copyright © 2016, 2018 David Thompson <davet@gnu.org>
;;;
;;; Chickadee is free software: you can redistribute it and/or modify
;;; it under the terms of the GNU General Public License as published
@@ -27,52 +27,14 @@
#:use-module (chickadee render gl)
#:use-module (chickadee render gpu)
#:use-module (chickadee render viewport)
- #:export (load-hook
- update-hook
- before-draw-hook
- draw-hook
- after-draw-hook
- quit-hook
- key-press-hook
- key-release-hook
- text-input-hook
- mouse-press-hook
- mouse-release-hook
- mouse-move-hook
- controller-add-hook
- controller-remove-hook
- controller-press-hook
- controller-release-hook
- controller-move-hook
- error-hook
- run-game
+ #:export (run-game*
abort-game
- time))
-
-(define load-hook (make-hook 0))
-(define update-hook (make-hook 1))
-(define before-draw-hook (make-hook 0))
-(define after-draw-hook (make-hook 0))
-(define draw-hook (make-hook 1))
-(define quit-hook (make-hook 0))
-(define key-press-hook (make-hook 4))
-(define key-release-hook (make-hook 3))
-(define text-input-hook (make-hook 1))
-(define mouse-press-hook (make-hook 4))
-(define mouse-release-hook (make-hook 3))
-(define mouse-move-hook (make-hook 5))
-(define controller-add-hook (make-hook 1))
-(define controller-remove-hook (make-hook 1))
-(define controller-press-hook (make-hook 2))
-(define controller-release-hook (make-hook 2))
-(define controller-move-hook (make-hook 3))
-(define error-hook (make-hook 3))
+ run-game/sdl))
-(define open-controller (@@ (chickadee input controller) open-controller))
-(define close-controller (@@ (chickadee input controller) close-controller))
-(define lookup-controller (@@ (chickadee input controller) lookup-controller))
-
-(define game-loop-prompt-tag (make-prompt-tag 'game-loop))
+
+;;;
+;;; Error handling
+;;;
(define (display-game-loop-error stack key args)
(let ((port (current-error-port)))
@@ -82,149 +44,190 @@
(apply display-error (stack-ref stack 0) port args)
(newline port)))
-(define (call-with-error-handling thunk)
- (if (hook-empty? error-hook)
- (thunk)
- (let ((stack #f))
- (catch #t
- thunk
- (lambda (key . args)
- (display-game-loop-error stack key args)
- (run-hook error-hook stack key args))
- (lambda (key . args)
- (set! stack (make-stack #t 3)))))))
-
-(define-syntax-rule (run-hook* args ...)
- (call-with-error-handling
- (lambda ()
- (run-hook args ...))))
-
-(define* (run-game #:key
- (window-title "Chickadee!")
- (window-width 640)
- (window-height 480)
- window-fullscreen?
- (update-hz 60))
+(define (call-with-error-handling handler thunk)
+ (let ((stack #f))
+ (catch #t
+ thunk
+ (lambda (key . args)
+ (display-game-loop-error stack key args)
+ (error stack key args))
+ (lambda (key . args)
+ (set! stack (make-stack #t 3))))))
+
+(define-syntax-rule (with-error-handling handler body ...)
+ (call-with-error-handling handler (lambda () body ...)))
+
+
+;;;
+;;; Game loop core
+;;;
+
+(define game-loop-prompt-tag (make-prompt-tag 'game-loop))
+
+(define (abort-game)
+ (abort-to-prompt game-loop-prompt-tag #f))
+
+(define* (run-game #:key update render time error (update-hz 60))
+ (let ((timestep (round (/ 1000 update-hz))))
+ (call-with-prompt game-loop-prompt-tag
+ (lambda ()
+ ;; Catch SIGINT and kill the loop.
+ (sigaction SIGINT
+ (lambda (signum)
+ (abort-game)))
+ ;; A simple analogy is that we are filling up a bucket
+ ;; with water. When the bucket fills up to a marked
+ ;; line, we dump it out. Our water is time, and each
+ ;; time we dump the bucket we update the game. Updating
+ ;; the game on a fixed timestep like this yields a
+ ;; stable simulation.
+ (let loop ((previous-time (time))
+ (buffer 0))
+ (let* ((current-time (time))
+ (delta (- current-time previous-time)))
+ (let update-loop ((buffer (+ buffer delta)))
+ (if (>= buffer timestep)
+ (begin
+ (with-error-handling error (update timestep))
+ (update-loop (- buffer timestep)))
+ (begin
+ ;; We render upon every iteration of the loop, and
+ ;; thus rendering is decoupled from updating.
+ ;; It's possible to render multiple times before
+ ;; an update is performed.
+ (with-error-handling error (render (/ buffer timestep)))
+ (loop current-time buffer)))))))
+ (lambda (cont callback)
+ #f))))
+
+
+;;;
+;;; Simple SDL + OpenGL engine
+;;;
+
+;; Good enough for simple games.
+
+(define open-controller (@@ (chickadee input controller) open-controller))
+(define close-controller (@@ (chickadee input controller) close-controller))
+(define lookup-controller (@@ (chickadee input controller) lookup-controller))
+
+(define* (run-game/sdl #:key
+ (window-title "Chickadee!")
+ (window-width 640)
+ (window-height 480)
+ window-fullscreen?
+ (update-hz 60)
+ (load (const #t))
+ (update (const #t))
+ (draw (const #t))
+ (quit abort-game)
+ (key-press (const #t))
+ (key-release (const #t))
+ (text-input (const #t))
+ (mouse-press (const #t))
+ (mouse-release (const #t))
+ (mouse-move (const #t))
+ (controller-add (const #t))
+ (controller-remove (const #t))
+ (controller-press (const #t))
+ (controller-release (const #t))
+ (controller-move (const #t))
+ (error (const #t)))
(sdl-init)
((@@ (chickadee audio) enable-audio))
(start-text-input)
(let ((window (open-window #:title window-title
#:width window-width
#:height window-height
- #:fullscreen? window-fullscreen?)))
+ #:fullscreen? window-fullscreen?))
+ (default-viewport (make-viewport 0 0 window-width window-height))
+ (default-projection (orthographic-projection 0 window-width
+ window-height 0
+ 0 1)))
(define (invert-y y)
;; SDL's origin is the top-left, but our origin is the bottom
;; left so we need to invert Y coordinates that SDL gives us.
(- window-height y))
- (define (process-event event)
- (cond
- ((quit-event? event)
- (run-hook* quit-hook))
- ((keyboard-down-event? event)
- (run-hook* key-press-hook
- (keyboard-event-key event)
- (keyboard-event-scancode event)
- (keyboard-event-modifiers event)
- (keyboard-event-repeat? event)))
- ((keyboard-up-event? event)
- (run-hook* key-release-hook
- (keyboard-event-key event)
- (keyboard-event-scancode event)
- (keyboard-event-modifiers event)))
- ((text-input-event? event)
- (run-hook* text-input-hook (text-input-event-text event)))
- ((mouse-button-down-event? event)
- (run-hook* mouse-press-hook
- (mouse-button-event-button event)
- (mouse-button-event-clicks event)
- (mouse-button-event-x event)
- (invert-y (mouse-button-event-y event))))
- ((mouse-button-up-event? event)
- (run-hook* mouse-release-hook
- (mouse-button-event-button event)
- (mouse-button-event-x event)
- (invert-y (mouse-button-event-y event))))
- ((mouse-motion-event? event)
- (run-hook* mouse-move-hook
- (mouse-motion-event-x event)
- (invert-y (mouse-motion-event-y event))
- (mouse-motion-event-x-rel event)
- (- (mouse-motion-event-y-rel event))
- (mouse-motion-event-buttons event)))
- ((and (controller-device-event? event)
- (eq? (controller-device-event-action event) 'added))
- (run-hook* controller-add-hook
- (open-controller (controller-device-event-which event))))
- ((and (controller-device-event? event)
- (eq? (controller-device-event-action event) 'removed))
- (let ((controller (lookup-controller
- (controller-device-event-which event))))
- (run-hook* controller-remove-hook controller)
- (close-controller controller)))
- ((controller-button-down-event? event)
- (run-hook* controller-press-hook
- (lookup-controller
- (controller-button-event-which event))
- (controller-button-event-button event)))
- ((controller-button-up-event? event)
- (run-hook* controller-release-hook
- (lookup-controller
- (controller-button-event-which event))
- (controller-button-event-button event)))
- ((controller-axis-event? event)
- (run-hook* controller-move-hook
- (lookup-controller
- (controller-axis-event-which event))
- (controller-axis-event-axis event)
- (/ (controller-axis-event-value event) 32768.0)))))
- (with-window window
- (let ((update-interval (round (/ 1000 update-hz)))
- (default-viewport
- (make-viewport 0 0 window-width window-height))
- (default-projection
- (orthographic-projection 0 window-width window-height 0 0 1)))
- (call-with-prompt game-loop-prompt-tag
- (lambda ()
- ;; Catch SIGINT and kill the loop.
- (sigaction SIGINT
- (lambda (signum)
- (abort-game)))
- (run-hook* load-hook)
- (let loop ((previous-time (sdl-ticks))
- (lag 0))
- (let* ((current-time (sdl-ticks))
- (delta (- current-time previous-time)))
- (let update-loop ((lag (+ lag delta)))
- (if (>= lag update-interval)
- (begin
- ;; Process all pending events.
- (let loop ((event (poll-event)))
- (when event
- (process-event event)
- (loop (poll-event))))
- ;; Advance the simulation.
- (run-hook* update-hook update-interval)
- ;; Free any GPU resources that have been GC'd.
- (gpu-reap!)
- (update-loop (- lag update-interval)))
- (begin
- ;; Render a frame.
- (run-hook* before-draw-hook)
- ;; Switch to the null viewport to ensure that
- ;; the default viewport will be re-applied and
- ;; clear the screen.
- (gpu-state-set! *viewport-state* null-viewport)
- (with-viewport default-viewport
- (with-projection default-projection
- (run-hook* draw-hook (/ lag update-interval))))
- (swap-buffers window)
- (run-hook* after-draw-hook)
- (loop current-time lag)))))))
- (lambda (cont callback)
- #f))))))
-(define (abort-game)
- (abort-to-prompt game-loop-prompt-tag #f))
+ (define (input-sdl)
+ (define (process-event event)
+ (cond
+ ((quit-event? event)
+ (quit))
+ ((keyboard-down-event? event)
+ (key-press (keyboard-event-key event)
+ (keyboard-event-scancode event)
+ (keyboard-event-modifiers event)
+ (keyboard-event-repeat? event)))
+ ((keyboard-up-event? event)
+ (key-release (keyboard-event-key event)
+ (keyboard-event-scancode event)
+ (keyboard-event-modifiers event)))
+ ((text-input-event? event)
+ (text-input (text-input-event-text event)))
+ ((mouse-button-down-event? event)
+ (mouse-press (mouse-button-event-button event)
+ (mouse-button-event-clicks event)
+ (mouse-button-event-x event)
+ (invert-y (mouse-button-event-y event))))
+ ((mouse-button-up-event? event)
+ (mouse-release (mouse-button-event-button event)
+ (mouse-button-event-x event)
+ (invert-y (mouse-button-event-y event))))
+ ((mouse-motion-event? event)
+ (mouse-move (mouse-motion-event-x event)
+ (invert-y (mouse-motion-event-y event))
+ (mouse-motion-event-x-rel event)
+ (- (mouse-motion-event-y-rel event))
+ (mouse-motion-event-buttons event)))
+ ((and (controller-device-event? event)
+ (eq? (controller-device-event-action event) 'added))
+ (controller-add
+ (open-controller (controller-device-event-which event))))
+ ((and (controller-device-event? event)
+ (eq? (controller-device-event-action event) 'removed))
+ (let ((controller (lookup-controller
+ (controller-device-event-which event))))
+ (controller-remove controller)
+ (close-controller controller)))
+ ((controller-button-down-event? event)
+ (controller-press (lookup-controller
+ (controller-button-event-which event))
+ (controller-button-event-button event)))
+ ((controller-button-up-event? event)
+ (controller-release (lookup-controller
+ (controller-button-event-which event))
+ (controller-button-event-button event)))
+ ((controller-axis-event? event)
+ (controller-move (lookup-controller
+ (controller-axis-event-which event))
+ (controller-axis-event-axis event)
+ (/ (controller-axis-event-value event) 32768.0)))))
+ ;; Process all pending events.
+ (let loop ((event (poll-event)))
+ (when event
+ (process-event event)
+ (loop (poll-event)))))
+
+ (define (update-sdl dt)
+ (input-sdl)
+ (update dt)
+ ;; Free any GPU resources that have been GC'd.
+ (gpu-reap!))
-(define (time)
- (sdl-ticks))
+ (define (render-sdl-opengl alpha)
+ ;; Switch to the null viewport to ensure that
+ ;; the default viewport will be re-applied and
+ ;; clear the screen.
+ (gpu-state-set! *viewport-state* null-viewport)
+ (with-viewport default-viewport
+ (with-projection default-projection
+ (draw alpha)))
+ (swap-buffers window))
+ (with-window window
+ (load)
+ (run-game #:update update-sdl
+ #:render render-sdl-opengl
+ #:error error
+ #:time sdl-ticks
+ #:update-hz update-hz))))
diff --git a/examples/lines.scm b/examples/lines.scm
index e6b1929..5e800e0 100644
--- a/examples/lines.scm
+++ b/examples/lines.scm
@@ -25,7 +25,4 @@
#:thickness thickness)))
lines))
-(add-hook! draw-hook draw)
-(add-hook! quit-hook abort-game)
-
-(run-game)
+(run-game/sdl #:draw draw)
diff --git a/examples/nine-patch.scm b/examples/nine-patch.scm
index 5255d34..ed03cab 100644
--- a/examples/nine-patch.scm
+++ b/examples/nine-patch.scm
@@ -16,8 +16,4 @@
(draw-nine-patch image (make-rect 192.0 192.0 256.0 96.0) #:margin 6)
(draw-text font "I am error." (vec2 200.0 266.0)))
-(add-hook! load-hook load)
-(add-hook! draw-hook draw)
-(add-hook! quit-hook abort-game)
-
-(run-game)
+(run-game/sdl #:load load #:draw draw)
diff --git a/examples/sprite.scm b/examples/sprite.scm
index 92ab364..12a9ffb 100644
--- a/examples/sprite.scm
+++ b/examples/sprite.scm
@@ -11,8 +11,4 @@
(define (draw alpha)
(draw-sprite sprite (vec2 256.0 176.0)))
-(add-hook! load-hook load)
-(add-hook! draw-hook draw)
-(add-hook! quit-hook abort-game)
-
-(run-game)
+(run-game/sdl #:load load #:draw draw)
diff --git a/examples/text.scm b/examples/text.scm
index 37ac22c..fd299b7 100644
--- a/examples/text.scm
+++ b/examples/text.scm
@@ -15,12 +15,8 @@
(draw-text font "The quick brown fox jumps over the lazy dog"
(vec2 100.0 100.0)))
-(add-hook! load-hook load)
-(add-hook! draw-hook draw)
-(add-hook! quit-hook abort-game)
-(add-hook! key-press-hook
- (lambda (key scan modifiers repeat?)
- (when (eq? key 'q)
- (abort-game))))
+(define (key-press key scan modifiers repeat?)
+ (when (eq? key 'q)
+ (abort-game)))
-(run-game)
+(run-game/sdl #:load load #:draw draw #:key-press key-press)
diff --git a/examples/tiled.scm b/examples/tiled.scm
index 9e42301..3d33052 100644
--- a/examples/tiled.scm
+++ b/examples/tiled.scm
@@ -23,9 +23,9 @@
('q (abort-game))
(_ #t)))
-(add-hook! load-hook load)
-(add-hook! draw-hook draw)
-(add-hook! key-press-hook key-press)
-(add-hook! quit-hook abort-game)
-
-(run-game #:window-width 320 #:window-height 240 #:window-title "tile map demo")
+(run-game/sdl #:window-width 320
+ #:window-height 240
+ #:window-title "tile map demo"
+ #:load load
+ #:draw draw
+ #:key-press key-press)