diff options
Diffstat (limited to 'starling/kernel.scm')
| -rw-r--r-- | starling/kernel.scm | 129 |
1 files changed, 60 insertions, 69 deletions
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." |