summaryrefslogtreecommitdiff
path: root/chickadee.scm
diff options
context:
space:
mode:
authorDavid Thompson <dthompson2@worcester.edu>2021-03-05 09:02:06 -0500
committerDavid Thompson <dthompson2@worcester.edu>2021-03-05 09:02:06 -0500
commit2234530eec2755958dd9ec3d57e7db1442bdbf44 (patch)
tree4383423c982311bfbd56e8629271beca2d980f27 /chickadee.scm
parent4e25e065a41d88ae9b58378957c8c6de9b7545c6 (diff)
Add support for window resizing.
Diffstat (limited to 'chickadee.scm')
-rw-r--r--chickadee.scm31
1 files changed, 20 insertions, 11 deletions
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