summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorDavid Thompson <dthompson2@worcester.edu>2023-04-30 10:22:21 -0400
committerDavid Thompson <dthompson2@worcester.edu>2023-04-30 10:28:17 -0400
commitbe7e9a78a3af99a0a0cb46f4aa6bf2fc43098a0e (patch)
tree4de72bae104c2214fb04c480bcbd305eacbe7448
parent19960570a391672f909c70ca973ce662238fd5c2 (diff)
Use pushdown state for tracking keyboard focus.
-rw-r--r--catbird/kernel.scm27
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))