From 0fe14aaf972b0cc00a7f7c3162c39b0ad422d7d9 Mon Sep 17 00:00:00 2001
From: David Thompson <dthompson2@worcester.edu>
Date: Sat, 13 May 2023 11:21:13 -0400
Subject: Add window event handlers to run-game.

---
 chickadee.scm | 69 ++++++++++++++++++++++++++++++++++++++++++++---------------
 1 file changed, 52 insertions(+), 17 deletions(-)

(limited to 'chickadee.scm')

diff --git a/chickadee.scm b/chickadee.scm
index 3022a52..a3434b8 100644
--- a/chickadee.scm
+++ b/chickadee.scm
@@ -248,6 +248,8 @@ border is disabled, otherwise it is enabled.")
 (define (warp-mouse x y)
   (sdl2:warp-mouse x y (unwrap-window (current-window))))
 
+(define noop (const #t))
+
 (define* (run-game #:key
                    (window-title "Chickadee!")
                    (window-width 640)
@@ -256,22 +258,32 @@ border is disabled, otherwise it is enabled.")
                    window-resizable?
                    (clear-color %default-clear-color)
                    (update-hz 60)
-                   (load (const #t))
-                   (update (const #t))
-                   (draw (const #t))
+                   (load noop)
+                   (update noop)
+                   (draw noop)
                    (quit abort-game)
-                   (key-press (const #t))
-                   (key-release (const #t))
-                   (text-input (const #t))
-                   (mouse-press (const #t))
-                   (mouse-release (const #t))
-                   (mouse-move (const #t))
-                   (mouse-wheel (const #t))
-                   (controller-add (const #t))
-                   (controller-remove (const #t))
-                   (controller-press (const #t))
-                   (controller-release (const #t))
-                   (controller-move (const #t))
+                   (key-press noop)
+                   (key-release noop)
+                   (text-input noop)
+                   (mouse-press noop)
+                   (mouse-release noop)
+                   (mouse-move noop)
+                   (mouse-wheel noop)
+                   (controller-add noop)
+                   (controller-remove noop)
+                   (controller-press noop)
+                   (controller-release noop)
+                   (controller-move noop)
+                   (window-keyboard-enter noop)
+                   (window-keyboard-leave noop)
+                   (window-mouse-enter noop)
+                   (window-mouse-leave noop)
+                   (window-show noop)
+                   (window-hide noop)
+                   (window-minimize noop)
+                   (window-maximize noop)
+                   (window-move noop)
+                   (window-resize noop)
                    error)
   (sdl-init)
   (start-text-input)
@@ -362,12 +374,35 @@ border is disabled, otherwise it is enabled.")
                             (controller-axis-event-which event))
                            (controller-axis-event-axis event)
                            (/ (controller-axis-event-value event) 32768.0)))
-         ((window-resized-event? event)
+         ((window-focus-gained-event? event)
+          (window-keyboard-enter))
+         ((window-focus-lost-event? event)
+          (window-keyboard-leave))
+         ((window-enter-event? event)
+          (window-mouse-enter))
+         ((window-leave-event? event)
+          (window-mouse-leave))
+         ((window-shown-event? event)
+          (window-show))
+         ((window-hidden-event? event)
+          (window-hide))
+         ((window-minimized-event? event)
+          (window-minimize))
+         ((window-maximized-event? event)
+          (window-maximize))
+         ((window-moved-event? event)
+          (match (window-event-vector event)
+            ((x y)
+             (window-move x y))))
+         ((window-size-changed-event? event)
           (match (window-event-vector event)
             ((width height)
+             (set! window-width width)
+             (set! window-height height)
              (atomic-box-set! default-viewport (make-viewport 0 0 width height))
              (atomic-box-set! default-projection
-                              (orthographic-projection 0 width height 0 0 1)))))))
+                              (orthographic-projection 0 width height 0 0 1))
+             (window-resize width height))))))
       ;; Process all pending events.
       (let loop ((event (poll-event)))
         (when event
-- 
cgit v1.2.3