diff options
| -rw-r--r-- | chickadee.scm | 64 |
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)))))) |