diff options
Diffstat (limited to 'catbird/scene.scm')
| -rw-r--r-- | catbird/scene.scm | 68 |
1 files changed, 55 insertions, 13 deletions
diff --git a/catbird/scene.scm b/catbird/scene.scm index 9197e47..7f2542d 100644 --- a/catbird/scene.scm +++ b/catbird/scene.scm @@ -26,11 +26,17 @@ #:use-module (catbird mode) #:use-module (catbird node) #:use-module (chickadee data array-list) + #:use-module (chickadee scripting) #:use-module (ice-9 exceptions) #:use-module (ice-9 format) #:use-module (oop goops) #:use-module (srfi srfi-1) #:export (<scene> + current-scene + with-scene + add-to-scene + scene-script + $ regions major-mode minor-modes @@ -48,9 +54,27 @@ (minor-modes #:accessor minor-modes #:init-value '()) (input-map #:getter input-map #:init-value '())) +(define current-scene (make-parameter #f)) + +(define-syntax-rule (with-scene scene body ...) + (parameterize ((current-scene scene)) body ...)) + +(define-syntax $ + (syntax-rules () + ((_) (current-scene)) + ((_ names ...) + (& (current-scene) names ...)))) + +(define-method (add-to-scene . nodes) + (apply attach-to (current-scene) nodes)) + +(define-syntax-rule (scene-script body ...) + (run-script (current-scene) body ...)) + (define-method (initialize (scene <scene>) args) (next-method) - (attach (major-mode scene) scene)) + (with-scene scene + (attach (major-mode scene) scene))) (define-method (replace-major-mode (scene <scene>) (mode <major-mode>)) (let ((old-mode (major-mode scene))) @@ -59,6 +83,9 @@ (set! (major-mode scene) mode) (attach mode scene))) +(define-method (replace-major-mode (mode <major-mode>)) + (replace-major-mode (current-scene) mode)) + (define-method (push-major-mode (scene <scene>) (mode <major-mode>)) (let ((old-mode (major-mode scene))) (array-list-push! (major-mode-stack scene) old-mode) @@ -67,6 +94,9 @@ (set! (major-mode scene) mode) (attach mode scene))) +(define-method (push-major-mode (mode <major-mode>)) + (push-major-mode (current-scene) mode)) + (define-method (pop-major-mode (scene <scene>)) (let ((stack (major-mode-stack scene))) (unless (array-list-empty? stack) @@ -77,6 +107,9 @@ (set! (major-mode scene) prev-mode) (resume prev-mode))))) +(define-method (pop-major-mode) + (pop-major-mode (current-scene))) + (define-method (add-minor-mode (scene <scene>) (mode <minor-mode>)) (when (parent mode) (raise-exception @@ -84,6 +117,9 @@ (set! (minor-modes scene) (cons mode (minor-modes scene))) (attach mode scene)) +(define-method (add-minor-mode (mode <minor-mode>)) + (add-minor-mode (current-scene) mode)) + (define-method (remove-minor-mode (scene <scene>) (mode <minor-mode>)) (unless (eq? scene (parent mode)) (raise-exception @@ -92,18 +128,23 @@ (set! (minor-modes scene) (delq mode modes)) (detach mode))) +(define-method (remove-minor-mode (mode <minor-mode>)) + (remove-minor-mode (current-scene) mode)) + (define-method (remove-minor-mode (scene <scene>) (mode-class <class>)) - (let ((mode (find (lambda (mode) - (eq? (class-of mode) mode-class)) - (minor-modes scene)))) - (when mode - (remove-minor-mode scene mode)))) + (with-scene scene + (let ((mode (find (lambda (mode) + (eq? (class-of mode) mode-class)) + (minor-modes scene)))) + (when mode + (remove-minor-mode scene mode))))) (define-method (search-modes (scene <scene>) proc) - (or (proc (major-mode scene)) - (find (lambda (mode) - (proc mode)) - (minor-modes scene)))) + (with-scene scene + (or (proc (major-mode scene)) + (find (lambda (mode) + (proc mode)) + (minor-modes scene))))) (define-method (on-key-press (scene <scene>) key modifiers) (search-modes scene @@ -156,9 +197,10 @@ (on-controller-move mode controller-id axis value)))) (define-method (update (scene <scene>) dt) - (update (major-mode scene) dt) - (for-each (lambda (mode) (update mode dt)) - (minor-modes scene))) + (with-scene scene + (update (major-mode scene) dt) + (for-each (lambda (mode) (update mode dt)) + (minor-modes scene)))) (define-method (pause (scene <scene>)) (for-each-child pause scene) |