diff options
| -rw-r--r-- | catbird/kernel.scm | 27 |
1 files changed, 21 insertions, 6 deletions
diff --git a/catbird/kernel.scm b/catbird/kernel.scm index 01861cf..5dc31a1 100644 --- a/catbird/kernel.scm +++ b/catbird/kernel.scm @@ -25,6 +25,7 @@ #:use-module (catbird input-map) #:use-module (catbird mixins) #:use-module (catbird mode) + #:use-module (catbird pushdown) #:use-module (catbird region) #:use-module (catbird scene) #:use-module (chickadee) @@ -54,6 +55,7 @@ on-controller-add on-controller-remove on-error + restore-keyboard-focus take-controller-focus take-keyboard-focus unbind-input/global)) @@ -68,15 +70,25 @@ (regions #:accessor regions #:init-value '()) (input-map #:accessor input-map #:init-thunk make-input-map #:allocation #:class) - (keyboard-focus #:accessor keyboard-focus #:init-value #f) + (keyboard-focus-state #:getter keyboard-focus-state + #:init-thunk make-pushdown-state) (controller-focus #:getter controller-focus #:init-thunk make-hash-table) (repl #:accessor repl #:init-value #f) - (stack #:accessor stack #:init-value #f) - (exception #:accessor exception #:init-value #f) - (debugging? #:accessor debugging? #:init-value #f) + (error-handler #:accessor error-handler #:init-form default-error-handler) (frame-start-time #:accessor frame-start-time #:init-value 0.0) (average-frame-time #:accessor average-frame-time #:init-value 0.0)) +(define-method (keyboard-focus (kernel <kernel>)) + (state-current (keyboard-focus-state kernel))) + +(define-method (push-keyboard-focus (kernel <kernel>) (region <region>)) + ;; Stealing keyboard multiple times is a no-op. + (unless (eq? (keyboard-focus kernel) region) + (state-push! (keyboard-focus-state kernel) region))) + +(define-method (pop-keyboard-focus (kernel <kernel>)) + (state-pop! (keyboard-focus-state kernel))) + (define-method (load* (kernel <kernel>)) (when developer-mode? (set! (repl kernel) (spawn-coop-repl-server)))) @@ -111,7 +123,7 @@ (let ((r (regions kernel))) ;; The first region added gets keyboard focus by default. (when (null? r) - (set! (keyboard-focus kernel) region)) + (push-keyboard-focus kernel region)) (set! (regions kernel) (sort-by-rank/ascending (cons region (regions kernel)))))) @@ -401,7 +413,10 @@ Resume the game loop without entering a debugger." (keyboard-focus (current-kernel))) (define (take-keyboard-focus region) - (set! (keyboard-focus (current-kernel)) region)) + (push-keyboard-focus (current-kernel) region)) + +(define (restore-keyboard-focus) + (pop-keyboard-focus (current-kernel))) (define (current-controller-focus controller-id) (hashv-ref (controller-focus (current-kernel)) controller-id)) |