Fallback to no multisampling if window creation fails.

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))))))