diff options
Diffstat (limited to 'lisparuga/scene.scm')
| -rw-r--r-- | lisparuga/scene.scm | 198 |
1 files changed, 198 insertions, 0 deletions
diff --git a/lisparuga/scene.scm b/lisparuga/scene.scm new file mode 100644 index 0000000..04874f2 --- /dev/null +++ b/lisparuga/scene.scm @@ -0,0 +1,198 @@ +;;; Lisparuga +;;; Copyright © 2020 David Thompson <dthompson2@worcester.edu> +;;; +;;; Lisparuga 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. +;;; +;;; Lisparuga 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 Lisparuga. 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 (lisparuga scene) + #:use-module (chickadee) + #:use-module (chickadee audio) + #:use-module (ice-9 match) + #:use-module (oop goops) + #:use-module (lisparuga 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 + + <scene-mux> + current-scene + previous-scene + push-scene + replace-scene + pop-scene + on-scenes-empty)) + +(define-class <scene> (<node>) + (background-music-source #:getter background-music-source + #:init-form (make-source #:loop? #t)) + (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>)) + (when (audio? (background-music scene)) + (set-source-volume! (background-music-source scene) + (background-music-volume scene)) + (set-source-audio! (background-music-source scene) + (background-music scene)) + (source-play (background-music-source scene)))) + +(define-method (on-exit (scene <scene>)) + (source-stop (background-music-source scene))) + +;; 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) + + +;;; +;;; Scene Multiplexer +;;; + +(define-class <scene-mux> (<node>) + (scenes #:accessor scenes #:init-form '())) + +(define-method (current-scene (mux <scene-mux>)) + (match (scenes mux) + ((s . _) s) + (() #f))) + +(define-method (previous-scene (mux <scene-mux>)) + (match (scenes mux) + ((_ s . _) s) + (_ #f))) + +(define-method (push-scene (mux <scene-mux>) (scene <scene>)) + (let ((old (current-scene mux))) + (set! (scenes mux) (cons scene (scenes mux))) + (when old (detach old)) + (attach-to mux scene))) + +(define-method (replace-scene (mux <scene-mux>) (scene <scene>)) + (match (scenes mux) + ((old . rest) + (set! (scenes mux) (cons scene rest)) + (detach old) + (attach-to mux scene)) + (() + (error "no scene to replace!" mux)))) + +(define-method (pop-scene (mux <scene-mux>)) + (match (scenes mux) + ((old) + (set! (scenes mux) '()) + (detach old) + (on-scenes-empty mux)) + ((and (old new . _) + (_ . rest)) + (set! (scenes mux) rest) + (detach old) + (attach-to mux new)) + (() + (error "no scene to pop!" mux)))) + +(define-method (on-scenes-empty (mux <scene-mux>)) + #t) + +(define-method (on-quit (mux <scene-mux>)) + (on-quit (current-scene mux))) + +(define-method (on-key-press (mux <scene-mux>) key scancode modifiers repeat?) + (on-key-press (current-scene mux) key scancode modifiers repeat?)) + +(define-method (on-key-release (mux <scene-mux>) key scancode modifiers) + (on-key-release (current-scene mux) key scancode modifiers)) + +(define-method (on-text-input (mux <scene-mux>) text) + (on-text-input (current-scene mux) text)) + +(define-method (on-mouse-press (mux <scene-mux>) button clicks x y) + (on-mouse-press (current-scene mux) button clicks x y)) + +(define-method (on-mouse-release (mux <scene-mux>) button x y) + (on-mouse-release (current-scene mux) button x y)) + +(define-method (on-mouse-move (mux <scene-mux>) x y x-rel y-rel buttons) + (on-mouse-move (current-scene mux) x y x-rel y-rel buttons)) + +(define-method (on-controller-add (mux <scene-mux>) controller) + (on-controller-add (current-scene mux) controller)) + +(define-method (on-controller-remove (mux <scene-mux>) controller) + (on-controller-remove (current-scene mux) controller)) + +(define-method (on-controller-press (mux <scene-mux>) controller button) + (on-controller-press (current-scene mux) controller button)) + +(define-method (on-controller-release (mux <scene-mux>) controller button) + (on-controller-release (current-scene mux) controller button)) + +(define-method (on-controller-move (mux <scene-mux>) controller axis value) + (on-controller-move (current-scene mux) controller axis value)) |