diff options
| -rw-r--r-- | Makefile.am | 1 | ||||
| -rw-r--r-- | starling/kernel.scm | 129 | ||||
| -rw-r--r-- | starling/scene.scm | 103 |
3 files changed, 164 insertions, 69 deletions
diff --git a/Makefile.am b/Makefile.am index 7a12ef2..b755a59 100644 --- a/Makefile.am +++ b/Makefile.am @@ -41,6 +41,7 @@ SOURCES = \ starling/inotify.scm \ starling/asset.scm \ starling/node.scm \ + starling/scene.scm \ starling/repl.scm \ starling/kernel.scm \ starling/node-2d.scm diff --git a/starling/kernel.scm b/starling/kernel.scm index 04fb4cd..e019b5b 100644 --- a/starling/kernel.scm +++ b/starling/kernel.scm @@ -39,21 +39,9 @@ #:use-module (starling asset) #:use-module (starling node) #:use-module (starling repl) + #:use-module (starling scene) #:use-module (system repl command) - #:export (on-quit - on-key-press - on-key-release - on-text-input - on-mouse-press - on-mouse-release - on-mouse-move - on-controller-add - on-controller-remove - on-controller-press - on-controller-release - on-controller-move - - <window-config> + #:export (<window-config> width height title @@ -66,46 +54,13 @@ gl-context current-kernel boot-kernel - elapsed-time) + elapsed-time + current-scene + push-scene + pop-scene + replace-scene) #:re-export (abort-game)) -;; Input event handler methods -(define-method (on-quit (node <node>)) - (abort-game)) - -(define-method (on-key-press (node <node>) key scancode modifiers repeat?) - #t) - -(define-method (on-key-release (node <node>) key scancode modifiers) - #t) - -(define-method (on-text-input (node <node>) text) - #t) - -(define-method (on-mouse-press (node <node>) button clicks x y) - #t) - -(define-method (on-mouse-release (node <node>) button x y) - #t) - -(define-method (on-mouse-move (node <node>) x y x-rel y-rel buttons) - #t) - -(define-method (on-controller-add (node <node>) controller) - #t) - -(define-method (on-controller-remove (node <node>) controller) - #t) - -(define-method (on-controller-press (node <node>) controller button) - #t) - -(define-method (on-controller-release (node <node>) controller button) - #t) - -(define-method (on-controller-move controller axis value) - #t) - (define-class <window-config> () (width #:accessor width #:init-form 640) (height #:accessor height #:init-form 480) @@ -120,7 +75,9 @@ (window #:accessor window) (gl-context #:accessor gl-context) (controllers #:accessor controllers #:init-thunk make-hash-table) - (repl #:accessor repl)) + (repl #:accessor repl) + ;; The scene stack. + (scenes #:accessor scenes #:init-form '())) (define current-kernel (make-parameter #f)) @@ -151,7 +108,7 @@ ;; Enable live asset reloading. (watch-assets #t) ;; Start REPL server. - (attach-to kernel (make <repl> #:name 'repl #:rank 9999)))) + (attach-to kernel (make <repl> #:name 'repl)))) (define-method (update* (kernel <kernel>) dt) (define (invert-y y) @@ -161,37 +118,37 @@ ((_ height) (- height y)))) (define (process-event event) - (let ((first-child (car (children kernel)))) + (let ((current-scene (current-scene))) (cond ((quit-event? event) - (on-quit first-child)) + (on-quit current-scene)) ((keyboard-down-event? event) - (on-key-press first-child + (on-key-press current-scene (keyboard-event-key event) (keyboard-event-scancode event) (keyboard-event-modifiers event) (keyboard-event-repeat? event))) ((keyboard-up-event? event) - (on-key-release first-child + (on-key-release current-scene (keyboard-event-key event) (keyboard-event-scancode event) (keyboard-event-modifiers event))) ((text-input-event? event) - (on-text-input first-child + (on-text-input current-scene (text-input-event-text event))) ((mouse-button-down-event? event) - (on-mouse-press first-child + (on-mouse-press current-scene (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) - (on-mouse-release first-child + (on-mouse-release current-scene (mouse-button-event-button event) (mouse-button-event-x event) (invert-y (mouse-button-event-y event)))) ((mouse-motion-event? event) - (on-mouse-move first-child + (on-mouse-move current-scene (mouse-motion-event-x event) (invert-y (mouse-motion-event-y event)) (mouse-motion-event-x-rel event) @@ -202,34 +159,34 @@ (let ((controller (add-controller kernel (controller-device-event-which event)))) - (on-controller-add first-child controller))) + (on-controller-add current-scene controller))) ((and (controller-device-event? event) (eq? (controller-device-event-action event) 'removed)) (let ((controller (lookup-controller kernel (controller-device-event-which event)))) - (on-controller-remove first-child controller) + (on-controller-remove current-scene controller) (remove-controller kernel (controller-device-event-which event)) (close-game-controller controller))) ((controller-button-down-event? event) (let ((controller (lookup-controller kernel (controller-button-event-which event)))) - (on-controller-press first-child + (on-controller-press current-scene controller (controller-button-event-button event)))) ((controller-button-up-event? event) (let ((controller (lookup-controller kernel (controller-button-event-which event)))) - (on-controller-release first-child + (on-controller-release current-scene controller (controller-button-event-button event)))) ((controller-axis-event? event) (let ((controller (lookup-controller kernel (controller-axis-event-which event)))) - (on-controller-move first-child + (on-controller-move current-scene controller (controller-axis-event-axis event) (/ (controller-axis-event-value event) 32768.0))))))) @@ -268,7 +225,7 @@ (define (elapsed-time) (sdl-ticks)) -(define (boot-kernel kernel first-node) +(define-method (boot-kernel (kernel <kernel>) (scene <scene>)) (sdl-init) ;; This will throw an error if any audio subsystem is unavailable, ;; but not every audio subsystem is needed so don't crash the @@ -298,7 +255,7 @@ (const #t) (lambda () (parameterize ((current-kernel kernel)) - (attach-to kernel first-node) + (push-scene scene) (activate kernel) (run-game #:update (lambda (dt) (update* kernel dt)) #:render (lambda (alpha) (render* kernel alpha)) @@ -310,6 +267,40 @@ (deactivate kernel) (close-window! (window kernel)))))) +(define-method (current-scene) + "Return the currently active scene" + (and (not (null? (scenes (current-kernel)))) + (car (scenes (current-kernel))))) + +(define-method (push-scene (scene <scene>)) + "Make SCENE the currently active scene and remember the previously +active scene." + (let ((old (current-scene))) + (set! (scenes (current-kernel)) (cons scene (scenes (current-kernel)))) + (when old (detach old)) + (attach-to (current-kernel) scene))) + +(define-method (replace-scene (scene <scene>)) + "Make SCENE the currently active scene and forget about whatever was +previously active." + (let ((old (current-scene))) + (unless old + (error "no scene to replace!")) + (set! (scenes (current-kernel)) (cons scene (cdr (scenes (current-kernel))))) + (detach old) + (attach-to (current-kernel) scene))) + +(define-method (pop-scene) + "Replace the current scene with the previously active scene." + (let ((old (current-scene))) + (set! (scenes (current-kernel)) (cdr (scenes (current-kernel)))) + (detach old) + (let ((new (current-scene))) + (if new + (attach-to (current-kernel) new) + ;; No scenes remain, it's time to shut down! + (abort-game))))) + (define-meta-command ((debug-game starling) repl) "debug-game Enter a debugger for the current game loop error." diff --git a/starling/scene.scm b/starling/scene.scm new file mode 100644 index 0000000..deedde1 --- /dev/null +++ b/starling/scene.scm @@ -0,0 +1,103 @@ +;;; Starling Game Engine +;;; Copyright © 2018 David Thompson <davet@gnu.org> +;;; +;;; This program 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. +;;; +;;; This program 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 Starling. If not, see <http://www.gnu.org/licenses/>. + +;;; Commentary: +;; +;; Scenes are the main state machine abstraction. A scene represents +;; a distinct portion of a game: main menu, overworld map, inventory +;; screen, etc. The kernel tracks the currently active scene. +;; +;;; Code: + +(define-module (starling scene) + #:use-module (chickadee) + #:use-module (oop goops) + #:use-module (sdl2 mixer) + #:use-module (starling node) + #:export (<scene> + background-music + background-music-volume + background-music-loop? + on-quit + on-key-press + on-key-release + on-text-input + on-mouse-press + on-mouse-release + on-mouse-move + on-controller-add + on-controller-remove + on-controller-press + on-controller-release + on-controller-move)) + +(define-class <scene> (<node>) + (background-music #:accessor background-music #:init-form #f + #:init-keyword #:music) + (background-music-volume #:accessor background-music-volume #:init-form 1.0 + #:init-keyword #:music-volume) + (background-music-loop? #:accessor background-music-loop? #:init-form #t + #:init-keyword #:music-loop?)) + +(define-method (on-enter (scene <scene>)) + (if (music? (background-music scene)) + (begin + (set-music-volume! (inexact->exact + (round + (* (background-music-volume scene) 128.0)))) + (play-music! (background-music scene) + (if (background-music-loop? scene) #f 1))) + (stop-music!))) + +(define-method (on-exit (scene <scene>)) + (stop-music!)) + +;; Input event handler methods +(define-method (on-quit (scene <scene>)) + (abort-game)) + +(define-method (on-key-press (scene <scene>) key scancode modifiers repeat?) + #t) + +(define-method (on-key-release (scene <scene>) key scancode modifiers) + #t) + +(define-method (on-text-input (scene <scene>) text) + #t) + +(define-method (on-mouse-press (scene <scene>) button clicks x y) + #t) + +(define-method (on-mouse-release (scene <scene>) button x y) + #t) + +(define-method (on-mouse-move (scene <scene>) x y x-rel y-rel buttons) + #t) + +(define-method (on-controller-add (scene <scene>) controller) + #t) + +(define-method (on-controller-remove (scene <scene>) controller) + #t) + +(define-method (on-controller-press (scene <scene>) controller button) + #t) + +(define-method (on-controller-release (scene <scene>) controller button) + #t) + +(define-method (on-controller-move (scene <scene>) controller axis value) + #t) |