From be7e9a78a3af99a0a0cb46f4aa6bf2fc43098a0e Mon Sep 17 00:00:00 2001
From: David Thompson <dthompson2@worcester.edu>
Date: Sun, 30 Apr 2023 10:22:21 -0400
Subject: Use pushdown state for tracking keyboard focus.

---
 catbird/kernel.scm | 27 +++++++++++++++++++++------
 1 file 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))
-- 
cgit v1.2.3