summaryrefslogtreecommitdiff
path: root/chickadee.scm
diff options
context:
space:
mode:
Diffstat (limited to 'chickadee.scm')
-rw-r--r--chickadee.scm64
1 files changed, 45 insertions, 19 deletions
diff --git a/chickadee.scm b/chickadee.scm
index e2d8624..2c65226 100644
--- a/chickadee.scm
+++ b/chickadee.scm
@@ -145,9 +145,32 @@ not being pushed at all."
(sdl2:game-controller-name controller))))
(define-record-type <window>
- (wrap-sdl-window sdl-window)
+ (wrap-window sdl-window gl-context)
window?
- (sdl-window unwrap-window))
+ (sdl-window unwrap-window)
+ (gl-context window-gl-context))
+
+(define* (make-window #:key (title "Chickadee") fullscreen?
+ (width 640) (height 480) (multisample? #t))
+ ;; Hint that we want OpenGL 3.2 Core profile. Doesn't mean we'll
+ ;; get it, though!
+ (sdl2:set-gl-attribute! 'context-major-version 3)
+ (sdl2:set-gl-attribute! 'context-major-version 2)
+ (sdl2:set-gl-attribute! 'context-profile-mask 1) ; core profile
+ (sdl2:set-gl-attribute! 'stencil-size 8) ; 8-bit stencil buffer
+ (if multisample?
+ (begin
+ (sdl2:set-gl-attribute! 'multisample-buffers 1)
+ (sdl2:set-gl-attribute! 'multisample-samples 4))
+ (begin
+ (sdl2:set-gl-attribute! 'multisample-buffers 0)
+ (sdl2:set-gl-attribute! 'multisample-samples 0)))
+ (let* ((window (sdl2:make-window #:opengl? #t
+ #:title title
+ #:size (list width height)
+ #:fullscreen? fullscreen?))
+ (gl-context (sdl2:make-gl-context window)))
+ (wrap-window window gl-context)))
(define current-window (make-parameter #f))
@@ -241,20 +264,23 @@ border is disabled, otherwise it is enabled.")
(sdl-init)
(start-text-input)
(init-audio)
- ;; Hint that we want OpenGL 3.2 Core profile. Doesn't mean we'll
- ;; get it, though!
- (sdl2:set-gl-attribute! 'context-major-version 3)
- (sdl2:set-gl-attribute! 'context-major-version 2)
- (sdl2:set-gl-attribute! 'context-profile-mask 1) ; core profile
- (sdl2:set-gl-attribute! 'stencil-size 8) ; 8-bit stencil buffer
- (sdl2:set-gl-attribute! 'multisample-buffers 1)
- (sdl2:set-gl-attribute! 'multisample-samples 4)
- (let* ((window (sdl2:make-window #:opengl? #t
- #:title window-title
- #:size (list window-width window-height)
+ ;; We assume here that if window creation fails it is because
+ ;; multisampling is not supported and that we need to try again with
+ ;; 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!
+ (let* ((window (or (false-if-exception
+ (make-window #:title window-title
+ #:width window-width
+ #:height window-height
#:fullscreen? window-fullscreen?))
- (gl-context (sdl2:make-gl-context window))
- (gpu (make-gpu gl-context))
+ (make-window #:title window-title
+ #:width window-width
+ #:height window-height
+ #:fullscreen? window-fullscreen?
+ #:multisample? #f)))
+ (gpu (make-gpu (window-gl-context window)))
(default-viewport (make-viewport 0 0 window-width window-height))
(default-projection (orthographic-projection 0 window-width
window-height 0
@@ -342,11 +368,11 @@ border is disabled, otherwise it is enabled.")
(clear-screen)
(with-projection default-projection
(draw alpha)))
- (sdl2:swap-gl-window window))
+ (sdl2:swap-gl-window (unwrap-window window)))
(dynamic-wind
(const #t)
(lambda ()
- (parameterize ((current-window (wrap-sdl-window window))
+ (parameterize ((current-window window)
(current-gpu gpu))
;; Attempt to activate vsync, if possible. Some systems do
;; not support setting the OpenGL swap interval.
@@ -368,5 +394,5 @@ border is disabled, otherwise it is enabled.")
#:update-hz update-hz)))
(lambda ()
(quit-audio)
- (sdl2:delete-gl-context! gl-context)
- (sdl2:close-window! window)))))
+ (sdl2:delete-gl-context! (window-gl-context window))
+ (sdl2:close-window! (unwrap-window window))))))