summaryrefslogtreecommitdiff
path: root/chickadee
diff options
context:
space:
mode:
authorDavid Thompson <dthompson2@worcester.edu>2018-08-20 21:50:41 -0400
committerDavid Thompson <dthompson2@worcester.edu>2018-08-23 08:01:11 -0400
commit517d129719e1f5210e1e0c8ff6e597284b41a599 (patch)
tree89a1766abe394fb4b7216dbe548b08b5b644d04c /chickadee
parenteceae08c4f6985c3cc30191ab33b22302578b81e (diff)
Move SDL game loop implementation to its own module.
Diffstat (limited to 'chickadee')
-rw-r--r--chickadee/audio.scm147
-rw-r--r--chickadee/input/controller.scm87
-rw-r--r--chickadee/input/keyboard.scm29
-rw-r--r--chickadee/sdl.scm207
-rw-r--r--chickadee/window.scm84
5 files changed, 207 insertions, 347 deletions
diff --git a/chickadee/audio.scm b/chickadee/audio.scm
deleted file mode 100644
index c92eb44..0000000
--- a/chickadee/audio.scm
+++ /dev/null
@@ -1,147 +0,0 @@
-;;; Chickadee Game Toolkit
-;;; Copyright © 2017 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
-;;; by the Free Software Foundation, either version 3 of the License,
-;;; or (at your option) any later version.
-;;;
-;;; Chickadee is distributed in the hope that it will be useful, but
-;;; WITHOUT ANY WARRANTY; without even the implied warranty of
-;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
-;;; General Public License for more details.
-;;;
-;;; You should have received a copy of the GNU General Public License
-;;; along with this program. If not, see
-;;; <http://www.gnu.org/licenses/>.
-
-;;; Commentary:
-;;
-;; Sound effects and music.
-;;
-;;; Code:
-
-(define-module (chickadee audio)
- #:use-module (ice-9 format)
- #:use-module (srfi srfi-9)
- #:use-module (srfi srfi-9 gnu)
- #:use-module ((sdl2 mixer) #:prefix sdl2:)
- #:export (load-sample
- sample?
- sample-audio
- set-sample-volume!
- play-sample
- load-music
- music?
- music-audio
- music-volume
- play-music
- set-music-volume!
- pause-music
- resume-music
- rewind-music
- stop-music
- music-paused?
- music-playing?))
-
-(define (enable-audio)
- ;; The SDL mixer will throw an exception if it cannot initialize a
- ;; particular audio format. We don't want this to be fatal, so we
- ;; ignore it.
- (false-if-exception (sdl2:mixer-init))
- (sdl2:open-audio))
-
-;; Used to wrap SDL audio functions whose return values should be
-;; ignored.
-(define-syntax-rule (ignore-value body ...)
- (begin
- body ...
- *unspecified*))
-
-;; Wrapper over SDL audio objects.
-(define-record-type <sample>
- (make-sample audio)
- sample?
- (audio sample-audio))
-
-(define (display-sample sample port)
- (format port "#<sample ~x>" (object-address sample)))
-
-(set-record-type-printer! <sample> display-sample)
-
-(define (load-sample file)
- "Load audio sample from FILE."
- (let ((audio (sdl2:load-chunk file)))
- (if audio
- (make-sample audio)
- (error "cannot load audio sample:" file))))
-
-(define (set-sample-volume! volume)
- "Set the volume that all samples are played at to VOLUME, a floating
-point value between 0 and 1."
- (ignore-value
- (sdl2:set-channel-volume! #f (inexact->exact (round (* volume 128.0))))))
-
-(define (play-sample sample)
- "Play SAMPLE."
- (ignore-value
- ;; An exception will be thrown if too many samples are being played
- ;; at once, but it can be safely ignored.
- (false-if-exception
- (sdl2:play-chunk! (sample-audio sample)))))
-
-;; Wrapper over SDL music objects.
-(define-record-type <music>
- (make-music audio)
- music?
- (audio music-audio))
-
-(define (display-music music port)
- (format port "#<music ~x>" (object-address music)))
-
-(set-record-type-printer! <music> display-music)
-
-(define (load-music file)
- "Load music from FILE."
- (make-music (sdl2:load-music file)))
-
-(define (music-volume)
- "Return the volume level for music, a floating point value between
-0 and 1."
- (/ (sdl2:music-volume) 128.0))
-
-(define (set-music-volume! volume)
- "Set the volume that music is played at to VOLUME, a floating point
-value between 0 and 1."
- (ignore-value
- (sdl2:set-music-volume!
- (inexact->exact (round (* volume 128.0))))))
-
-(define* (play-music music #:key loop?)
- "Play MUSIC. If LOOP?, play it over and over and over and over
-and..."
- (sdl2:play-music! (music-audio music) (if loop? #f 1)))
-
-(define (pause-music)
- "Pause the current music track."
- (sdl2:pause-music!))
-
-(define (resume-music)
- "Resume the current music track."
- (sdl2:resume-music!))
-
-(define (rewind-music)
- "Restart the current music track from the beginning."
- (sdl2:rewind-music!))
-
-(define (stop-music)
- "Stop playing the current music track."
- (sdl2:stop-music!))
-
-(define (music-playing?)
- "Return #t if music is currently playing."
- (sdl2:music-playing?))
-
-(define (music-paused?)
- "Return #t if music is currently paused."
- (sdl2:music-paused?))
diff --git a/chickadee/input/controller.scm b/chickadee/input/controller.scm
deleted file mode 100644
index cb44120..0000000
--- a/chickadee/input/controller.scm
+++ /dev/null
@@ -1,87 +0,0 @@
-;;; Chickadee Game Toolkit
-;;; Copyright © 2016 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
-;;; by the Free Software Foundation, either version 3 of the License,
-;;; or (at your option) any later version.
-;;;
-;;; Chickadee is distributed in the hope that it will be useful, but
-;;; WITHOUT ANY WARRANTY; without even the implied warranty of
-;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
-;;; General Public License for more details.
-;;;
-;;; You should have received a copy of the GNU General Public License
-;;; along with this program. If not, see
-;;; <http://www.gnu.org/licenses/>.
-
-(define-module (chickadee input controller)
- #:use-module (srfi srfi-9)
- #:use-module (sdl2)
- #:use-module ((sdl2 input game-controller) #:prefix sdl2:)
- #:use-module ((sdl2 input joystick) #:prefix sdl2:)
- #:export (controller?
- controller-name
- controller-power-level
- controller-button-pressed?
- controller-axis))
-
-(define-record-type <controller>
- (wrap-controller sdl-controller)
- controller?
- (sdl-controller unwrap-controller))
-
-(define %controllers (make-hash-table))
-
-(define (open-controller index)
- (let* ((sdl-controller (sdl2:open-game-controller index))
- (controller (wrap-controller sdl-controller)))
- ;; Register controller in global hash table for future lookup.
- (hash-set! %controllers
- (sdl2:joystick-instance-id
- (sdl2:game-controller-joystick sdl-controller))
- controller)
- controller))
-
-(define (close-controller controller)
- (hash-remove! %controllers
- (sdl2:joystick-instance-id
- (sdl2:game-controller-joystick
- (unwrap-controller controller))))
- (sdl2:close-game-controller (unwrap-controller controller)))
-
-(define (lookup-controller instance-id)
- (hash-ref %controllers instance-id))
-
-(define (controller-name controller)
- "Return the human readable model name of CONTROLLER."
- (sdl2:game-controller-name (unwrap-controller controller)))
-
-(define (controller-power-level controller)
- "Return the symbolic power level for CONTROLLER.
-
-Possible return values are:
-- unknown
-- empty
-- low
-- medium
-- full
-- wired"
- (sdl2:joystick-power-level
- (sdl2:game-controller-joystick
- (unwrap-controller controller))))
-
-(define (controller-connected? controller)
- "Return #t if CONTROLLER is currently in use."
- (sdl2:game-controller-attached? (unwrap-controller controller)))
-
-(define (controller-button-pressed? controller button)
- "Return #t if BUTTON is currently being pressed on CONTROLLER."
- (sdl2:game-controller-button-pressed? (unwrap-controller controller) button))
-
-(define-inlinable (controller-axis controller axis)
- "Return a floating point value in the range [-1, 1] corresponding to
-how much AXIS is being pushed on CONTROLLER. 0 is returned if AXIS is
-not being pushed at all."
- (/ (sdl2:game-controller-axis (unwrap-controller controller) axis)
- 32768.0))
diff --git a/chickadee/input/keyboard.scm b/chickadee/input/keyboard.scm
deleted file mode 100644
index afc0435..0000000
--- a/chickadee/input/keyboard.scm
+++ /dev/null
@@ -1,29 +0,0 @@
-;;; Chickadee Game Toolkit
-;;; Copyright © 2017 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
-;;; by the Free Software Foundation, either version 3 of the License,
-;;; or (at your option) any later version.
-;;;
-;;; Chickadee is distributed in the hope that it will be useful, but
-;;; WITHOUT ANY WARRANTY; without even the implied warranty of
-;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
-;;; General Public License for more details.
-;;;
-;;; You should have received a copy of the GNU General Public License
-;;; along with this program. If not, see
-;;; <http://www.gnu.org/licenses/>.
-
-(define-module (chickadee input keyboard)
- #:use-module ((sdl2 input keyboard) #:prefix sdl2:)
- #:export (key-pressed?
- key-released?))
-
-(define (key-pressed? key)
- "Return #t if KEY is currently being pressed."
- (sdl2:key-pressed? key))
-
-(define (key-released? key)
- "Return #t if KEY is not currently being pressed."
- (sdl2:key-released? key))
diff --git a/chickadee/sdl.scm b/chickadee/sdl.scm
new file mode 100644
index 0000000..bb8d5e3
--- /dev/null
+++ b/chickadee/sdl.scm
@@ -0,0 +1,207 @@
+;;; Chickadee Game Toolkit
+;;; Copyright © 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
+;;; by the Free Software Foundation, either version 3 of the License,
+;;; or (at your option) any later version.
+;;;
+;;; Chickadee is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+;;; General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with this program. If not, see
+;;; <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+;;
+;; Simple SDL + OpenGL game loop implementation.
+;;
+;;; Code:
+
+(define-module (chickadee sdl)
+ #:use-module (sdl2)
+ #:use-module (sdl2 events)
+ #:use-module (sdl2 input game-controller)
+ #:use-module (sdl2 input joystick)
+ #:use-module (sdl2 input text)
+ #:use-module (sdl2 mixer)
+ #:use-module (sdl2 video)
+ #:use-module (chickadee)
+ #:use-module (chickadee math matrix)
+ #:use-module (chickadee render)
+ #:use-module (chickadee render color)
+ #:use-module (chickadee render gl)
+ #:use-module (chickadee render gpu)
+ #:use-module (chickadee render viewport)
+ #:export (current-window
+ run-game/sdl))
+
+(define *controllers* (make-hash-table))
+
+(define (lookup-controller joystick-id)
+ (hashv-ref *controllers* joystick-id))
+
+(define (add-controller joystick-index)
+ (let ((controller (open-game-controller joystick-index)))
+ (hashv-set! *controllers*
+ (joystick-instance-id
+ (game-controller-joystick controller))
+ controller)
+ controller))
+
+(define (remove-controller joystick-id)
+ (hashv-remove! *controllers* joystick-id))
+
+(define (open-all-controllers)
+ (let loop ((i 0))
+ (when (< i (num-joysticks))
+ (when (game-controller-index? i)
+ (add-controller i))
+ (loop (+ i 1)))))
+
+(define current-window (make-parameter #f))
+
+(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)
+ (false-if-exception (mixer-init))
+ (open-audio)
+ (start-text-input)
+ (open-all-controllers)
+ (let* ((window (make-window #:opengl? #t
+ #:title window-title
+ #:size (list window-width window-height)
+ #:fullscreen? window-fullscreen?))
+ (gl-context (make-gl-context window))
+ (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 (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 (add-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)
+ (remove-controller (controller-device-event-which event))
+ (close-game-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 (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-gl-window window))
+ (dynamic-wind
+ (const #t)
+ (lambda ()
+ (parameterize ((current-window window))
+ ;; Attempt to activate vsync, if possible. Some systems do
+ ;; not support setting the OpenGL swap interval.
+ (catch #t
+ (lambda ()
+ (set-gl-swap-interval! 'vsync))
+ (lambda args
+ (display "warning: could not enable vsync\n"
+ (current-error-port))))
+ (load)
+ ;; Notify about all controllers that were already connected
+ ;; when the game was launched because SDL will not create
+ ;; events for them.
+ (hash-for-each (lambda (key controller)
+ (controller-add controller))
+ *controllers*)
+ (run-game #:update update-sdl
+ #:render render-sdl-opengl
+ #:error error
+ #:time sdl-ticks
+ #:update-hz update-hz)))
+ (lambda ()
+ (delete-gl-context! gl-context)
+ (close-window! window)))))
diff --git a/chickadee/window.scm b/chickadee/window.scm
deleted file mode 100644
index aff2458..0000000
--- a/chickadee/window.scm
+++ /dev/null
@@ -1,84 +0,0 @@
-;;; Chickadee Game Toolkit
-;;; Copyright © 2016 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
-;;; by the Free Software Foundation, either version 3 of the License,
-;;; or (at your option) any later version.
-;;;
-;;; Chickadee is distributed in the hope that it will be useful, but
-;;; WITHOUT ANY WARRANTY; without even the implied warranty of
-;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
-;;; General Public License for more details.
-;;;
-;;; You should have received a copy of the GNU General Public License
-;;; along with this program. If not, see
-;;; <http://www.gnu.org/licenses/>.
-
-(define-module (chickadee window)
- #:use-module (ice-9 match)
- #:use-module (srfi srfi-9)
- #:use-module ((sdl2) #:prefix sdl2:)
- #:use-module ((sdl2 events) #:prefix sdl2:)
- #:use-module ((sdl2 video) #:prefix sdl2:)
- #:export (open-window
- close-window!
- window?
- window-title
- window-width
- window-height
- window-fullscreen?
- with-window
- swap-buffers))
-
-(define-record-type <window>
- (make-window sdl-window gl-context)
- window?
- (sdl-window unwrap-window)
- (gl-context window-gl-context))
-
-(define* (open-window #:key
- (title "Chickadee")
- (width 640)
- (height 480)
- fullscreen?)
- (let* ((sdl-window (sdl2:make-window #:opengl? #t
- #:title title
- #:size (list width height)
- #:fullscreen? fullscreen?))
- (gl-context (sdl2:make-gl-context sdl-window))
- (window (make-window sdl-window gl-context)))
- ;; Some systems do not support setting the OpenGL swap interval.
- (catch #t
- (lambda ()
- (sdl2:set-gl-swap-interval! 'vsync))
- (lambda args
- (display "warning: could not enable vsync\n"
- (current-error-port))))
- window))
-
-(define (close-window! window)
- "Close WINDOW."
- (sdl2:delete-gl-context! (window-gl-context window))
- (sdl2:close-window! (unwrap-window window)))
-
-(define (window-title window)
- "Return the title of WINDOW."
- (sdl2:window-title (unwrap-window window)))
-
-(define (set-window-title! window title)
- "Set TITLE for WINDOW."
- (sdl2:set-window-title! (unwrap-window window) title))
-
-(define (set-window-size! window width height)
- (sdl2:set-window-size! (unwrap-window window) (list width height)))
-
-(define-syntax-rule (with-window window body ...)
- (dynamic-wind
- (const #t)
- (lambda () body ...)
- (lambda ()
- (close-window! window))))
-
-(define (swap-buffers window)
- (sdl2:swap-gl-window (unwrap-window window)))