From 2234530eec2755958dd9ec3d57e7db1442bdbf44 Mon Sep 17 00:00:00 2001
From: David Thompson <dthompson2@worcester.edu>
Date: Fri, 5 Mar 2021 09:02:06 -0500
Subject: Add support for window resizing.

---
 chickadee.scm | 31 ++++++++++++++++++++-----------
 1 file changed, 20 insertions(+), 11 deletions(-)

(limited to 'chickadee.scm')

diff --git a/chickadee.scm b/chickadee.scm
index 82eb1b4..489fd0b 100644
--- a/chickadee.scm
+++ b/chickadee.scm
@@ -34,6 +34,7 @@
   #:use-module (chickadee utils)
   #:use-module (gl)
   #:use-module (gl enums)
+  #:use-module (ice-9 atomic)
   #:use-module (ice-9 match)
   #:use-module (sdl2)
   #:use-module (sdl2 events)
@@ -150,7 +151,7 @@ not being pushed at all."
   (sdl-window unwrap-window)
   (gl-context window-gl-context))
 
-(define* (make-window #:key (title "Chickadee") fullscreen?
+(define* (make-window #:key (title "Chickadee") fullscreen? resizable?
                       (width 640) (height 480) (multisample? #t))
   ;; Hint that we want OpenGL 3.2 Core profile.  Doesn't mean we'll
   ;; get it, though!
@@ -168,7 +169,8 @@ not being pushed at all."
   (let* ((window (sdl2:make-window #:opengl? #t
                                    #:title title
                                    #:size (list width height)
-                                   #:fullscreen? fullscreen?))
+                                   #:fullscreen? fullscreen?
+                                   #:resizable? resizable?))
          (gl-context (sdl2:make-gl-context window)))
     (wrap-window window gl-context)))
 
@@ -244,6 +246,7 @@ border is disabled, otherwise it is enabled.")
                    (window-width 640)
                    (window-height 480)
                    window-fullscreen?
+                   window-resizable?
                    (update-hz 60)
                    (load (const #t))
                    (update (const #t))
@@ -269,22 +272,26 @@ border is disabled, otherwise it is enabled.")
   ;; multisampling disabled.  This is obviously hacky but it solves a
   ;; real world user issue and I'm not sure how to test for driver
   ;; features before opening the window.  SDL's display mode
-  ;; information doesn't seem to enough.  Help wanted!
+  ;; information doesn't seem to be enough.  Help wanted!
   (let* ((window (or (false-if-exception
                       (make-window #:title window-title
                                    #:width window-width
                                    #:height window-height
-                                   #:fullscreen? window-fullscreen?))
+                                   #:fullscreen? window-fullscreen?
+                                   #:resizable? window-resizable?))
                      (make-window #:title window-title
                                   #:width window-width
                                   #:height window-height
                                   #:fullscreen? window-fullscreen?
+                                  #:resizable? window-resizable?
                                   #:multisample? #f)))
          (gfx (make-graphics-engine (window-gl-context window)))
-         (default-viewport (make-viewport 0 0 window-width window-height))
-         (default-projection (orthographic-projection 0 window-width
-                                                      window-height 0
-                                                      0 1)))
+         (default-viewport (make-atomic-box
+                            (make-viewport 0 0 window-width window-height)))
+         (default-projection (make-atomic-box
+                              (orthographic-projection 0 window-width
+                                                       window-height 0
+                                                       0 1))))
     (define (invert-y y)
       ;; SDL's origin is the top-left, but our origin is the bottom
       ;; left so we need to invert Y coordinates that SDL gives us.
@@ -345,7 +352,9 @@ border is disabled, otherwise it is enabled.")
          ((window-resized-event? event)
           (match (window-event-vector event)
             ((width height)
-             (set! default-viewport (make-viewport 0 0 width 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)))))))
       ;; Process all pending events.
       (let loop ((event (poll-event)))
         (when event
@@ -360,9 +369,9 @@ border is disabled, otherwise it is enabled.")
       ;; Free any GPU resources that have been GC'd.
       (graphics-engine-reap! gfx))
     (define (render-sdl-opengl alpha)
-      (with-graphics-state! ((viewport default-viewport))
+      (with-graphics-state! ((viewport (atomic-box-ref default-viewport)))
         (clear-viewport)
-        (with-projection default-projection
+        (with-projection (atomic-box-ref default-projection)
           (draw alpha)))
       (sdl2:swap-gl-window (unwrap-window window)))
     (dynamic-wind
-- 
cgit v1.2.3