diff options
Diffstat (limited to 'chickadee.scm')
| -rw-r--r-- | chickadee.scm | 164 |
1 files changed, 79 insertions, 85 deletions
diff --git a/chickadee.scm b/chickadee.scm index 05f3d65..47515ff 100644 --- a/chickadee.scm +++ b/chickadee.scm @@ -25,9 +25,12 @@ #:use-module (chickadee config) #:use-module (chickadee game-loop) #:use-module (chickadee math matrix) + #:use-module (chickadee graphics) + #:use-module ((chickadee graphics backend) #:prefix gpu:) + #:use-module (chickadee graphics backend opengl) #:use-module (chickadee graphics color) - #:use-module (chickadee graphics engine) - #:use-module (chickadee graphics gl) + #:use-module (chickadee graphics pass) + #:use-module (chickadee graphics texture) #:use-module (chickadee graphics viewport) #:use-module (chickadee utils) #:use-module (gl) @@ -74,6 +77,7 @@ mouse-button-released? warp-mouse set-show-cursor! + default-texture-view run-game) #:re-export (abort-game current-timestep)) @@ -155,21 +159,10 @@ not being pushed at all." (sdl-window unwrap-window) (gl-context window-gl-context)) +(define default-texture-view (make-parameter #f)) + (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! - (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))) + (width 640) (height 480)) (let* ((window (sdl2:make-window #:opengl? #t #:title title #:size (list width height) @@ -288,32 +281,30 @@ border is disabled, otherwise it is enabled.") (sdl-init) (start-text-input) (init-audio) - ;; 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 be enough. Help wanted! - (let* ((window (or (false-if-exception - (make-window #:title window-title - #:width window-width - #:height window-height - #: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-atomic-box - (make-viewport 0 0 window-width window-height - #:clear-color clear-color))) - (default-projection (make-atomic-box - (orthographic-projection 0 window-width - window-height 0 - 0 1)))) + (let* ((window (make-window #:title window-title + #:width window-width + #:height window-height + #:fullscreen? window-fullscreen? + #:resizable? window-resizable?)) + (gpu (make-opengl-gpu (window-gl-context window) + (lambda () + (sdl2:swap-gl-window + (unwrap-window window))) + window-width window-height)) + (default-viewport (make-viewport 0 0 window-width window-height)) + (default-projection (orthographic-projection 0 window-width + window-height 0 + 0 1)) + (default-render-pass + (make-render-pass + #:color-attachments + (vector + (make-color-attachment + #:view default-texture-view + #:operation (make-color-operation + #:clear-color db32-viking)))))) + (pk (gpu:gpu-description gpu)) + (pk (gpu:gpu-limits gpu)) (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. @@ -399,11 +390,10 @@ border is disabled, otherwise it is enabled.") ((width height) (set! window-width width) (set! window-height height) - (atomic-box-set! default-viewport - (make-viewport 0 0 width height - #:clear-color clear-color)) - (atomic-box-set! default-projection - (orthographic-projection 0 width height 0 0 1)) + (refresh-default-texture-view! width height) + (set! default-viewport (make-viewport 0 0 width height)) + (set! default-projection + (orthographic-projection 0 width height 0 0 1)) (window-resize width height)))))) ;; Process all pending events. (let loop ((event (poll-event))) @@ -415,46 +405,50 @@ border is disabled, otherwise it is enabled.") (update dt) ;; Update audio after updating game state so that any sounds ;; that were queued to play this frame start playing immediately. - (update-audio) - ;; Free any GPU resources that have been GC'd. - (graphics-engine-reap! gfx)) - (define (render-sdl-opengl alpha) - (with-graphics-state! ((g:viewport (atomic-box-ref default-viewport))) - (clear-viewport) - (with-projection (atomic-box-ref default-projection) - (draw alpha))) - (sdl2:swap-gl-window (unwrap-window window))) + (update-audio)) + (define (draw-frame alpha) + ((@@ (chickadee graphics) begin-frame)) + (parameterize ((current-viewport default-viewport) + (current-projection default-projection) + (current-pass default-render-pass)) + (draw alpha)) + ((@@ (chickadee graphics) end-frame) (default-texture-view))) (define (on-error e stack) (error e stack) ;; Flush all input events that have occurred while in the error ;; state. (while (poll-event) #t)) - (dynamic-wind - (const #t) - (lambda () - (parameterize ((current-window window) - (current-graphics-engine gfx)) - ;; Attempt to activate vsync, if possible. Some systems do - ;; not support setting the OpenGL swap interval. - (catch #t - (lambda () - (sdl2:set-gl-swap-interval! 'vsync)) - (lambda args - (display "warning: could not enable vsync\n" - (current-error-port)))) - ;; Turn off multisampling by default. - (gl-disable (version-1-3 multisample)) - ;; Enable seamless cube maps. - (gl-enable (version-3-2 texture-cube-map-seamless)) - (sdl2:load-game-controller-mappings! - (scope-datadir "gamecontrollerdb.txt")) - (run-game* #:init load - #:update update-sdl - #:render render-sdl-opengl - #:error (and error on-error) - #:time elapsed-time - #:update-hz update-hz))) - (lambda () - (quit-audio) - (sdl2:delete-gl-context! (window-gl-context window)) - (sdl2:close-window! (unwrap-window window)))))) + (define (refresh-default-texture-view! width height) + (let* ((old (default-texture-view)) + (texture (make-texture #:name "Default texture" + #:width width + #:height height)) + (view (make-texture-view texture #:name "Default texture view"))) + (when old (destroy-texture-view old)) + (default-texture-view view))) + (parameterize ((current-window window) + (gpu:current-gpu gpu)) + (refresh-default-texture-view! window-width window-height) + ;; Attempt to activate vsync, if possible. Some systems do + ;; not support setting the OpenGL swap interval. + (catch #t + (lambda () + (sdl2:set-gl-swap-interval! 'vsync)) + (lambda args + (display "warning: could not enable vsync\n" + (current-error-port)))) + ;; Turn off multisampling by default. + ;; (gl-disable (version-1-3 multisample)) + ;; Enable seamless cube maps. + ;; (gl-enable (version-3-2 texture-cube-map-seamless)) + (sdl2:load-game-controller-mappings! + (scope-datadir "gamecontrollerdb.txt")) + (run-game* #:init load + #:update update-sdl + #:render draw-frame + #:error (and error on-error) + #:time elapsed-time + #:update-hz update-hz)) + (quit-audio) + (sdl2:delete-gl-context! (window-gl-context window)) + (sdl2:close-window! (unwrap-window window)))) |