diff options
34 files changed, 742 insertions, 1211 deletions
diff --git a/Makefile.am b/Makefile.am index a0bf9dd..09eff46 100644 --- a/Makefile.am +++ b/Makefile.am @@ -70,11 +70,6 @@ SOURCES = \ chickadee/graphics/gpu.scm \ chickadee/graphics/engine.scm \ chickadee/graphics/color.scm \ - chickadee/graphics/blend.scm \ - chickadee/graphics/polygon.scm \ - chickadee/graphics/depth.scm \ - chickadee/graphics/stencil.scm \ - chickadee/graphics/multisample.scm \ chickadee/graphics/buffer.scm \ chickadee/graphics/pixbuf.scm \ chickadee/graphics/texture.scm \ @@ -31,7 +31,7 @@ And of course on native targets we will now have the option of using whatever graphics API makes the most sense. Some big subtasks here: -- [ ] Decouple OpenGL state management from dynamic render context +- [X] Decouple OpenGL state management from dynamic render context - [ ] Refactor all OpenGL calls into a single module - [ ] Add generic WebGPU-like graphics API - [ ] Implement that API for OpenGL backend diff --git a/chickadee.scm b/chickadee.scm index 05f3d65..88928e1 100644 --- a/chickadee.scm +++ b/chickadee.scm @@ -28,6 +28,7 @@ #:use-module (chickadee graphics color) #:use-module (chickadee graphics engine) #:use-module (chickadee graphics gl) + #:use-module (chickadee graphics gpu) #:use-module (chickadee graphics viewport) #:use-module (chickadee utils) #:use-module (gl) @@ -306,14 +307,15 @@ border is disabled, otherwise it is enabled.") #:fullscreen? window-fullscreen? #:resizable? window-resizable? #:multisample? #f))) - (gfx (make-graphics-engine (window-gl-context window))) - (default-viewport (make-atomic-box + (default-viewport (vector (make-viewport 0 0 window-width window-height #:clear-color clear-color))) - (default-projection (make-atomic-box + (default-projection (vector (orthographic-projection 0 window-width window-height 0 - 0 1)))) + 0 1))) + (gpu (make-gpu (window-gl-context window))) + (gfx (make-graphics-engine 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 +401,11 @@ 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)) + (vector-set! default-viewport 0 + (make-viewport 0 0 width height + #:clear-color clear-color)) + (vector-set! default-projection 0 + (orthographic-projection 0 width height 0 0 1)) (window-resize width height)))))) ;; Process all pending events. (let loop ((event (poll-event))) @@ -417,11 +419,12 @@ border is disabled, otherwise it is enabled.") ;; 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)) + (graphics-engine-gc gfx)) (define (render-sdl-opengl alpha) - (with-graphics-state! ((g:viewport (atomic-box-ref default-viewport))) + (graphics-engine-reset! gfx) + (with-viewport (vector-ref default-viewport 0) (clear-viewport) - (with-projection (atomic-box-ref default-projection) + (with-graphics-state ((projection (vector-ref default-projection 0))) (draw alpha))) (sdl2:swap-gl-window (unwrap-window window))) (define (on-error e stack) diff --git a/chickadee/graphics/9-patch.scm b/chickadee/graphics/9-patch.scm index c023b25..5b74585 100644 --- a/chickadee/graphics/9-patch.scm +++ b/chickadee/graphics/9-patch.scm @@ -18,9 +18,9 @@ #:use-module (chickadee math matrix) #:use-module (chickadee math rect) #:use-module (chickadee math vector) - #:use-module (chickadee graphics blend) #:use-module (chickadee graphics color) #:use-module (chickadee graphics engine) + #:use-module (chickadee graphics gpu) #:use-module (chickadee graphics shader) #:use-module (chickadee graphics texture) #:use-module (chickadee graphics buffer) @@ -145,14 +145,14 @@ void main (void) { (x2 y1 s2 t1) (x2 y2 s2 t2) (x1 y2 s1 t2)) - (geometry-index-append! geometry 0 3 2 0 2 1))) + (geometry-index-append! geometry 0 2 3 0 1 2))) ;; Convert pixel margin values to GL texture values. (set-rect-x! margins (/ left-margin tw)) (set-rect-y! margins (/ right-margin tw)) (set-rect-width! margins (/ bottom-margin th)) (set-rect-height! margins (/ top-margin th)) - (with-graphics-state ((g:blend-mode blend-mode) - (g:texture-0 texture)) + (with-graphics-state ((blend-mode blend-mode) + (texture 0 (texture-id texture))) (shader-apply shader (geometry-vertex-array geometry) #:width w* diff --git a/chickadee/graphics/blend.scm b/chickadee/graphics/blend.scm deleted file mode 100644 index 7450c52..0000000 --- a/chickadee/graphics/blend.scm +++ /dev/null @@ -1,139 +0,0 @@ -;;; Chickadee Game Toolkit -;;; Copyright © 2016, 2021 David Thompson <dthompson2@worcester.edu> -;;; -;;; Licensed under the Apache License, Version 2.0 (the "License"); -;;; you may not use this file except in compliance with the License. -;;; You may obtain a copy of the License at -;;; -;;; http://www.apache.org/licenses/LICENSE-2.0 -;;; -;;; Unless required by applicable law or agreed to in writing, software -;;; distributed under the License is distributed on an "AS IS" BASIS, -;;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -;;; See the License for the specific language governing permissions and -;;; limitations under the License. - -(define-module (chickadee graphics blend) - #:use-module (chickadee graphics engine) - #:use-module (chickadee graphics gl) - #:use-module (gl) - #:use-module (ice-9 match) - #:use-module (srfi srfi-9) - #:export (make-blend-mode - blend-mode? - blend-mode-equation - blend-mode-source-function - blend-mode-destination-function - blend:alpha - blend:multiply - blend:subtract - blend:add - blend:lighten - blend:darken - blend:screen - blend:replace - g:blend-mode - current-blend-mode)) - -(define-record-type <blend-mode> - (make-blend-mode equation source-function destination-function) - blend-mode? - (equation blend-mode-equation) - (source-function blend-mode-source-function) - (destination-function blend-mode-destination-function)) - -(define blend:alpha - (make-blend-mode 'add 'source-alpha 'one-minus-source-alpha)) -(define blend:multiply - (make-blend-mode 'add 'destination-color 'zero)) -(define blend:subtract - (make-blend-mode 'reverse-subtract 'one 'zero)) -(define blend:add - (make-blend-mode 'add 'one 'one)) -(define blend:lighten - (make-blend-mode 'max 'one 'zero)) -(define blend:darken - (make-blend-mode 'min 'one 'zero)) -(define blend:screen - (make-blend-mode 'add 'one 'one-minus-source-color)) -(define blend:replace - (make-blend-mode 'add 'one 'zero)) - -(define (bind-blend-mode blend-mode) - (if blend-mode - (begin - (gl-enable (enable-cap blend)) - (gl-blend-equation - (match (blend-mode-equation blend-mode) - ('add - (blend-equation-mode-ext func-add-ext)) - ('subtract - (blend-equation-mode-ext func-subtract-ext)) - ('reverse-subtract - (blend-equation-mode-ext func-reverse-subtract-ext)) - ('min - (blend-equation-mode-ext min-ext)) - ('max - (blend-equation-mode-ext max-ext)) - ('alpha-min - (blend-equation-mode-ext alpha-min-sgix)) - ('alpha-max - (blend-equation-mode-ext alpha-min-sgix)))) - (gl-blend-func (match (blend-mode-source-function blend-mode) - ('zero - (blending-factor-src zero)) - ('one - (blending-factor-src one)) - ('destination-color - (blending-factor-src dst-color)) - ('one-minus-destination-color - (blending-factor-src one-minus-dst-color)) - ('source-alpha-saturate - (blending-factor-src src-alpha-saturate)) - ('source-alpha - (blending-factor-src src-alpha)) - ('one-minus-source-alpha - (blending-factor-src one-minus-src-alpha)) - ('destination-alpha - (blending-factor-src dst-alpha)) - ('one-minus-destination-alpha - (blending-factor-src one-minus-dst-alpha)) - ('constant-color - (blending-factor-src constant-color-ext)) - ('one-minus-constant-color - (blending-factor-src one-minus-constant-color-ext)) - ('contstant-alpha - (blending-factor-src constant-alpha-ext)) - ('one-minus-constant-alpha - (blending-factor-src one-minus-constant-alpha-ext))) - (match (blend-mode-destination-function blend-mode) - ('zero - (blending-factor-dest zero)) - ('one - (blending-factor-dest one)) - ('source-color - (blending-factor-dest src-color)) - ('one-minus-source-color - (blending-factor-dest one-minus-src-color)) - ('source-alpha - (blending-factor-dest src-alpha)) - ('one-minus-source-alpha - (blending-factor-dest one-minus-src-alpha)) - ('destination-alpha - (blending-factor-dest dst-alpha)) - ('one-minus-destination-alpha - (blending-factor-dest one-minus-dst-alpha)) - ('constant-color - (blending-factor-dest constant-color-ext)) - ('one-minus-constant-color - (blending-factor-dest one-minus-constant-color-ext)) - ('contstant-alpha - (blending-factor-dest constant-alpha-ext)) - ('one-minus-constant-alpha - (blending-factor-dest one-minus-constant-alpha-ext))))) - (gl-disable (enable-cap blend)))) - -(define-graphics-state g:blend-mode - current-blend-mode - #:default blend:replace - #:bind bind-blend-mode) diff --git a/chickadee/graphics/buffer.scm b/chickadee/graphics/buffer.scm index d16ab09..50b6d1c 100644 --- a/chickadee/graphics/buffer.scm +++ b/chickadee/graphics/buffer.scm @@ -34,6 +34,7 @@ #:use-module (chickadee graphics color) #:use-module (chickadee graphics engine) #:use-module (chickadee graphics gl) + #:use-module (chickadee graphics gpu) #:export (make-buffer buffer? index-buffer? @@ -124,7 +125,7 @@ (define (print-buffer buffer port) (format port - "#<buffer id: ~d name: ~s usage: ~s target: ~s length: ~d stride: ~s>" + "#<buffer id: ~s name: ~s usage: ~s target: ~s length: ~d stride: ~s>" (buffer-id buffer) (buffer-name buffer) (buffer-usage buffer) @@ -137,25 +138,6 @@ (define null-buffer (%make-buffer 0 "null" 0 0 'vertex 'static #f #f)) -(define (free-buffer buffer) - (gl-delete-buffer (buffer-id buffer))) - -(define (bind-buffer buffer) - (gl-bind-buffer (buffer-target-gl buffer) - (buffer-id buffer))) - -(define-graphics-finalizer buffer-finalizer - #:predicate buffer? - #:free free-buffer) - -(define-graphics-state g:buffer - current-buffer - #:default null-buffer - #:bind bind-buffer) - -(define (generate-buffer-gl) - (gl-generate-buffer)) - (define (index-buffer? buffer) "Return #t if VIEW is an index buffer view." (eq? (buffer-target buffer) 'index)) @@ -202,25 +184,19 @@ never sent to the GPU." (assert-current-graphics-engine) ;; Weird bugs will occur when creating a new vertex buffer while a ;; vertex array is bound. - (with-graphics-state! ((g:vertex-array null-vertex-array)) - (let ((buffer (%make-buffer (generate-buffer-gl) - name - length - stride - target - usage - #f + (with-graphics-state! ((vertex-array gpu-vertex-array:null)) + (let ((buffer (%make-buffer (fresh-gpu-buffer (current-gpu) target) + name length stride target usage #f (and (eq? usage 'stream) (make-hash-table))))) - (graphics-engine-guard! buffer) - (with-graphics-state! ((g:buffer buffer)) + (with-graphics-state! ((buffer (buffer-id buffer))) (gl-buffer-data (buffer-target-gl buffer) length (if data (bytevector->pointer data offset) %null-pointer) - (buffer-usage-gl buffer))) - buffer))) + (buffer-usage-gl buffer)) + buffer)))) (define (buffer-mapped? buffer) "Return #t if buffer data has been mapped from GPU." @@ -230,14 +206,19 @@ never sent to the GPU." ;; good throughput. However, it requires getting a new data pointer ;; every frame and allocating a Scheme bytevector for that memory ;; region. Allocating this bytevector every frame causes significant -;; GC pressure. It turns out that, GPU drivers tend to return the -;; same set of pointers over and over. So, by caching bytevectors for -;; those memory regions we avoid bytevector allocation after a frame -;; or two of warmup. +;; GC pressure. It turns out that GPU drivers tend to return the same +;; set of pointers over and over, or at least the driver I'm using +;; does this. So, by caching bytevectors for those memory regions we +;; avoid bytevector allocation after a frame or two of warmup. (define (pointer->bytevector/cached buffer pointer length) - (let ((cache (buffer-stream-cache buffer)) - (address (pointer-address pointer))) - (or (hashv-ref cache address) + (let* ((cache (buffer-stream-cache buffer)) + (address (pointer-address pointer)) + (cached (hashv-ref cache address))) + ;; It could be that there is a cached bytevector for the address, + ;; but the bytevector is a different length. We must treat this + ;; as a cache miss and allocate a new bytevector. + (if (and cached (= (bytevector-length cached) length)) + cached (let ((bv (pointer->bytevector pointer length))) (hashv-set! cache address bv) bv)))) @@ -250,7 +231,7 @@ vertex buffer data back to the GPU." (unless (buffer-mapped? buffer) ;; Don't map a buffer that is already mapped! (let ((target (buffer-target-gl buffer)) (length (buffer-length buffer))) - (with-graphics-state! ((g:buffer buffer)) + (with-graphics-state! ((buffer (buffer-id buffer))) (when (eq? (buffer-usage buffer) 'stream) ;; Orphan the buffer to avoid implicit synchronization. ;; See: https://www.opengl.org/wiki/Buffer_Object_Streaming#Buffer_re-specification @@ -268,7 +249,7 @@ vertex buffer data back to the GPU." (define (unmap-buffer! buffer) "Return the mapped vertex buffer data for BUFFER to the GPU." - (with-graphics-state! ((g:buffer buffer)) + (with-graphics-state! ((buffer (buffer-id buffer))) (gl-unmap-buffer (buffer-target-gl buffer)) (set-buffer-data! buffer #f))) @@ -420,7 +401,7 @@ element is used for 2 instances, and so on." ((double) (data-type double)))) (define (apply-vertex-attribute vertex-attribute attribute-index) - (with-graphics-state! ((g:buffer (vertex-attribute->buffer vertex-attribute))) + (with-graphics-state! ((buffer (buffer-id (vertex-attribute->buffer vertex-attribute)))) ;; If there is no attribute-index, we assume this is being bound for ;; use as an index buffer. (when attribute-index @@ -458,24 +439,6 @@ element is used for 2 instances, and so on." (define null-vertex-array (%make-vertex-array 0 #f '() 'triangles)) -(define (generate-vertex-array) - (gl-generate-vertex-array)) - -(define (free-vertex-array va) - (gl-delete-vertex-array (vertex-array-id va))) - -(define (bind-vertex-array va) - (gl-bind-vertex-array (vertex-array-id va))) - -(define-graphics-finalizer vertex-array-finalizer - #:predicate vertex-array? - #:free free-vertex-array) - -(define-graphics-state g:vertex-array - current-vertex-array - #:default null-vertex-array - #:bind bind-vertex-array) - (define* (make-vertex-array #:key indices attributes (mode 'triangles)) "Return a new vertex array using the index data within the typed buffer INDICES and the vertex attribute data within ATTRIBUTES, an @@ -494,20 +457,17 @@ argument may be overridden. The following values are supported: - triangle-strip - triangle-fan" (assert-current-graphics-engine) - (let ((array (%make-vertex-array (generate-vertex-array) + (let ((array (%make-vertex-array (fresh-gpu-vertex-array (current-gpu)) indices attributes mode))) - (graphics-engine-guard! array) - (with-graphics-state! ((g:vertex-array array)) + (with-graphics-state! ((vertex-array (vertex-array-id array))) (for-each (match-lambda ((index . vertex-attribute) (apply-vertex-attribute vertex-attribute index))) attributes) - (when indices (apply-vertex-attribute indices #f))) - ;; Restore the old array. Is this needed? - ;; (graphics-engine-commit!) - array)) + (when indices (apply-vertex-attribute indices #f)) + array))) (define (vertex-array-mode-gl array) (case (vertex-array-mode array) @@ -520,10 +480,12 @@ argument may be overridden. The following values are supported: ((triangle-fan) (begin-mode triangle-fan)))) (define (render-vertices array count offset) - (with-graphics-state! ((g:vertex-array array)) + (with-graphics-state! ((vertex-array (vertex-array-id array))) (let ((indices (vertex-array-indices array))) (if indices (begin + ;; This shouldn't be here but I get weird rendering issues + ;; otherwise whyyyyyy?? (apply-vertex-attribute indices #f) (gl-draw-elements (vertex-array-mode-gl array) (or count @@ -538,7 +500,7 @@ argument may be overridden. The following values are supported: 0)))))))) (define (render-vertices/instanced array instances count offset) - (with-graphics-state! ((g:vertex-array array)) + (with-graphics-state! ((vertex-array (vertex-array-id array))) (let ((indices (vertex-array-indices array))) (if indices (begin diff --git a/chickadee/graphics/color.scm b/chickadee/graphics/color.scm index 78e4c75..5548c87 100644 --- a/chickadee/graphics/color.scm +++ b/chickadee/graphics/color.scm @@ -20,7 +20,6 @@ ;;; Code: (define-module (chickadee graphics color) - #:use-module (chickadee graphics engine) #:use-module (chickadee graphics gl) #:use-module (chickadee math) #:use-module (ice-9 format) @@ -391,8 +390,3 @@ a color object." (color-mask-green? mask) (color-mask-blue? mask) (color-mask-alpha? mask))) - -(define-graphics-state g:color-mask - current-color-mask - #:default default-color-mask - #:bind bind-color-mask) diff --git a/chickadee/graphics/depth.scm b/chickadee/graphics/depth.scm deleted file mode 100644 index 2c1e901..0000000 --- a/chickadee/graphics/depth.scm +++ /dev/null @@ -1,65 +0,0 @@ -;;; Chickadee Game Toolkit -;;; Copyright © 2020, 2021 David Thompson <dthompson2@worcester.edu> -;;; -;;; Licensed under the Apache License, Version 2.0 (the "License"); -;;; you may not use this file except in compliance with the License. -;;; You may obtain a copy of the License at -;;; -;;; http://www.apache.org/licenses/LICENSE-2.0 -;;; -;;; Unless required by applicable law or agreed to in writing, software -;;; distributed under the License is distributed on an "AS IS" BASIS, -;;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -;;; See the License for the specific language governing permissions and -;;; limitations under the License. - -(define-module (chickadee graphics depth) - #:use-module (ice-9 match) - #:use-module (gl) - #:use-module (chickadee graphics engine) - #:use-module (chickadee graphics gl) - #:use-module (srfi srfi-9) - #:export (make-depth-test - depth-test? - depth-test-write? - depth-test-function - depth-test-near - depth-test-far - basic-depth-test - g:depth-test - current-depth-test)) - -(define-record-type <depth-test> - (%make-depth-test write? function near far) - depth-test? - (write? depth-test-write?) - (function depth-test-function) - (near depth-test-near) - (far depth-test-far)) - -(define* (make-depth-test #:key (write? #t) (function 'less-than) (near 0.0) (far 1.0)) - (%make-depth-test write? function near far)) - -(define basic-depth-test (make-depth-test)) - -(define (bind-depth-test depth-test) - (if depth-test - (let ((glfunc (match (depth-test-function depth-test) - ('always (depth-function always)) - ('never (depth-function never)) - ('equal (depth-function equal)) - ('not-equal (depth-function notequal)) - ('less-than (depth-function less)) - ('less-than-or-equal (depth-function lequal)) - ('greater-than (depth-function greater)) - ('greater-than-or-equal (depth-function gequal))))) - (gl-enable (enable-cap depth-test)) - (gl-depth-func glfunc) - (gl-depth-mask (depth-test-write? depth-test)) - (gl-depth-range (depth-test-near depth-test) (depth-test-far depth-test))) - (gl-disable (enable-cap depth-test)))) - -(define-graphics-state g:depth-test - current-depth-test - #:default #f - #:bind bind-depth-test) diff --git a/chickadee/graphics/engine.scm b/chickadee/graphics/engine.scm index 9598e91..8759ee6 100644 --- a/chickadee/graphics/engine.scm +++ b/chickadee/graphics/engine.scm @@ -1,6 +1,7 @@ (define-module (chickadee graphics engine) #:use-module (chickadee data array-list) - #:use-module (chickadee graphics gl) + #:use-module (chickadee graphics color) + #:use-module (chickadee graphics gpu) #:use-module (chickadee math matrix) #:use-module (gl) #:use-module (ice-9 atomic) @@ -9,136 +10,28 @@ #:use-module (srfi srfi-1) #:use-module (srfi srfi-9) #:use-module (system foreign) - #:export (define-graphics-state - define-graphics-finalizer - define-graphics-variable + #:export (define-graphics-variable make-graphics-engine graphics-engine? - graphics-engine-gl-context - graphics-engine-gl-version + graphics-engine-gpu graphics-engine-glsl-version graphics-engine-max-texture-size - graphics-engine-state-ref + graphics-engine-context graphics-variable-ref graphics-variable-set! + graphics-engine-reset! graphics-engine-commit! - graphics-engine-guard! - graphics-engine-reap! + graphics-engine-gc current-graphics-engine - assert-current-graphics-engine + current-gpu current-projection - with-projection + current-viewport + assert-current-graphics-engine with-graphics-state with-graphics-state!)) ;;; -;;; States -;;; - -;; A "graphics state" is CPU-side storage for GPU-side state. The -;; goal is to track changes and minimize the number of GPU state -;; changes (because they are expensive) by only communicating with the -;; GPU when the value really needs updating. - -(define-record-type <graphics-state-spec> - (%make-graphics-state-spec id name default binder) - graphics-state-spec? - (id graphics-state-spec-id) - (name graphics-state-spec-name) - (default graphics-state-spec-default) - (binder graphics-state-spec-binder)) - -(define* (make-graphics-state-spec id name #:key default bind) - (%make-graphics-state-spec id name default bind)) - -(define-record-type <graphics-state> - (%make-graphics-state binder value bound-value dirty? stack) - graphics-state? - (binder graphics-state-binder) - (value graphics-state-ref %graphics-state-set!) - (bound-value graphics-state-bound-value set-graphics-state-bound-value!) - (dirty? graphics-state-dirty? set-graphics-state-dirty!) - (stack graphics-state-stack)) - -(define (make-graphics-state bind default) - (%make-graphics-state bind default default #f (make-array-list))) - -(define (graphics-state-set! state new-value) - (graphics-state-binder state) new-value - (let ((current-value (graphics-state-bound-value state))) - (%graphics-state-set! state new-value) - (set-graphics-state-dirty! state (not (eq? new-value current-value))))) - -(define (graphics-state-push! state new-value) - (array-list-push! (graphics-state-stack state) (graphics-state-ref state)) - (graphics-state-set! state new-value)) - -(define (graphics-state-pop! state) - (graphics-state-set! state (array-list-pop! (graphics-state-stack state)))) - -(define (graphics-state-bind-maybe state) - (when (graphics-state-dirty? state) - (let ((x (graphics-state-ref state))) - ((graphics-state-binder state) x) - (set-graphics-state-bound-value! state x) - (set-graphics-state-dirty! state #f)))) - -(define *graphics-states* (make-array-list)) - -;; Box the counter so the compiler doesn't do constant propagation on -;; it and screw everything up. -(define *graphics-state-id-counter* (vector 0)) - -(define (next-graphics-state-id) - (let ((id (vector-ref *graphics-state-id-counter* 0))) - (vector-set! *graphics-state-id-counter* 0 (+ id 1)) - id)) - -(define-syntax-rule (define-graphics-state name getter args ...) - (begin - (define name - (let* ((id (next-graphics-state-id)) - (spec (make-graphics-state-spec id 'name args ...))) - (array-list-push! *graphics-states* spec) - (when (current-graphics-engine) - (install-graphics-state (current-graphics-engine) spec)) - spec)) - (define* (getter #:optional (engine (current-graphics-engine))) - (graphics-engine-state-ref name engine)))) - - -;;; -;;; Finalizers -;;; - -;; Graphics finalizers delete GPU-side resources when Guile is ready -;; to GC them. - -(define-record-type <graphics-finalizer> - (%make-graphics-finalizer name predicate free) - graphics-finalizer? - (name graphics-finalizer-name) - (predicate graphics-finalizer-predicate) - (free graphics-finalizer-free)) - -(define* (make-graphics-finalizer name #:key predicate free) - (%make-graphics-finalizer name predicate free)) - -;; Need to box this value so that the compiler doesn't inline the -;; initial value everywhere. -(define *graphics-finalizers* (make-atomic-box '())) - -(define-syntax-rule (define-graphics-finalizer name args ...) - (define name - (let ((finalizer (make-graphics-finalizer 'name args ...))) - (atomic-box-set! *graphics-finalizers* - (cons (cons 'name finalizer) - (atomic-box-ref *graphics-finalizers*))) - finalizer))) - - -;;; ;;; Variables ;;; @@ -167,124 +60,142 @@ ;;; +;;; Render Context +;;; + +(define-record-type <render-context> + (%make-render-context textures) + render-context? + (projection render-context-projection set-render-context-projection!) + (front-face render-context-front-face set-render-context-front-face!) + (blend-mode render-context-blend-mode set-render-context-blend-mode!) + (cull-face-mode render-context-cull-face-mode set-render-context-cull-face-mode!) + (polygon-mode render-context-polygon-mode set-render-context-polygon-mode!) + (color-mask render-context-color-mask set-render-context-color-mask!) + (depth-test render-context-depth-test set-render-context-depth-test!) + (stencil-test render-context-stencil-test set-render-context-stencil-test!) + (scissor-test render-context-scissor-test set-render-context-scissor-test!) + (viewport render-context-viewport set-render-context-viewport!) + (clear-color render-context-clear-color set-render-context-clear-color!) + (multisample? render-context-multisample? set-render-context-multisample!) + (framebuffer render-context-framebuffer set-render-context-framebuffer!) + (vertex-array render-context-vertex-array set-render-context-vertex-array!) + (buffer render-context-buffer set-render-context-buffer!) + (program render-context-program set-render-context-program!) + (textures render-context-textures)) + +(define (make-render-context n-textures) + (let ((context (%make-render-context (make-vector n-textures)))) + (render-context-reset! context) + context)) + +(define (render-context-texture context i) + (vector-ref (render-context-textures context) i)) + +(define (set-render-context-texture! context i texture) + (vector-set! (render-context-textures context) i texture)) + +(define %identity-matrix (make-identity-matrix4)) + +(define (render-context-reset! context) + (set-render-context-projection! context %identity-matrix) + (set-render-context-front-face! context front-face:ccw) + (set-render-context-blend-mode! context blend:replace) + (set-render-context-cull-face-mode! context cull-face:back) + (set-render-context-polygon-mode! context polygon:fill) + (set-render-context-color-mask! context color-mask:all) + (set-render-context-depth-test! context #f) + (set-render-context-stencil-test! context #f) + (set-render-context-scissor-test! context #f) + (set-render-context-viewport! context window-rect:empty) + (set-render-context-clear-color! context black) + (set-render-context-multisample! context #f) + (set-render-context-framebuffer! context gpu-framebuffer:null) + (set-render-context-buffer! context gpu-buffer:null) + (set-render-context-vertex-array! context gpu-vertex-array:null) + (set-render-context-program! context gpu-program:null) + (let ((textures (render-context-textures context))) + (let loop ((i 0)) + (when (< i (vector-length textures)) + (set-render-context-texture! context i gpu-texture:null) + (loop (+ i 1)))))) + +(define (render-context-apply! context gpu) + (set-gpu-front-face! gpu (render-context-front-face context)) + (set-gpu-blend-mode! gpu (render-context-blend-mode context)) + (set-gpu-cull-face-mode! gpu (render-context-cull-face-mode context)) + (set-gpu-polygon-mode! gpu (render-context-polygon-mode context)) + (set-gpu-color-mask! gpu (render-context-color-mask context)) + (set-gpu-depth-test! gpu (render-context-depth-test context)) + (set-gpu-stencil-test! gpu (render-context-stencil-test context)) + (set-gpu-scissor-test! gpu (render-context-scissor-test context)) + (set-gpu-viewport! gpu (render-context-viewport context)) + (set-gpu-clear-color! gpu (render-context-clear-color context)) + (set-gpu-multisample! gpu (render-context-multisample? context)) + (set-gpu-framebuffer! gpu (render-context-framebuffer context)) + (set-gpu-buffer! gpu (render-context-buffer context)) + (set-gpu-vertex-array! gpu (render-context-vertex-array context)) + (set-gpu-program! gpu (render-context-program context)) + (let ((textures (render-context-textures context))) + (let loop ((i 0)) + (when (< i (vector-length textures)) + (set-gpu-texture! gpu i (vector-ref textures i)) + (loop (+ i 1)))))) + + +;;; ;;; Engine ;;; (define-record-type <graphics-engine> - (%make-graphics-engine gl-context gl-version glsl-version max-texture-size - projection-matrix guardian states variables) + (%make-graphics-engine gpu context variables) graphics-engine? - (gl-context %graphics-engine-gl-context) - (gl-version %graphics-engine-gl-version) - (glsl-version %graphics-engine-glsl-version) - (max-texture-size %graphics-engine-max-texture-size) - (projection-matrix %graphics-engine-projection-matrix - %set-graphics-engine-projection-matrix!) - (guardian graphics-engine-guardian) - (states graphics-engine-states) + (gpu graphics-engine-gpu) + (context graphics-engine-context) (variables graphics-engine-variables)) -(define (install-graphics-state engine spec) - (let ((binder (graphics-state-spec-binder spec)) - (default (graphics-state-spec-default spec)) - (states (graphics-engine-states engine)) - (id (graphics-state-spec-id spec))) - (unless (> (array-list-size states) id) - (let loop ((i (array-list-size states))) - (unless (> i id) - (array-list-push! states #f) - (loop (+ i 1))))) - (array-list-set! states id (make-graphics-state binder default)))) +(define (graphics-engine-glsl-version engine) + (gpu-glsl-version (graphics-engine-gpu engine))) + +(define (graphics-engine-max-texture-size engine) + (gpu-max-texture-size (graphics-engine-gpu engine))) (define (install-graphics-variable engine var) (hashq-set! (graphics-engine-variables engine) var (eval-graphics-variable var))) -(define (make-graphics-engine gl-context) - (define (max-texture-size) - (let ((bv (make-s32vector 1))) - (gl-get-integer-v (get-p-name max-texture-size) - (bytevector->pointer bv)) - (s32vector-ref bv 0))) - (define (max-texture-units) - (let ((bv (make-s32vector 1))) - (gl-get-integer-v (version-1-3 max-texture-units) - (bytevector->pointer bv)) - (s32vector-ref bv 0))) - (define (extract-version attr) - (car (string-split (pointer->string (gl-get-string attr)) #\space))) - (define (glsl-version) - (extract-version (version-2-0 shading-language-version))) - (pk 'max-texture-units (max-texture-units)) - (let ((engine (%make-graphics-engine gl-context - (extract-version (string-name version)) - (glsl-version) - (pk 'max-texture-size (max-texture-size)) - (make-identity-matrix4) - (make-guardian) - (make-array-list) - (make-hash-table)))) +(define current-graphics-engine (make-parameter #f)) + +(define (current-gpu) + (graphics-engine-gpu (current-graphics-engine))) + +(define (current-projection) + (render-context-projection + (graphics-engine-context + (current-graphics-engine)))) + +(define (current-viewport) + (render-context-viewport + (graphics-engine-context + (current-graphics-engine)))) + +(define-syntax-rule (assert-current-graphics-engine) + (unless (current-graphics-engine) + (error "No active graphics engine. Make sure the game loop is running before calling this procedure."))) + +(define (make-graphics-engine gpu) + (let* ((context (make-render-context (gpu-max-texture-units gpu))) + (engine (%make-graphics-engine gpu context (make-hash-table)))) ;; Variable initialization must be delayed until after engine ;; creation because variable initializers may modify graphics ;; engine state to create shaders, textures, etc. (parameterize ((current-graphics-engine engine)) - (array-list-for-each (lambda (i spec) - (install-graphics-state engine spec)) - *graphics-states*) (hash-for-each (lambda (key var) (install-graphics-variable engine var)) *graphics-variables*)) engine)) -(define current-graphics-engine (make-parameter #f)) - -(define-syntax-rule (assert-current-graphics-engine) - (unless (current-graphics-engine) - (error "No active graphics engine. Make sure the game loop is running before calling this procedure."))) - -(define* (graphics-engine-gl-context #:optional (engine (current-graphics-engine))) - (%graphics-engine-gl-context engine)) - -(define* (graphics-engine-gl-version #:optional (engine (current-graphics-engine))) - (%graphics-engine-gl-version engine)) - -(define* (graphics-engine-glsl-version #:optional (engine (current-graphics-engine))) - (%graphics-engine-glsl-version engine)) - -(define* (graphics-engine-max-texture-size #:optional (engine (current-graphics-engine))) - (%graphics-engine-max-texture-size engine)) - -(define* (current-projection #:optional (engine (current-graphics-engine))) - (%graphics-engine-projection-matrix engine)) - -(define-syntax-rule (with-projection matrix body ...) - (let ((old (current-projection))) - (set-graphics-engine-projection-matrix! matrix) - (let ((result (begin body ...))) - (set-graphics-engine-projection-matrix! old) - result))) - -(define* (set-graphics-engine-projection-matrix! matrix #:optional (engine (current-graphics-engine))) - (%set-graphics-engine-projection-matrix! engine matrix)) - -(define (graphics-engine-lookup-state engine spec) - (array-list-ref (graphics-engine-states engine) - (graphics-state-spec-id spec))) - -(define* (graphics-engine-state-ref spec #:optional - (engine (current-graphics-engine))) - (let ((state (graphics-engine-lookup-state engine spec))) - (and state (graphics-state-ref state)))) - -(define* (graphics-engine-state-push! spec value #:optional - (engine (current-graphics-engine))) - (graphics-state-push! (graphics-engine-lookup-state engine spec) value)) - -(define* (graphics-engine-state-pop! spec #:optional - (engine (current-graphics-engine))) - (graphics-state-pop! (graphics-engine-lookup-state engine spec))) - (define* (graphics-variable-ref var #:optional (engine (current-graphics-engine))) (hashq-ref (graphics-engine-variables engine) var)) @@ -293,43 +204,221 @@ (engine (current-graphics-engine))) (hashq-set! (graphics-engine-variables engine) var value)) - -;; HACK: This *should* be in graphics-engine-commit! but for some -;; reason Guile's compiler is generating inefficient bytecode that -;; allocates a closure even though it should be completely -;; unnecessary. Defining this procedure at the top-level fixes it. -(define (maybe-bind _id state) - (graphics-state-bind-maybe state)) - -(define (graphics-engine-commit!) - (array-list-for-each maybe-bind - (graphics-engine-states (current-graphics-engine)))) - -(define* (graphics-engine-guard! obj #:optional - (engine (current-graphics-engine))) - ((graphics-engine-guardian engine) obj)) - -(define* (graphics-engine-reap! #:optional (engine (current-graphics-engine))) - (let ((guardian (graphics-engine-guardian engine))) - (let loop ((obj (guardian))) - (when obj - (unless (find (match-lambda - ((name . f) - (and ((graphics-finalizer-predicate f) obj) - ((graphics-finalizer-free f) obj) - #t))) - (atomic-box-ref *graphics-finalizers*)) - (error "no finalizer for graphics engine object" obj)) - (loop (guardian)))))) - -(define-syntax-rule (with-graphics-state ((spec value) ...) body ...) - (begin - (graphics-engine-state-push! spec value) ... - (let ((result (begin body ...))) - (graphics-engine-state-pop! spec) ... - result) )) - -(define-syntax-rule (with-graphics-state! ((spec value) ...) body ...) - (with-graphics-state ((spec value) ...) - (graphics-engine-commit!) - body ...)) +(define (graphics-engine-reset! engine) + (gpu-reset! (graphics-engine-gpu engine)) + (render-context-reset! (graphics-engine-context engine))) + +(define (graphics-engine-commit! engine) + (render-context-apply! (graphics-engine-context engine) + (graphics-engine-gpu engine))) + +(define (graphics-engine-gc engine) + (gpu-gc (graphics-engine-gpu engine))) + +;; (define-syntax context-getter +;; (syntax-rules (projection front-face blend-mode cull-face-mode polygon-mode +;; color-mask depth-test stencil-test scissor-test +;; viewport clear-color multisample? framebuffer +;; vertex-array program) +;; ((_ projection) render-context-projection) +;; ((_ front-face) render-context-front-face) +;; ((_ blend-mode) render-context-blend-mode) +;; ((_ cull-face-mode) render-context-cull-face-mode) +;; ((_ polygon-mode) render-context-polygon-mode) +;; ((_ color-mask) render-context-color-mask) +;; ((_ depth-test) render-context-depth-test) +;; ((_ stencil-test) render-context-stencil-test) +;; ((_ scissor-test) render-context-scissor-test) +;; ((_ viewport) render-context-viewport) +;; ((_ clear-color) render-context-clear-color) +;; ((_ multisample?) render-context-multisample?) +;; ((_ framebuffer) render-context-framebuffer) +;; ((_ vertex-array) render-context-vertex-array) +;; ((_ program) render-context-program))) + +;; (define-syntax context-setter +;; (syntax-rules (projection front-face blend-mode cull-face-mode polygon-mode +;; color-mask depth-test stencil-test scissor-test +;; viewport clear-color multisample? framebuffer +;; vertex-array program) +;; ((_ projection) set-render-context-projection!) +;; ((_ front-face) set-render-context-front-face!) +;; ((_ blend-mode) set-render-context-blend-mode!) +;; ((_ cull-face-mode) set-render-context-cull-face-mode!) +;; ((_ polygon-mode) set-render-context-polygon-mode!) +;; ((_ color-mask) set-render-context-color-mask!) +;; ((_ depth-test) set-render-context-depth-test!) +;; ((_ stencil-test) set-render-context-stencil-test!) +;; ((_ scissor-test) set-render-context-scissor-test!) +;; ((_ viewport) set-render-context-viewport!) +;; ((_ clear-color) set-render-context-clear-color!) +;; ((_ multisample?) set-render-context-multisample!) +;; ((_ framebuffer) set-render-context-framebuffer!) +;; ((_ vertex-array) set-render-context-vertex-array!) +;; ((_ program) set-render-context-program!))) + +;; (define-syntax current-state +;; (syntax-rules (projection front-face blend-mode cull-face-mode polygon-mode +;; color-mask depth-test stencil-test scissor-test +;; viewport clear-color multisample? framebuffer +;; vertex-array program) +;; ((_ context projection) +;; (render-context-projection context)) +;; ((_ context front-face) +;; (render-context-front-face context)) +;; ((_ context blend-mode) +;; (render-context-blend-mode context)) +;; ((_ context cull-face-mode) +;; (render-context-cull-face-mode context)) +;; ((_ context polygon-mode) +;; (render-context-polygon-mode context)) +;; ((_ context color-mask) +;; (render-context-color-mask context)) +;; ((_ context depth-test) +;; (render-context-depth-test context)) +;; ((_ context stencil-test) +;; (render-context-stencil-test context)) +;; ((_ context scissor-test) +;; (render-context-scissor-test context)) +;; ((_ context viewport) +;; (render-context-viewport context)) +;; ((_ context clear-color) +;; (render-context-clear-color context)) +;; ((_ context multisample?) +;; (render-context-multisample? context)) +;; ((_ context framebuffer) +;; (render-context-framebuffer context)) +;; ((_ context vertex-array) +;; (render-context-vertex-array context)) +;; ((_ context program) +;; (render-context-program context)))) + +;; (define-syntax change-state +;; (syntax-rules (projection front-face blend-mode cull-face-mode polygon-mode +;; color-mask depth-test stencil-test scissor-test +;; viewport clear-color multisample? framebuffer +;; vertex-array program) +;; ((_ context projection new) +;; (set-render-context-projection! context new)) +;; ((_ context front-face new) +;; (set-render-context-front-face! context new)) +;; ((_ context blend-mode new) +;; (set-render-context-blend-mode! context new)) +;; ((_ context cull-face-mode new) +;; (set-render-context-cull-face-mode! context new)) +;; ((_ context polygon-mode new) +;; (set-render-context-polygon-mode! context new)) +;; ((_ context color-mask new) +;; (set-render-context-color-mask! context new)) +;; ((_ context depth-test new) +;; (set-render-context-depth-test! context new)) +;; ((_ context stencil-test new) +;; (set-render-context-stencil-test! context new)) +;; ((_ context scissor-test new) +;; (set-render-context-scissor-test! context new)) +;; ((_ context viewport new) +;; (set-render-context-viewport! context new)) +;; ((_ context clear-color new) +;; (set-render-context-clear-color! context new)) +;; ((_ context multisample? new) +;; (set-render-context-multisample?! context new)) +;; ((_ context framebuffer new) +;; (set-render-context-framebuffer! context new)) +;; ((_ context vertex-array new) +;; (set-render-context-vertex-array! context new)) +;; ((_ context program new) +;; (set-render-context-program! context new)))) + +;; (define-syntax %with-graphics-state +;; (syntax-rules (projection front-face blend-mode cull-face-mode polygon-mode +;; color-mask depth-test stencil-test scissor-test +;; viewport clear-color multisample? framebuffer +;; vertex-array program texture) +;; ((_ context () body ...) +;; (begin body ...)) +;; ((_ context ((texture i new) . rest) body ...) +;; (let ((old (render-context-texture context i))) +;; (set-render-context-texture! context i new) +;; (%with-graphics-state context rest body ...) +;; (set-render-context-texture! context i old))) +;; ((_ context ((param new) . rest) body ...) +;; (let ((old ((context-getter param) context))) +;; ((context-setter param) context new) +;; (%with-graphics-state context rest body ...) +;; ((context-setter param) context old))))) + +(define-syntax context-getter + (lambda (x) + (syntax-case x () + ((_ name) + (match (syntax->datum #'name) + ('projection #'render-context-projection) + ('front-face #'render-context-front-face) + ('blend-mode #'render-context-blend-mode) + ('cull-face-mode #'render-context-cull-face-mode) + ('polygon-mode #'render-context-polygon-mode) + ('color-mask #'render-context-color-mask) + ('depth-test #'render-context-depth-test) + ('stencil-test #'render-context-stencil-test) + ('scissor-test #'render-context-scissor-test) + ('viewport #'render-context-viewport) + ('clear-color #'render-context-clear-color) + ('multisample? #'render-context-multisample?) + ('framebuffer #'render-context-framebuffer) + ('buffer #'render-context-buffer) + ('vertex-array #'render-context-vertex-array) + ('program #'render-context-program)))))) + +(define-syntax context-setter + (lambda (x) + (syntax-case x () + ((_ name) + (match (syntax->datum #'name) + ('projection #'set-render-context-projection!) + ('front-face #'set-render-context-front-face!) + ('blend-mode #'set-render-context-blend-mode!) + ('cull-face-mode #'set-render-context-cull-face-mode!) + ('polygon-mode #'set-render-context-polygon-mode!) + ('color-mask #'set-render-context-color-mask!) + ('depth-test #'set-render-context-depth-test!) + ('stencil-test #'set-render-context-stencil-test!) + ('scissor-test #'set-render-context-scissor-test!) + ('viewport #'set-render-context-viewport!) + ('clear-color #'set-render-context-clear-color!) + ('multisample? #'set-render-context-multisample!) + ('framebuffer #'set-render-context-framebuffer!) + ('buffer #'set-render-context-buffer!) + ('vertex-array #'set-render-context-vertex-array!) + ('program #'set-render-context-program!)))))) + +(define-syntax %with-graphics-state + (lambda (x) + (syntax-case x () + ((_ context () body ...) + #'(let () body ...)) + ((_ context ((name i new) . rest) body ...) + (and (identifier? #'name) (eq? (syntax->datum #'name) 'texture)) + #'(let ((old (render-context-texture context i))) + (set-render-context-texture! context i new) + (let ((result (%with-graphics-state context rest body ...))) + (set-render-context-texture! context i old) + result))) + ((_ context ((name new) . rest) body ...) + (identifier? #'name) + #'(let ((old ((context-getter name) context))) + ((context-setter name) context new) + (let ((result (%with-graphics-state context rest body ...))) + ((context-setter name) context old) + result)))))) + +(define-syntax-rule (with-graphics-state settings body ...) + (let ((context (graphics-engine-context (current-graphics-engine)))) + (%with-graphics-state context settings body ...))) + +(define-syntax-rule (with-graphics-state! settings body ...) + (let* ((engine (current-graphics-engine)) + (context (graphics-engine-context engine))) + (%with-graphics-state context settings + (let () + (graphics-engine-commit! engine) + body ...)))) diff --git a/chickadee/graphics/framebuffer.scm b/chickadee/graphics/framebuffer.scm index bee4b7d..f4f3100 100644 --- a/chickadee/graphics/framebuffer.scm +++ b/chickadee/graphics/framebuffer.scm @@ -29,6 +29,7 @@ #:use-module (chickadee graphics color) #:use-module (chickadee graphics engine) #:use-module (chickadee graphics gl) + #:use-module (chickadee graphics gpu) #:use-module (chickadee graphics pixbuf) #:use-module ((chickadee graphics texture) #:select (make-texture null-texture)) #:use-module (chickadee graphics viewport) @@ -42,18 +43,6 @@ current-framebuffer with-framebuffer)) -(define (generate-framebuffer) - "Generate a new OpenGL framebuffer object." - (let ((bv (u32vector 1))) - (gl-gen-framebuffers 1 (bytevector->pointer bv)) - (u32vector-ref bv 0))) - -(define (generate-renderbuffer) - "Generate a new OpenGL renderbuffer object." - (let ((bv (u32vector 1))) - (gl-gen-renderbuffers 1 (bytevector->pointer bv)) - (u32vector-ref bv 0))) - (define-record-type <framebuffer> (%make-framebuffer id renderbuffer-id texture viewport projection) framebuffer? @@ -66,33 +55,6 @@ (define null-framebuffer (%make-framebuffer 0 0 null-texture null-viewport (make-identity-matrix4))) -(define (free-framebuffer framebuffer) - (gl-delete-renderbuffers 1 - (bytevector->pointer - (u32vector - (framebuffer-renderbuffer-id framebuffer)))) - (gl-delete-framebuffers 1 - (bytevector->pointer - (u32vector - (framebuffer-id framebuffer))))) - -(define (apply-framebuffer framebuffer) - (gl-bind-framebuffer (version-3-0 framebuffer) - (framebuffer-id framebuffer))) - -(define (bind-framebuffer framebuffer) - (gl-bind-framebuffer (version-3-0 framebuffer) - (framebuffer-id framebuffer))) - -(define-graphics-finalizer framebuffer-finalizer - #:predicate framebuffer? - #:free free-framebuffer) - -(define-graphics-state g:framebuffer - current-framebuffer - #:default null-framebuffer - #:bind bind-framebuffer) - (define %clear-color (transparency 0.0)) (define %draw-buffers (bytevector->pointer (u32vector (version-3-0 color-attachment0)))) @@ -101,8 +63,9 @@ "Create a new framebuffer that renders to a texture with dimensions WIDTH x HEIGHT." (assert-current-graphics-engine) - (let* ((framebuffer-id (generate-framebuffer)) - (renderbuffer-id (generate-renderbuffer)) + (let* ((gpu (current-gpu)) + (framebuffer-id (fresh-gpu-framebuffer gpu)) + (renderbuffer-id (fresh-gpu-renderbuffer gpu)) (texture (make-texture width height #:min-filter min-filter #:mag-filter mag-filter @@ -120,28 +83,28 @@ dimensions WIDTH x HEIGHT." texture viewport projection))) - (graphics-engine-guard! framebuffer) - (with-graphics-state! ((g:framebuffer framebuffer)) - ;; Setup depth buffer. - (gl-bind-renderbuffer (version-3-0 renderbuffer) - renderbuffer-id) - (gl-renderbuffer-storage (version-3-0 renderbuffer) - (arb-framebuffer-object depth24-stencil8) - width - height) - (gl-bind-renderbuffer (version-3-0 renderbuffer) 0) - (gl-framebuffer-renderbuffer (version-3-0 framebuffer) - (arb-framebuffer-object depth-stencil-attachment) - (version-3-0 renderbuffer) - renderbuffer-id) - ;; Setup framebuffer. - (gl-framebuffer-texture-2d (version-3-0 framebuffer) - (version-3-0 color-attachment0) - (texture-target texture-2d) - ((@@ (chickadee graphics texture) texture-id) - texture) - 0) - (gl-draw-buffers 1 %draw-buffers)) + (set-gpu-renderbuffer! gpu renderbuffer-id) + (set-gpu-framebuffer! gpu framebuffer-id) + ;; Setup depth buffer. + (gl-bind-renderbuffer (version-3-0 renderbuffer) + renderbuffer-id) + (gl-renderbuffer-storage (version-3-0 renderbuffer) + (arb-framebuffer-object depth24-stencil8) + width + height) + (gl-bind-renderbuffer (version-3-0 renderbuffer) 0) + (gl-framebuffer-renderbuffer (version-3-0 framebuffer) + (arb-framebuffer-object depth-stencil-attachment) + (version-3-0 renderbuffer) + renderbuffer-id) + ;; Setup framebuffer. + (gl-framebuffer-texture-2d (version-3-0 framebuffer) + (version-3-0 color-attachment0) + (texture-target texture-2d) + ((@@ (chickadee graphics texture) texture-id) + texture) + 0) + (gl-draw-buffers 1 %draw-buffers) ;; Check for errors. (unless (= (gl-check-framebuffer-status (version-3-0 framebuffer)) (version-3-0 framebuffer-complete)) @@ -153,8 +116,8 @@ dimensions WIDTH x HEIGHT." ;; as well so that the user doesn't have to explicitly make a ;; viewport and/or projection matrix unless they actually want to do ;; fancy viewport manipulations. - (with-graphics-state! ((g:framebuffer framebuffer) - (g:viewport (framebuffer-viewport framebuffer))) - (clear-viewport) - (with-projection (framebuffer-projection framebuffer) + (with-graphics-state ((framebuffer (framebuffer-id framebuffer)) + (projection (framebuffer-projection framebuffer))) + (with-viewport (framebuffer-viewport framebuffer) + (clear-viewport) body ...))) diff --git a/chickadee/graphics/gpu.scm b/chickadee/graphics/gpu.scm index c63cc4d..5549266 100644 --- a/chickadee/graphics/gpu.scm +++ b/chickadee/graphics/gpu.scm @@ -79,6 +79,7 @@ depth-test-function depth-test-near depth-test-far + depth-test:default make-stencil-test stencil-test? @@ -96,6 +97,7 @@ stencil-test-on-depth-fail-back stencil-test-on-pass-front stencil-test-on-pass-back + stencil-test:default make-window-rect window-rect? @@ -103,6 +105,7 @@ window-rect-y window-rect-width window-rect-height + window-rect:empty fresh-gpu-framebuffer free-gpu-framebuffer @@ -190,9 +193,7 @@ set-gpu-program! set-gpu-texture! gpu-gc - gpu-reset! - - current-gpu)) + gpu-reset!)) ;;; @@ -337,7 +338,7 @@ front-face-direction->symbol))) (define (bind-front-face front-face) - (gl-front-face (front-face-winding front-face))) + (gl-front-face (%front-face-winding front-face))) (define front-face:cw (make-front-face 'cw)) (define front-face:ccw (make-front-face 'ccw)) @@ -452,12 +453,14 @@ (define (bind-depth-test depth-test) (match depth-test (#f (gl-disable (enable-cap depth-test))) - (($ <depth-test> write? near far func) + (($ <depth-test> near far write? func) (gl-enable (enable-cap depth-test)) (gl-depth-func func) (gl-depth-mask write?) (gl-depth-range near far)))) +(define depth-test:default (make-depth-test)) + (define-enum-converters stencil-op symbol->stencil-op stencil-op->symbol @@ -570,6 +573,8 @@ (gl-stencil-op-separate (cull-face-mode back) on-fail-back on-depth-fail-back on-pass-back)))) +(define stencil-test:default (make-stencil-test)) + (define (bind-multisample multisample?) (if multisample? (gl-enable (version-1-3 multisample)) @@ -589,6 +594,8 @@ (width window-rect-width) (height window-rect-height)) +(define window-rect:empty (make-window-rect 0 0 0 0)) + (define (bind-scissor-test rect) (match rect (#f (gl-disable (enable-cap scissor-test))) @@ -767,8 +774,6 @@ (%make-gpu gl-context gl-version glsl-version max-texture-size max-texture-units guardian textures))) -(define current-gpu (make-parameter #f)) - (define-syntax-rule (define-gpu-setter name %set! ref bind pred) (define (name gpu obj) (unless (pred obj (ref gpu)) @@ -834,6 +839,9 @@ ((? gpu-vertex-array? va) (free-gpu-vertex-array va) (loop)) + ((? gpu-texture? t) + (free-gpu-texture t) + (loop)) ((? gpu-shader? s) (free-gpu-shader s) (loop)) @@ -842,7 +850,8 @@ (loop)))))) (define (guard! gpu obj) - ((gpu-guardian gpu) obj)) + ((gpu-guardian gpu) obj) + obj) (define-syntax-rule (define-fresh name constructor params ...) (define (name gpu params ...) @@ -852,6 +861,7 @@ (define-fresh fresh-gpu-renderbuffer make-gpu-renderbuffer) (define-fresh fresh-gpu-buffer make-gpu-buffer target) (define-fresh fresh-gpu-vertex-array make-gpu-vertex-array) +(define-fresh fresh-gpu-texture make-gpu-texture target) (define-fresh fresh-gpu-shader make-gpu-shader type) (define-fresh fresh-gpu-program make-gpu-program) @@ -864,8 +874,8 @@ (set-gpu-depth-test! gpu #f) (set-gpu-stencil-test! gpu #f) (set-gpu-scissor-test! gpu #f) - ;; TODO: Need current window dimensions. - ;; (set-gpu-viewport! gpu ...) + (set-gpu-viewport! gpu window-rect:empty) + (set-gpu-clear-color! gpu black) (set-gpu-multisample! gpu #f) (set-gpu-framebuffer! gpu gpu-framebuffer:null) (set-gpu-renderbuffer! gpu gpu-renderbuffer:null) diff --git a/chickadee/graphics/mesh.scm b/chickadee/graphics/mesh.scm index 8bf4f8f..ba9bb3d 100644 --- a/chickadee/graphics/mesh.scm +++ b/chickadee/graphics/mesh.scm @@ -23,17 +23,13 @@ #:use-module (chickadee math) #:use-module (chickadee math matrix) #:use-module (chickadee math vector) - #:use-module (chickadee graphics blend) #:use-module (chickadee graphics buffer) #:use-module (chickadee graphics color) - #:use-module (chickadee graphics depth) #:use-module (chickadee graphics engine) - #:use-module (chickadee graphics multisample) + #:use-module (chickadee graphics gpu) #:use-module (chickadee graphics light) - #:use-module (chickadee graphics polygon) #:use-module (chickadee graphics shader) #:use-module (chickadee graphics skybox) - #:use-module (chickadee graphics stencil) #:use-module (chickadee graphics texture) #:use-module (chickadee utils) #:use-module (ice-9 match) @@ -104,10 +100,10 @@ (name "anonymous") (shader null-shader) (blend-mode blend:replace) - (polygon-mode fill-polygon-mode) - (cull-face-mode back-cull-face-mode) - (depth-test basic-depth-test) - (stencil-test default-stencil-test) + (polygon-mode polygon:fill) + (cull-face-mode cull-face:back) + (depth-test depth-test:default) + (stencil-test stencil-test:default) multisample? (texture-0 null-texture) (texture-1 null-texture) @@ -123,18 +119,18 @@ (define (material-apply material vertex-array model-matrix view-matrix camera-position skybox light-vector) - (with-graphics-state ((g:blend-mode (material-blend-mode material)) - (g:cull-face-mode (material-cull-face-mode material)) - (g:depth-test (material-depth-test material)) - (g:multisample? (material-multisample? material)) - (g:polygon-mode (material-polygon-mode material)) - (g:stencil-test (material-stencil-test material)) - (g:texture-0 (skybox-cube-map skybox)) - (g:texture-1 (material-texture-0 material)) - (g:texture-2 (material-texture-1 material)) - (g:texture-3 (material-texture-2 material)) - (g:texture-4 (material-texture-3 material)) - (g:texture-5 (material-texture-4 material))) + (with-graphics-state ((blend-mode (material-blend-mode material)) + (cull-face-mode (material-cull-face-mode material)) + (depth-test (material-depth-test material)) + (multisample? (material-multisample? material)) + (polygon-mode (material-polygon-mode material)) + (stencil-test (material-stencil-test material)) + (texture 0 (texture-id (skybox-cube-map skybox))) + (texture 1 (texture-id (material-texture-0 material))) + (texture 2 (texture-id (material-texture-1 material))) + (texture 3 (texture-id (material-texture-2 material))) + (texture 4 (texture-id (material-texture-3 material))) + (texture 5 (texture-id (material-texture-4 material)))) (shader-apply (material-shader material) vertex-array #:model model-matrix #:view view-matrix diff --git a/chickadee/graphics/model.scm b/chickadee/graphics/model.scm index 5746e5a..737748f 100644 --- a/chickadee/graphics/model.scm +++ b/chickadee/graphics/model.scm @@ -27,16 +27,13 @@ #:use-module (chickadee math quaternion) #:use-module (chickadee math vector) #:use-module (chickadee graphics buffer) - #:use-module (chickadee graphics blend) #:use-module (chickadee graphics color) - #:use-module (chickadee graphics depth) #:use-module (chickadee graphics engine) + #:use-module (chickadee graphics gpu) #:use-module (chickadee graphics light) #:use-module (chickadee graphics mesh) - #:use-module (chickadee graphics multisample) #:use-module (chickadee graphics pbr) #:use-module (chickadee graphics phong) - #:use-module (chickadee graphics polygon) #:use-module (chickadee graphics shader) #:use-module (chickadee graphics skybox) #:use-module (chickadee graphics texture) @@ -147,7 +144,6 @@ (define* (make-model #:key name scenes (default-scene (car scenes)) render-state) (%make-model name scenes default-scene render-state)) -(define %depth-test (make-depth-test)) (define %identity-matrix (make-identity-matrix4)) (define %origin (vec3 0.0 0.0 0.0)) @@ -157,8 +153,8 @@ (camera-position %origin) (skybox (default-skybox)) (lights '())) - (with-graphics-state ((g:depth-test %depth-test) - (g:multisample? #t)) + (with-graphics-state ((depth-test depth-test:default) + (multisample? #t)) (let ((state (model-render-state model))) (render-state-reset! state) (render-state-model-matrix-mult! state model-matrix) @@ -877,9 +873,7 @@ (make-pbr-material #:name name #:blend-mode (if (eq? alpha-mode 'opaque) blend:alpha blend:replace) - #:cull-face-mode (if double-sided? - no-cull-face-mode - back-cull-face-mode) + #:cull-face-mode (if double-sided? cull-face:none cull-face:back) #:base-color-texture base-color-texture #:metallic-roughness-texture metal-rough-texture #:normal-texture normal-texture diff --git a/chickadee/graphics/multisample.scm b/chickadee/graphics/multisample.scm deleted file mode 100644 index cd54d55..0000000 --- a/chickadee/graphics/multisample.scm +++ /dev/null @@ -1,36 +0,0 @@ -;;; Chickadee Game Toolkit -;;; Copyright © 2021 David Thompson <dthompson2@worcester.edu> -;;; -;;; Licensed under the Apache License, Version 2.0 (the "License"); -;;; you may not use this file except in compliance with the License. -;;; You may obtain a copy of the License at -;;; -;;; http://www.apache.org/licenses/LICENSE-2.0 -;;; -;;; Unless required by applicable law or agreed to in writing, software -;;; distributed under the License is distributed on an "AS IS" BASIS, -;;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -;;; See the License for the specific language governing permissions and -;;; limitations under the License. - -;;; Commentary: -;; -;; Multisampling. -;; -;;; Code: - -(define-module (chickadee graphics multisample) - #:use-module (chickadee graphics engine) - #:use-module (gl) - #:export (g:multisample? - current-multisample)) - -(define (bind-multisample multisample?) - (if multisample? - (gl-enable (version-1-3 multisample)) - (gl-disable (version-1-3 multisample)))) - -(define-graphics-state g:multisample? - current-multisample - #:default #f - #:bind bind-multisample) diff --git a/chickadee/graphics/particles.scm b/chickadee/graphics/particles.scm index d8bd1b2..35aa6fc 100644 --- a/chickadee/graphics/particles.scm +++ b/chickadee/graphics/particles.scm @@ -24,10 +24,10 @@ #:use-module (chickadee math matrix) #:use-module (chickadee math rect) #:use-module (chickadee math vector) - #:use-module (chickadee graphics blend) #:use-module (chickadee graphics buffer) #:use-module (chickadee graphics color) #:use-module (chickadee graphics engine) + #:use-module (chickadee graphics gpu) #:use-module (chickadee graphics shader) #:use-module (chickadee graphics texture) #:export (make-particle-emitter @@ -285,7 +285,7 @@ default. (hw (- hh) 1.0 0.0) (hw hh 1.0 1.0) ((- hw) hh 0.0 1.0))) - (geometry-index-append! geometry 0 3 2 0 2 1)) + (geometry-index-append! geometry 0 2 3 0 1 2)) (%make-particles capacity 0 ;; 1 extra element as swap space for sorting. @@ -431,8 +431,8 @@ default. (let ((shader (graphics-variable-ref particles-shader)) (mvp (graphics-variable-ref mvp-matrix)) (geometry (particles-geometry particles))) - (with-graphics-state ((g:blend-mode (particles-blend-mode particles)) - (g:texture-0 (particles-texture particles))) + (with-graphics-state ((blend-mode (particles-blend-mode particles)) + (texture 0 (texture-id (particles-texture particles)))) (shader-apply/instanced shader (geometry-vertex-array geometry) (particles-size particles) diff --git a/chickadee/graphics/path.scm b/chickadee/graphics/path.scm index 30d4c7c..f98e038 100644 --- a/chickadee/graphics/path.scm +++ b/chickadee/graphics/path.scm @@ -22,16 +22,13 @@ (define-module (chickadee graphics path) #:use-module (chickadee config) #:use-module (chickadee data array-list) - #:use-module (chickadee graphics blend) #:use-module (chickadee graphics buffer) #:use-module (chickadee graphics color) #:use-module (chickadee graphics engine) #:use-module (chickadee graphics framebuffer) #:use-module (chickadee graphics gl) - #:use-module (chickadee graphics multisample) - #:use-module (chickadee graphics polygon) + #:use-module (chickadee graphics gpu) #:use-module (chickadee graphics shader) - #:use-module (chickadee graphics stencil) #:use-module (chickadee graphics texture) #:use-module (chickadee image) #:use-module (chickadee math) @@ -954,13 +951,11 @@ ;; requires looking at the newest 2 points + the 2 ;; previous points. (unless first? - (geometry-index-append! geometry - (- vert-count 1) - (- vert-count 2) - vert-count - (- vert-count 1) - vert-count - (+ vert-count 1))))) + (let ((l1 (- vert-count 2)) + (r1 (- vert-count 1)) + (l2 vert-count) + (r2 (+ vert-count 1))) + (geometry-index-append! geometry r1 l2 l1 r1 r2 l2))))) (define (set-length i length) (stroke-vertex-set! geometry length (* i 2) length) (stroke-vertex-set! geometry length (+ (* i 2) 1) length)) @@ -1235,7 +1230,7 @@ (define stencil-cover-and-clear (make-stencil-test #:on-fail 'zero #:on-depth-fail 'zero #:on-pass 'zero - #:function 'not-equal)) + #:function '!=)) (define *debug?* #f) @@ -1250,7 +1245,7 @@ (matrix4-mult! mvp matrix (current-projection)) ;; Wireframe debug mode. (when *debug?* - (with-graphics-state ((g:polygon-mode line-polygon-mode)) + (with-graphics-state ((polygon-mode polygon:line)) (for-range ((i n)) (shader-apply* shader (geometry-vertex-array stencil-geometry) @@ -1258,7 +1253,7 @@ (u32vector-ref counts i) #:mvp (current-projection))))) ;; Anti-alias the edges of the fill. - (with-graphics-state ((g:multisample? #t)) + (with-graphics-state ((multisample? #t)) ;; Render fan to stencil buffer. Each time a triangle is ;; rasterized, it flips the values in the stencil buffer for ;; those fragments. So, the first time a triangle is rendered, @@ -1270,8 +1265,9 @@ ;; ;; For more information, see: ;; http://developer.download.nvidia.com/devzone/devcenter/gamegraphics/files/opengl/gpupathrender.pdf - (with-graphics-state ((g:color-mask null-color-mask) - (g:stencil-test stencil-flip)) + (with-graphics-state ((color-mask color-mask:none) + (stencil-test stencil-flip) + (cull-face-mode cull-face:none)) (for-range ((i n)) (shader-apply* shader (geometry-vertex-array stencil-geometry) @@ -1281,8 +1277,8 @@ ;; Render a quad with the stencil applied. The quad is the size ;; of the path's bounding box. The stencil test will make it so ;; we only draw fragments that are part of the filled path. - (with-graphics-state ((g:stencil-test stencil-cover-and-clear) - (g:blend-mode (filled-path-blend-mode filled-path))) + (with-graphics-state ((stencil-test stencil-cover-and-clear) + (blend-mode (filled-path-blend-mode filled-path))) (let ((color (filled-path-color filled-path))) (if (gradient? color) ;; Linear/radial gradient fill. @@ -1310,7 +1306,7 @@ (let ((shader (graphics-variable-ref stroke-shader)) (mvp (graphics-variable-ref mvp-matrix))) (matrix4-mult! mvp matrix (current-projection)) - (with-graphics-state ((g:blend-mode (stroked-path-blend-mode stroked-path))) + (with-graphics-state ((blend-mode (stroked-path-blend-mode stroked-path))) (let ((geometry (stroked-path-geometry stroked-path))) (shader-apply* shader (geometry-vertex-array geometry) diff --git a/chickadee/graphics/pbr.scm b/chickadee/graphics/pbr.scm index a2c7251..e7e4333 100644 --- a/chickadee/graphics/pbr.scm +++ b/chickadee/graphics/pbr.scm @@ -22,15 +22,12 @@ (define-module (chickadee graphics pbr) #:use-module (chickadee config) #:use-module (chickadee math vector) - #:use-module (chickadee graphics blend) #:use-module (chickadee graphics buffer) #:use-module (chickadee graphics color) - #:use-module (chickadee graphics depth) #:use-module (chickadee graphics engine) + #:use-module (chickadee graphics gpu) #:use-module (chickadee graphics mesh) - #:use-module (chickadee graphics polygon) #:use-module (chickadee graphics shader) - #:use-module (chickadee graphics stencil) #:use-module (chickadee graphics texture) #:use-module (srfi srfi-9) #:export (make-pbr-properties @@ -73,10 +70,10 @@ (define* (make-pbr-material #:key (name "anonymous") (blend-mode blend:replace) - (polygon-mode fill-polygon-mode) - (cull-face-mode back-cull-face-mode) - (depth-test basic-depth-test) - (stencil-test default-stencil-test) + (polygon-mode polygon:fill) + (cull-face-mode cull-face:back) + (depth-test depth-test:default) + (stencil-test stencil-test:default) multisample? (base-color-factor (vec3 1.0 1.0 1.0)) (base-color-texcoord 0) diff --git a/chickadee/graphics/phong.scm b/chickadee/graphics/phong.scm index 8812a9a..2e3fafc 100644 --- a/chickadee/graphics/phong.scm +++ b/chickadee/graphics/phong.scm @@ -22,15 +22,12 @@ (define-module (chickadee graphics phong) #:use-module (chickadee config) #:use-module (chickadee math vector) - #:use-module (chickadee graphics blend) #:use-module (chickadee graphics color) - #:use-module (chickadee graphics depth) #:use-module (chickadee graphics engine) + #:use-module (chickadee graphics gpu) #:use-module (chickadee graphics light) #:use-module (chickadee graphics mesh) - #:use-module (chickadee graphics polygon) #:use-module (chickadee graphics shader) - #:use-module (chickadee graphics stencil) #:use-module (chickadee graphics texture) #:use-module (srfi srfi-9) #:export (make-phong-properties @@ -59,10 +56,10 @@ (define* (make-phong-material #:key (name "anonymous") (blend-mode blend:replace) - (polygon-mode fill-polygon-mode) - (cull-face-mode back-cull-face-mode) - (depth-test basic-depth-test) - (stencil-test default-stencil-test) + (polygon-mode polygon:fill) + (cull-face-mode cull-face:back) + (depth-test depth-test:default) + (stencil-test stencil-test:default) multisample? (ambient-factor (vec3 1.0 1.0 1.0)) (diffuse-factor (vec3 1.0 1.0 1.0)) diff --git a/chickadee/graphics/polygon.scm b/chickadee/graphics/polygon.scm deleted file mode 100644 index 0e05018..0000000 --- a/chickadee/graphics/polygon.scm +++ /dev/null @@ -1,107 +0,0 @@ -;;; Chickadee Game Toolkit -;;; Copyright © 2020, 2021 David Thompson <dthompson2@worcester.edu> -;;; -;;; Licensed under the Apache License, Version 2.0 (the "License"); -;;; you may not use this file except in compliance with the License. -;;; You may obtain a copy of the License at -;;; -;;; http://www.apache.org/licenses/LICENSE-2.0 -;;; -;;; Unless required by applicable law or agreed to in writing, software -;;; distributed under the License is distributed on an "AS IS" BASIS, -;;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -;;; See the License for the specific language governing permissions and -;;; limitations under the License. - -;;; Commentary -;; -;; Polygon face rendering configuration. -;; -;;; Code: - -(define-module (chickadee graphics polygon) - #:use-module (chickadee graphics engine) - #:use-module (chickadee graphics gl) - #:use-module (gl) - #:use-module (ice-9 match) - #:use-module (srfi srfi-9) - #:export (make-polygon-mode - polygon-mode? - polygon-mode-front - polygon-mode-back - fill-polygon-mode - line-polygon-mode - point-polygon-mode - g:polygon-mode - current-polygon-mode - - cull-face-mode? - cull-face-mode-front? - cull-face-mode-back? - no-cull-face-mode - back-cull-face-mode - front-cull-face-mode - front-and-back-cull-face-mode - g:cull-face-mode - current-cull-face-mode)) - -(define-record-type <polygon-mode> - (make-polygon-mode front back) - polygon-mode? - (front polygon-mode-front) - (back polygon-mode-back)) - -(define fill-polygon-mode (make-polygon-mode 'fill 'fill)) -(define line-polygon-mode (make-polygon-mode 'line 'line)) -(define point-polygon-mode (make-polygon-mode 'point 'point)) - -(define (bind-polygon-mode mode) - (define (glmode sym) - (match sym - ('fill (polygon-mode fill)) - ('line (polygon-mode line)) - ('point (polygon-mode point)))) - (let ((front (polygon-mode-front mode)) - (back (polygon-mode-back mode))) - (if (eq? front back) - (gl-polygon-mode (cull-face-mode front-and-back) (glmode front)) - (begin - (gl-polygon-mode (cull-face-mode front) (glmode front)) - (gl-polygon-mode (cull-face-mode back) (glmode back)))))) - -(define-graphics-state g:polygon-mode - current-polygon-mode - #:default fill-polygon-mode - #:bind bind-polygon-mode) - -(define-record-type <cull-face-mode> - (make-cull-face-mode front? back?) - cull-face-mode? - (front? cull-face-mode-front?) - (back? cull-face-mode-back?)) - -(define no-cull-face-mode (make-cull-face-mode #f #f)) -(define back-cull-face-mode (make-cull-face-mode #f #t)) -(define front-cull-face-mode (make-cull-face-mode #t #f)) -(define front-and-back-cull-face-mode (make-cull-face-mode #t #t)) - -(define (bind-cull-face-mode mode) - (let ((front? (cull-face-mode-front? mode)) - (back? (cull-face-mode-back? mode))) - (cond - ((and front? back?) - (gl-enable (enable-cap cull-face)) - (gl-cull-face (cull-face-mode front-and-back))) - (front? - (gl-enable (enable-cap cull-face)) - (gl-cull-face (cull-face-mode front))) - (back? - (gl-enable (enable-cap cull-face)) - (gl-cull-face (cull-face-mode back))) - (else - (gl-disable (enable-cap cull-face)))))) - -(define-graphics-state g:cull-face-mode - current-cull-face-mode - #:default back-cull-face-mode - #:bind bind-cull-face-mode) diff --git a/chickadee/graphics/shader.scm b/chickadee/graphics/shader.scm index 94c6bfc..f1e930f 100644 --- a/chickadee/graphics/shader.scm +++ b/chickadee/graphics/shader.scm @@ -33,6 +33,7 @@ #:use-module (chickadee graphics color) #:use-module (chickadee graphics engine) #:use-module (chickadee graphics gl) + #:use-module (chickadee graphics gpu) #:use-module (chickadee graphics texture) #:use-module (chickadee utils) #:export (shader-data-type? @@ -501,45 +502,33 @@ (location attribute-location) (type attribute-type)) -(define null-shader (%make-shader 0 (make-hash-table) (make-hash-table) #f #f)) - -(define (bind-shader shader) - (gl-use-program (shader-id shader))) - -(define (free-shader shader) - (gl-delete-program (shader-id shader))) - -(define-graphics-finalizer shader-finalizer - #:predicate shader? - #:free free-shader) - -(define-graphics-state g:shader - current-shader - #:default null-shader - #:bind bind-shader) +(define null-shader (%make-shader gpu-program:null (make-hash-table) (make-hash-table) #f #f)) (define (make-shader vertex-port fragment-port) "Read GLSL source from VERTEX-PORT and FRAGMENT-PORT and compile them into a GPU shader program." (define (shader-compiled? id) (let ((status (make-u32vector 1))) - (gl-get-shaderiv id (version-2-0 compile-status) + (gl-get-shaderiv (gpu-shader-id id) + (version-2-0 compile-status) (bytevector->pointer status)) (= (u32vector-ref status 0) 1))) (define (shader-linked? id) (let ((status (make-u32vector 1))) - (gl-get-programiv id (version-2-0 link-status) + (gl-get-programiv (gpu-program-id id) + (version-2-0 link-status) (bytevector->pointer status)) (= (u32vector-ref status 0) 1))) (define (info-log length-proc log-proc id) (let ((log-length-bv (make-u32vector 1))) - (length-proc id (version-2-0 info-log-length) + (length-proc (gpu-shader-id id) (version-2-0 info-log-length) (bytevector->pointer log-length-bv)) (u32vector-ref log-length-bv 0) ;; Add one byte to account for the null string terminator. (let* ((log-length (u32vector-ref log-length-bv 0)) (log (make-u8vector (1+ log-length)))) - (log-proc id log-length %null-pointer (bytevector->pointer log)) + (log-proc (gpu-shader-id id) log-length %null-pointer + (bytevector->pointer log)) (utf8->string log)))) (define (compilation-error id) (info-log gl-get-shaderiv gl-get-shader-info-log id)) @@ -549,7 +538,8 @@ them into a GPU shader program." ;; Set up preprocessor directives dynamically based on the current ;; OpenGL context's GLSL version so that we can write shaders that ;; are compatible with as many systems as possible. - (let ((glsl-version (graphics-engine-glsl-version))) + (let ((glsl-version (graphics-engine-glsl-version + (current-graphics-engine)))) (cond ((string>= glsl-version "3.3") "#version 330 @@ -566,27 +556,28 @@ them into a GPU shader program." (else (error "incompatible GLSL version" glsl-version))))) (define (make-shader-stage type port) - (let ((id (gl-create-shader type)) - (source (string->utf8 - (string-append (glsl-preprocessor-source) - (get-string-all port))))) - (gl-shader-source id 1 + (let* ((gpu (current-gpu)) + (id (fresh-gpu-shader gpu type)) + (source (string->utf8 + (string-append (glsl-preprocessor-source) + (get-string-all port))))) + (gl-shader-source (gpu-shader-id id) 1 (bytevector->pointer (u64vector (pointer-address (bytevector->pointer source)))) (bytevector->pointer (u32vector (bytevector-length source)))) - (gl-compile-shader id) + (gl-compile-shader (gpu-shader-id id)) (unless (shader-compiled? id) (let ((error-log (compilation-error id))) - (gl-delete-shader id) ; clean up GPU resource. + (free-gpu-shader id) ; clean up GPU resource. (display "shader compilation failed:\n") (display error-log (current-error-port)) (error "failed to compile shader"))) id)) (define (uniform-count id) (let ((bv (make-u32vector 1))) - (gl-get-programiv id + (gl-get-programiv (gpu-program-id id) (arb-shader-objects active-uniforms) (bytevector->pointer bv)) (u32vector-ref bv 0))) @@ -677,7 +668,8 @@ them into a GPU shader program." (size-bv (make-u32vector 1)) (type-bv (make-u32vector 1)) (name-bv (make-bytevector 255))) - (gl-get-active-uniform id i + (gl-get-active-uniform (gpu-program-id id) + i (bytevector-length name-bv) (bytevector->pointer length-bv) (bytevector->pointer size-bv) @@ -685,7 +677,7 @@ them into a GPU shader program." (bytevector->pointer name-bv)) (let* ((name-length (u32vector-ref length-bv 0)) (name (utf8->string* name-bv name-length)) - (location (gl-get-uniform-location id name)) + (location (gl-get-uniform-location (gpu-program-id id) name)) (size (u32vector-ref size-bv 0)) (type (parse-data-type (u32vector-ref type-bv 0))) (sampler? (or (eq? type sampler-2d) (eq? type sampler-cube))) @@ -719,7 +711,7 @@ them into a GPU shader program." (values namespace scratch-size))))) (define (attribute-count id) (let ((bv (make-u32vector 1))) - (gl-get-programiv id + (gl-get-programiv (gpu-program-id id) (arb-shader-objects active-attributes) (bytevector->pointer bv)) (u32vector-ref bv 0))) @@ -731,7 +723,8 @@ them into a GPU shader program." (size-bv (make-u32vector 1)) (type-bv (make-u32vector 1)) (name-bv (make-bytevector 255))) - (gl-get-active-attrib id i + (gl-get-active-attrib (gpu-program-id id) + i (bytevector-length name-bv) (bytevector->pointer length-bv) (bytevector->pointer size-bv) @@ -741,26 +734,25 @@ them into a GPU shader program." (name (utf8->string* name-bv length)) (size (u32vector-ref size-bv 0)) (type (parse-data-type (u32vector-ref type-bv 0))) - (location (gl-get-attrib-location id name))) + (location (gl-get-attrib-location (gpu-program-id id) name))) (unless (= size 1) (error "unsupported attribute size" name size)) (hash-set! table name (make-attribute name location type))))) table)) (assert-current-graphics-engine) - (let ((vertex-id (make-shader-stage (version-2-0 vertex-shader) - vertex-port)) - (fragment-id (make-shader-stage (version-2-0 fragment-shader) - fragment-port)) - (id (gl-create-program))) - (gl-attach-shader id vertex-id) - (gl-attach-shader id fragment-id) - (gl-link-program id) + (let* ((gpu (current-gpu)) + (vertex-id (make-shader-stage 'vertex vertex-port)) + (fragment-id (make-shader-stage 'fragment fragment-port)) + (id (fresh-gpu-program gpu))) + (gl-attach-shader (gpu-program-id id) (gpu-shader-id vertex-id)) + (gl-attach-shader (gpu-program-id id) (gpu-shader-id fragment-id)) + (gl-link-program (gpu-program-id id)) (unless (shader-linked? id) (let ((error-log (linking-error id))) - (gl-delete-program id) + (free-gpu-program id) (error "failed to link shader" error-log))) - (gl-delete-shader vertex-id) - (gl-delete-shader fragment-id) + (free-gpu-shader vertex-id) + (free-gpu-shader fragment-id) (call-with-values (lambda () (extract-uniforms id)) (lambda (namespace scratch-size) @@ -768,7 +760,6 @@ them into a GPU shader program." (scratch-ptr (bytevector->pointer scratch)) (shader (%make-shader id (extract-attributes id) namespace scratch scratch-ptr))) - (graphics-engine-guard! shader) shader))))) (define (load-shader vertex-source-file fragment-source-file) @@ -878,9 +869,10 @@ shader program." (shader-uniform-set! shader 'sname value) (uniform-apply shader rest))))))) -(define-syntax-rule (shader-apply** shader* vertex-array uniforms exp) - (with-graphics-state! ((g:shader shader*)) - (uniform-apply shader* uniforms) +(define-syntax-rule (shader-apply** shader vertex-array uniforms exp) + (with-graphics-state ((program (shader-id shader))) + (graphics-engine-commit! (current-graphics-engine)) + (uniform-apply shader uniforms) ;; Sampler2D values aren't explicitly passed as uniform values via ;; shader-apply, so we have to bind them to the proper texture units ;; behind the scenes. @@ -888,8 +880,8 @@ shader program." (lambda (uniform) (when (or (eq? (uniform-type uniform) sampler-2d) (eq? (uniform-type uniform) sampler-cube)) - (set-uniform-value! shader* uniform (uniform-value uniform)))) - shader*) + (set-uniform-value! shader uniform (uniform-value uniform)))) + shader) exp)) (define-syntax-rule (shader-apply* shader vertex-array offset count . uniforms) diff --git a/chickadee/graphics/skybox.scm b/chickadee/graphics/skybox.scm index 31fcd76..d94c13e 100644 --- a/chickadee/graphics/skybox.scm +++ b/chickadee/graphics/skybox.scm @@ -22,12 +22,10 @@ (define-module (chickadee graphics skybox) #:use-module (chickadee config) #:use-module (chickadee graphics buffer) - #:use-module (chickadee graphics blend) #:use-module (chickadee graphics color) - #:use-module (chickadee graphics depth) #:use-module (chickadee graphics engine) + #:use-module (chickadee graphics gpu) #:use-module (chickadee graphics pixbuf) - #:use-module (chickadee graphics polygon) #:use-module (chickadee graphics shader) #:use-module (chickadee graphics texture) #:use-module (srfi srfi-9) @@ -112,7 +110,7 @@ (force %skybox-shader)) (define (draw-skybox skybox view) - (with-graphics-state ((g:texture-0 (skybox-cube-map skybox))) + (with-graphics-state ((texture 0 (texture-id (skybox-cube-map skybox)))) (shader-apply (skybox-shader) (skybox-vertex-array skybox) #:view view #:projection (current-projection)))) diff --git a/chickadee/graphics/sprite.scm b/chickadee/graphics/sprite.scm index 29c1088..8fdabfd 100644 --- a/chickadee/graphics/sprite.scm +++ b/chickadee/graphics/sprite.scm @@ -21,12 +21,12 @@ #:use-module (chickadee math matrix) #:use-module (chickadee math rect) #:use-module (chickadee math vector) - #:use-module (chickadee graphics blend) + #:use-module (chickadee graphics buffer) #:use-module (chickadee graphics color) #:use-module (chickadee graphics engine) + #:use-module (chickadee graphics gpu) #:use-module (chickadee graphics shader) #:use-module (chickadee graphics texture) - #:use-module (chickadee graphics buffer) #:export (draw-sprite* draw-sprite @@ -94,9 +94,9 @@ uniform vec4 tint; void main (void) { #ifdef GLSL330 - fragColor = texture(colorTexture, fragTex) * tint; + fragColor = (texture(colorTexture, fragTex) * tint); #else - gl_FragColor = texture2D(colorTexture, fragTex) * tint; + gl_FragColor = (texture2D(colorTexture, fragTex) * tint); #endif } ")) @@ -111,6 +111,20 @@ void main (void) { (let ((shader (graphics-variable-ref sprite-shader)) (geometry (graphics-variable-ref sprite-geometry)) (mvp (graphics-variable-ref sprite-mvp-matrix))) + (with-graphics-state ((blend-mode blend-mode) + (texture 0 texture)) + #t))) + +(define* (draw-sprite* texture + rect + matrix + #:key + (tint white) + (blend-mode blend:alpha) + (texcoords (texture-gl-tex-rect texture))) + (let ((shader (graphics-variable-ref sprite-shader)) + (geometry (graphics-variable-ref sprite-geometry)) + (mvp (graphics-variable-ref sprite-mvp-matrix))) (with-geometry geometry (let* ((x1 (rect-x rect)) (y1 (rect-y rect)) @@ -125,9 +139,9 @@ void main (void) { (x2 y1 s2 t1) (x2 y2 s2 t2) (x1 y2 s1 t2)) - (geometry-index-append! geometry 0 3 2 0 2 1))) - (with-graphics-state ((g:blend-mode blend-mode) - (g:texture-0 texture)) + (geometry-index-append! geometry 0 2 3 0 1 2))) + (with-graphics-state ((blend-mode blend-mode) + (texture 0 (texture-id texture))) (shader-apply shader (geometry-vertex-array geometry) #:tint tint @@ -304,11 +318,11 @@ texture may be specified via the TEXTURE-REGION argument." (x4 y4 s1 t2 r g b a)) (geometry-index-append! geometry vertex-offset - (+ vertex-offset 3) (+ vertex-offset 2) + (+ vertex-offset 3) vertex-offset - (+ vertex-offset 2) - (+ vertex-offset 1)) + (+ vertex-offset 1) + (+ vertex-offset 2)) (set-sprite-batch-size! batch (+ (sprite-batch-size batch) 1)))) (define* (sprite-batch-add! batch @@ -342,8 +356,8 @@ may be specified via the TEXTURE-REGION argument." (mvp (graphics-variable-ref sprite-mvp-matrix))) (sprite-batch-flush! batch) (matrix4-mult! mvp matrix (current-projection)) - (with-graphics-state ((g:blend-mode blend-mode) - (g:texture-0 (sprite-batch-texture batch))) + (with-graphics-state ((blend-mode blend-mode) + (texture 0 (texture-id (sprite-batch-texture batch)))) (let ((geometry (sprite-batch-geometry batch))) (shader-apply* shader (geometry-vertex-array geometry) diff --git a/chickadee/graphics/stencil.scm b/chickadee/graphics/stencil.scm deleted file mode 100644 index bc4cef2..0000000 --- a/chickadee/graphics/stencil.scm +++ /dev/null @@ -1,141 +0,0 @@ -;;; Chickadee Game Toolkit -;;; Copyright © 2020, 2021 David Thompson <dthompson2@worcester.edu> -;;; -;;; Licensed under the Apache License, Version 2.0 (the "License"); -;;; you may not use this file except in compliance with the License. -;;; You may obtain a copy of the License at -;;; -;;; http://www.apache.org/licenses/LICENSE-2.0 -;;; -;;; Unless required by applicable law or agreed to in writing, software -;;; distributed under the License is distributed on an "AS IS" BASIS, -;;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -;;; See the License for the specific language governing permissions and -;;; limitations under the License. - -(define-module (chickadee graphics stencil) - #:use-module (ice-9 match) - #:use-module (gl) - #:use-module (chickadee graphics engine) - #:use-module (chickadee graphics gl) - #:use-module (srfi srfi-9) - #:export (make-stencil-test - stencil-test? - stencil-test-mask-front - stencil-test-mask-back - stencil-test-function-front - stencil-test-function-back - stencil-test-function-mask-front - stencil-test-function-mask-back - stencil-test-reference-front - stencil-test-reference-back - stencil-test-on-fail-front - stencil-test-on-fail-back - stencil-test-on-depth-fail-front - stencil-test-on-depth-fail-back - stencil-test-on-pass-front - stencil-test-on-pass-back - default-stencil-test - g:stencil-test - current-stencil-test)) - -(define-record-type <stencil-test> - (%make-stencil-test mask-front mask-back function-front function-back - function-mask-front function-mask-back - reference-front reference-back - on-fail-front on-fail-back - on-depth-fail-front on-depth-fail-back - on-pass-front on-pass-back) - stencil-test? - (mask-front stencil-test-mask-front) - (mask-back stencil-test-mask-back) - (function-front stencil-test-function-front) - (function-back stencil-test-function-back) - (function-mask-front stencil-test-function-mask-front) - (function-mask-back stencil-test-function-mask-back) - (reference-front stencil-test-reference-front) - (reference-back stencil-test-reference-back) - (on-fail-front stencil-test-on-fail-front) - (on-fail-back stencil-test-on-fail-back) - (on-depth-fail-front stencil-test-on-depth-fail-front) - (on-depth-fail-back stencil-test-on-depth-fail-back) - (on-pass-front stencil-test-on-pass-front) - (on-pass-back stencil-test-on-pass-back)) - -(define* (make-stencil-test #:key (mask #xFF) (function 'always) - (function-mask #xFF) (reference 0) - (on-fail 'keep) (on-depth-fail 'keep) (on-pass 'keep) - (mask-front mask) (mask-back mask) - (function-front function) (function-back function) - (function-mask-front function-mask) - (function-mask-back function-mask) - (reference-front reference) - (reference-back reference) - (on-fail-front on-fail) (on-fail-back on-fail) - (on-depth-fail-front on-depth-fail) - (on-depth-fail-back on-depth-fail) - (on-pass-front on-pass) (on-pass-back on-pass)) - (%make-stencil-test mask-front mask-back function-front function-back - function-mask-front function-mask-back - reference-front reference-back - on-fail-front on-fail-back - on-depth-fail-front on-depth-fail-back - on-pass-front on-pass-back)) - -(define default-stencil-test (make-stencil-test)) - -(define* (bind-stencil-test stencil) - (define (symbol->op sym) - (match sym - ('zero (stencil-op zero)) - ('keep (stencil-op keep)) - ('replace (stencil-op replace)) - ('increment (stencil-op incr)) - ('increment-wrap (version-1-4 incr-wrap)) - ('decrement (stencil-op decr)) - ('decrement-wrap (version-1-4 decr-wrap)) - ('invert (stencil-op invert)))) - (define (symbol->function sym) - (match sym - ('always (stencil-function always)) - ('never (stencil-function never)) - ('less-than (stencil-function less)) - ('equal (stencil-function equal)) - ('less-than-or-equal (stencil-function lequal)) - ('greater-than (stencil-function greater)) - ('greater-than-or-equal (stencil-function gequal)) - ('not-equal (stencil-function notequal)))) - (if stencil - (begin - (gl-enable (enable-cap stencil-test)) - ;; Mask - (gl-stencil-mask-separate (cull-face-mode front) - (stencil-test-mask-front stencil)) - (gl-stencil-mask-separate (cull-face-mode back) - (stencil-test-mask-back stencil)) - ;; Function - (gl-stencil-func-separate (cull-face-mode front) - (symbol->function - (stencil-test-function-front stencil)) - (stencil-test-reference-front stencil) - (stencil-test-function-mask-front stencil)) - (gl-stencil-func-separate (cull-face-mode back) - (symbol->function - (stencil-test-function-back stencil)) - (stencil-test-reference-back stencil) - (stencil-test-function-mask-back stencil)) - ;; Operation - (gl-stencil-op-separate (cull-face-mode front) - (symbol->op (stencil-test-on-fail-front stencil)) - (symbol->op (stencil-test-on-depth-fail-front stencil)) - (symbol->op (stencil-test-on-pass-front stencil))) - (gl-stencil-op-separate (cull-face-mode back) - (symbol->op (stencil-test-on-fail-back stencil)) - (symbol->op (stencil-test-on-depth-fail-back stencil)) - (symbol->op (stencil-test-on-pass-back stencil)))) - (gl-disable (enable-cap stencil-test)))) - -(define-graphics-state g:stencil-test - current-stencil-test - #:default default-stencil-test - #:bind bind-stencil-test) diff --git a/chickadee/graphics/text.scm b/chickadee/graphics/text.scm index 20b8ca5..8efa7ae 100644 --- a/chickadee/graphics/text.scm +++ b/chickadee/graphics/text.scm @@ -37,9 +37,9 @@ #:use-module (chickadee math matrix) #:use-module (chickadee math rect) #:use-module (chickadee math vector) - #:use-module (chickadee graphics blend) #:use-module (chickadee graphics color) #:use-module (chickadee graphics engine) + #:use-module (chickadee graphics gpu) #:use-module (chickadee graphics pixbuf) #:use-module (chickadee graphics shader) #:use-module (chickadee graphics sprite) @@ -146,7 +146,9 @@ non-smooth scaling will be used." (let ((face (load-face (force freetype-handle) file-name)) (chars (make-hash-table)) (kernings (make-hash-table)) - (texture-size (min (graphics-engine-max-texture-size) 2048))) + (texture-size (min (graphics-engine-max-texture-size + (current-graphics-engine)) + 2048))) ;; TODO: Use actual screen DPI. (set-char-size! face (* point-size 64) 0 96 96) (let ((glyph (face-glyph-slot face)) diff --git a/chickadee/graphics/texture.scm b/chickadee/graphics/texture.scm index 65b7300..86702a3 100644 --- a/chickadee/graphics/texture.scm +++ b/chickadee/graphics/texture.scm @@ -29,6 +29,7 @@ #:use-module (chickadee graphics color) #:use-module (chickadee graphics engine) #:use-module (chickadee graphics gl) + #:use-module (chickadee graphics gpu) #:use-module (chickadee graphics pixbuf) #:use-module (chickadee image) #:use-module (chickadee utils) @@ -45,6 +46,7 @@ texture-region? cube-map? texture-null? + texture-id texture-type texture-parent texture-min-filter @@ -113,7 +115,7 @@ (set-record-type-printer! <texture> (lambda (texture port) (format port - "#<texture id: ~d region?: ~a x: ~d y: ~d width: ~d height: ~d min-filter: ~a mag-filter: ~a wrap-s: ~a wrap-t: ~a>" + "#<texture id: ~s region?: ~a x: ~d y: ~d width: ~d height: ~d min-filter: ~a mag-filter: ~a wrap-s: ~a wrap-t: ~a>" (texture-id texture) (texture-region? texture) (texture-x texture) @@ -126,7 +128,7 @@ (texture-wrap-t texture)))) (define null-texture - (%make-texture 0 '2d #f 'linear 'linear 'repeat 'repeat 0 0 0 0 + (%make-texture gpu-texture:null '2d #f 'linear 'linear 'repeat 'repeat 0 0 0 0 (make-rect 0.0 0.0 0.0 0.0) (make-rect 0.0 0.0 0.0 0.0))) (define (texture-null? texture) @@ -139,9 +141,6 @@ (define (cube-map? texture) (and (texture? texture) (eq? (texture-type texture) 'cube-map))) -(define (free-texture texture) - (gl-delete-texture (texture-id texture))) - (define (gl-texture-target type) (case type ((2d) @@ -149,47 +148,6 @@ ((cube-map) (version-1-3 texture-cube-map)))) -(define (make-bind-texture n) - (lambda (texture) - (let ((texture-unit (+ (version-1-3 texture0) n))) - (set-gl-active-texture texture-unit) - (gl-bind-texture (gl-texture-target (texture-type texture)) - (texture-id texture))))) - -(define-graphics-finalizer texture-finalizer - #:predicate texture? - #:free free-texture) - -(define-graphics-state g:texture-0 - current-texture-0 - #:default null-texture - #:bind (make-bind-texture 0)) - -(define-graphics-state g:texture-1 - current-texture-1 - #:default null-texture - #:bind (make-bind-texture 1)) - -(define-graphics-state g:texture-2 - current-texture-2 - #:default null-texture - #:bind (make-bind-texture 2)) - -(define-graphics-state g:texture-3 - current-texture-3 - #:default null-texture - #:bind (make-bind-texture 3)) - -(define-graphics-state g:texture-4 - current-texture-4 - #:default null-texture - #:bind (make-bind-texture 4)) - -(define-graphics-state g:texture-5 - current-texture-5 - #:default null-texture - #:bind (make-bind-texture 5)) - (define (gl-wrap-mode mode) (case mode ((repeat) @@ -248,15 +206,15 @@ Allowed symbols are: repeat (the default), mirrored-repeat, clamp, clamp-to-border, clamp-to-edge. FORMAT specifies the pixel format. Currently only 32-bit RGBA format is supported." (assert-current-graphics-engine) - (let ((texture (%make-texture (gl-generate-texture) '2d #f + (let ((texture (%make-texture (fresh-gpu-texture (current-gpu) '2d) + '2d #f min-filter mag-filter wrap-s wrap-t 0 0 width height (make-rect 0.0 0.0 width height) (if flip? (make-rect 0.0 1.0 1.0 -1.0) (make-rect 0.0 0.0 1.0 1.0))))) - (graphics-engine-guard! texture) - (with-graphics-state! ((g:texture-0 texture)) + (with-graphics-state! ((texture 0 (texture-id texture))) ;; Ensure that we are using texture unit 0 because ;; with-graphics-state! doesn't guarantee it. (set-gl-active-texture (version-1-3 texture0)) @@ -283,8 +241,8 @@ Currently only 32-bit RGBA format is supported." linear-mipmap-nearest nearest-mipmap-linear linear-mipmap-linear)) - (gl-generate-mipmap (texture-target texture-2d)))) - texture)) + (gl-generate-mipmap (texture-target texture-2d))) + texture))) (define* (pixbuf->texture pixbuf #:key flip? @@ -298,15 +256,15 @@ Currently only 32-bit RGBA format is supported." (assert-current-graphics-engine) (let* ((width (pixbuf-width pixbuf)) (height (pixbuf-height pixbuf)) - (texture (%make-texture (gl-generate-texture) '2d #f + (texture (%make-texture (fresh-gpu-texture (current-gpu) '2d) + '2d #f min-filter mag-filter wrap-s wrap-t 0 0 width height (make-rect 0.0 0.0 width height) (if flip? (make-rect 0.0 1.0 1.0 -1.0) (make-rect 0.0 0.0 1.0 1.0))))) - (graphics-engine-guard! texture) - (with-graphics-state! ((g:texture-0 texture)) + (with-graphics-state! ((texture 0 (texture-id texture))) ;; Ensure that we are using texture unit 0 because ;; with-graphics-state! doesn't guarantee it. (set-gl-active-texture (version-1-3 texture0)) @@ -333,8 +291,8 @@ Currently only 32-bit RGBA format is supported." linear-mipmap-nearest nearest-mipmap-linear linear-mipmap-linear)) - (gl-generate-mipmap (texture-target texture-2d)))) - texture)) + (gl-generate-mipmap (texture-target texture-2d))) + texture))) (define* (make-cube-map #:key right left top bottom front back @@ -364,12 +322,12 @@ Currently only 32-bit RGBA format is supported." (color-pointer-type unsigned-byte) (pixbuf-pixels pixbuf))) (assert-current-graphics-engine) - (let ((texture (%make-texture (gl-generate-texture) 'cube-map #f + (let ((texture (%make-texture (fresh-gpu-texture (current-gpu) 'cube-map) + 'cube-map #f min-filter mag-filter 'clamp-to-edge 'clamp-to-edge 0 0 0 0 #f #f))) - (graphics-engine-guard! texture) - (with-graphics-state! ((g:texture-0 texture)) + (with-graphics-state! ((texture 0 (texture-id texture))) ;; Ensure that we are using texture unit 0 because ;; with-graphics-state! doesn't guarantee it. (set-gl-active-texture (version-1-3 texture0)) @@ -400,8 +358,8 @@ Currently only 32-bit RGBA format is supported." linear-mipmap-nearest nearest-mipmap-linear linear-mipmap-linear)) - (gl-generate-mipmap (gl-texture-target 'cube-map)))) - texture)) + (gl-generate-mipmap (gl-texture-target 'cube-map))) + texture))) (define (make-texture-region texture rect) "Create a new texture region covering a section of TEXTURE defined @@ -483,12 +441,12 @@ are 'nearest and 'linear. By default, 'nearest is used." (let* ((w (texture-width texture)) (h (texture-height texture)) (pixels (make-bytevector (* w h 4) 0))) - (with-graphics-state! ((g:texture-0 texture)) - (gl-get-tex-image (texture-target texture-2d) - 0 - (gl-pixel-format 'rgba) - (color-pointer-type unsigned-byte) - (bytevector->pointer pixels))) + (set-gpu-texture! (current-gpu) 0 texture) + (gl-get-tex-image (texture-target texture-2d) + 0 + (gl-pixel-format 'rgba) + (color-pointer-type unsigned-byte) + (bytevector->pointer pixels)) (let ((pixbuf (bytevector->pixbuf pixels w h #:format 'rgba #:bit-depth 8))) diff --git a/chickadee/graphics/tile-map.scm b/chickadee/graphics/tile-map.scm index 84213eb..48ed914 100644 --- a/chickadee/graphics/tile-map.scm +++ b/chickadee/graphics/tile-map.scm @@ -24,10 +24,10 @@ #:use-module (chickadee math matrix) #:use-module (chickadee math rect) #:use-module (chickadee math vector) - #:use-module (chickadee graphics blend) #:use-module (chickadee graphics buffer) #:use-module (chickadee graphics color) #:use-module (chickadee graphics engine) + #:use-module (chickadee graphics gpu) #:use-module (chickadee graphics shader) #:use-module (chickadee graphics texture) #:use-module (chickadee graphics viewport) @@ -423,11 +423,11 @@ (x1 y2 ds dt)) (geometry-index-append! geometry vertex-offset - (+ vertex-offset 3) (+ vertex-offset 2) + (+ vertex-offset 3) vertex-offset - (+ vertex-offset 2) - (+ vertex-offset 1)))))) + (+ vertex-offset 1) + (+ vertex-offset 2)))))) (hash-for-each (lambda (texture geometry) (geometry-end! geometry)) t))) @@ -479,7 +479,7 @@ void main (void) { ")) (define (draw-chunk-geometry texture geometry matrix tint) - (with-graphics-state ((g:texture-0 texture)) + (with-graphics-state ((texture 0 (texture-id texture))) (shader-apply* (graphics-variable-ref tile-map-chunk-shader) (geometry-vertex-array geometry) 0 @@ -500,7 +500,7 @@ void main (void) { (when (chunk-rebuild-geometry? chunk) (chunk-rebuild-geometry! chunk) (set-chunk-rebuild-geometry! chunk #f)) - (with-graphics-state ((g:blend-mode blend-mode)) + (with-graphics-state ((blend-mode blend-mode)) (hash-for-each (lambda (texture geometry) (draw-chunk-geometry texture geometry matrix tint)) (chunk-geometry chunk)))) @@ -904,8 +904,8 @@ argument may be used to specify a list of layers to draw, instead." (let ((vp (current-viewport))) (set-rect-x! *region* (vec2-x camera)) (set-rect-y! *region* (vec2-y camera)) - (set-rect-width! *region* (viewport-width vp)) - (set-rect-height! *region* (viewport-height vp))) + (set-rect-width! *region* (window-rect-width vp)) + (set-rect-height! *region* (window-rect-height vp))) ;; Translation must be adjusted by inverse of camera. (vec2-copy! camera *position*) (vec2-mult! *position* -1.0) diff --git a/chickadee/graphics/viewport.scm b/chickadee/graphics/viewport.scm index e305c19..4258e05 100644 --- a/chickadee/graphics/viewport.scm +++ b/chickadee/graphics/viewport.scm @@ -26,31 +26,26 @@ #:use-module (chickadee utils) #:use-module (chickadee graphics color) #:use-module (chickadee graphics engine) + #:use-module (chickadee graphics gpu) #:use-module (chickadee graphics gl) #:export (make-viewport viewport? - viewport-x - viewport-y - viewport-width - viewport-height + viewport-rect viewport-clear-color viewport-clear-flags null-viewport clear-viewport - g:viewport - current-viewport + with-viewport %default-clear-flags %default-clear-color)) (define-record-type <viewport> - (%make-viewport x y width height clear-color clear-flags) + (%make-viewport rect clear-color clear-flags clear-mask) viewport? - (x viewport-x) - (y viewport-y) - (width viewport-width) - (height viewport-height) + (rect viewport-rect) (clear-color viewport-clear-color) - (clear-flags viewport-clear-flags)) + (clear-flags viewport-clear-flags) + (clear-mask viewport-clear-mask)) (define %default-clear-flags '(color-buffer depth-buffer stencil-buffer)) ;; Just a fun color from the Dawnbringer 32-color palette instead of @@ -62,6 +57,19 @@ n (error "expecting non-negative integer:" n))) +;; TODO: This is gross. Get rid of it. +(define clear-buffer-mask + (memoize + (lambda (flags) + (apply logior + ;; Map symbols to OpenGL constants. + (map (match-lambda + ('depth-buffer 256) + ('accum-buffer 512) + ('stencil-buffer 1024) + ('color-buffer 16384)) + flags))))) + (define* (make-viewport x y width height #:key (clear-color %default-clear-color) (clear-flags %default-clear-flags)) @@ -71,59 +79,23 @@ viewport with CLEAR-COLOR when clearing the screen. Clear the buffers denoted by the list of symbols in CLEAR-FLAGS. Possible values for CLEAR-FLAGS are 'color-buffer', 'depth-buffer', 'accum-buffer', and 'stencil-buffer'." - (%make-viewport (assert-non-negative-integer x) - (assert-non-negative-integer y) - (assert-non-negative-integer width) - (assert-non-negative-integer height) + (%make-viewport (make-window-rect (assert-non-negative-integer x) + (assert-non-negative-integer y) + (assert-non-negative-integer width) + (assert-non-negative-integer height)) clear-color - clear-flags)) + clear-flags + (clear-buffer-mask clear-flags))) (define null-viewport (make-viewport 0 0 0 0)) -(define clear-buffer-mask - (memoize - (lambda (flags) - (apply logior - ;; Map symbols to OpenGL constants. - (map (match-lambda - ('depth-buffer 256) - ('accum-buffer 512) - ('stencil-buffer 1024) - ('color-buffer 16384)) - flags))))) +(define-syntax-rule (with-viewport v body ...) + (let ((viewport v)) + (with-graphics-state ((viewport (viewport-rect viewport)) + (clear-color (viewport-clear-color viewport))) + body ...))) +;; TODO: Add clear buffer mask to managed gpu state. (define (clear-viewport) - (gl-clear (clear-buffer-mask (viewport-clear-flags (current-viewport))))) - -(define (apply-viewport viewport) - "Set the OpenGL state for VIEWPORT. Clip rendering to the viewport -area, set the clear color, and clear necessary buffers." - (unless (eq? viewport null-viewport) - (let ((x (viewport-x viewport)) - (y (viewport-y viewport)) - (w (viewport-width viewport)) - (h (viewport-height viewport)) - (c (viewport-clear-color viewport))) - (gl-enable (enable-cap scissor-test)) - (gl-viewport x y w h) - (gl-scissor x y w h) - (gl-clear-color (color-r c) (color-g c) (color-b c) (color-a c))))) - -(define (bind-viewport viewport) - "Set the OpenGL state for VIEWPORT. Clip rendering to the viewport -area, and set the clear color.." - (unless (eq? viewport null-viewport) - (let ((x (viewport-x viewport)) - (y (viewport-y viewport)) - (w (viewport-width viewport)) - (h (viewport-height viewport)) - (c (viewport-clear-color viewport))) - (gl-enable (enable-cap scissor-test)) - (gl-viewport x y w h) - (gl-scissor x y w h) - (gl-clear-color (color-r c) (color-g c) (color-b c) (color-a c))))) - -(define-graphics-state g:viewport - current-viewport - #:default null-viewport - #:bind bind-viewport) + (graphics-engine-commit! (current-graphics-engine)) + (gl-clear (clear-buffer-mask %default-clear-flags))) diff --git a/doc/api.texi b/doc/api.texi index 50ce301..b6aef7b 100644 --- a/doc/api.texi +++ b/doc/api.texi @@ -4483,8 +4483,8 @@ and state changes happen within the context of this engine. Performing a custom draw call could look something like this: @lisp -(with-graphics-state ((g:blend-mode blend:alpha) - (g:texture-0 my-texture)) +(with-graphics-state ((blend-mode blend:alpha) + (texture 0 my-texture)) (shader-apply my-shader #:foo 1)) @end lisp @@ -4502,17 +4502,12 @@ values afterwards. @end deffn One additional piece of state that the rendering engine has, that is -not part of the GPU state, is the current projection matrix: +not strictly part of the GPU state, is the current projection matrix: @deffn {Procedure} current-projection Return the currently bound projection matrix (@pxref{Matrices}). @end deffn -@deffn {Syntax} with-projection projection body @dots{} -Evaluate @var{body} with the current projection matrix bound to -@var{projection} (@pxref{Matrices}). -@end deffn - @subsubsection Rendering Chickadee likens a GPU draw call to a Scheme procedure call. A shader diff --git a/examples/model.scm b/examples/model.scm index 4fa42c7..35aceb5 100644 --- a/examples/model.scm +++ b/examples/model.scm @@ -26,7 +26,7 @@ (reset-position)) (define (draw alpha) - (with-projection projection + (with-graphics-state ((projection projection)) (draw-model model #:model-matrix model-matrix #:view-matrix view-matrix diff --git a/examples/path.scm b/examples/path.scm index 44cabdb..ef9bf8f 100644 --- a/examples/path.scm +++ b/examples/path.scm @@ -4,7 +4,8 @@ (chickadee graphics text) (chickadee math) (chickadee math vector) - (chickadee scripting)) + (chickadee scripting) + (ice-9 format)) (set! *random-state* (random-state-from-platform)) diff --git a/examples/sprite-batch.scm b/examples/sprite-batch.scm index e62d1e4..cf79565 100644 --- a/examples/sprite-batch.scm +++ b/examples/sprite-batch.scm @@ -3,6 +3,7 @@ (chickadee math rect) (chickadee math vector) (chickadee graphics color) + (chickadee graphics path) (chickadee graphics sprite) (chickadee graphics text) (chickadee graphics texture) @@ -28,22 +29,28 @@ (define matrix (make-identity-matrix4)) (define (stats-message) - (format #f "sprites: ~d fps: ~1,2f" + (format #f "sprites: ~d fps: ~1,2f" num-sprites (/ 1.0 avg-frame-time))) - +(define stats-text-pos (vec2 8.0 462.0)) (define stats-text (stats-message)) +(define stats-background + (with-style ((fill-color tango-light-plum)) + (fill + (rounded-rectangle (vec2- stats-text-pos (vec2 4.0 4.0)) + 212.0 18.0 #:radius 4.0)))) +(define stats-canvas (make-empty-canvas)) (define (load) (set! *random-state* (random-state-from-platform)) (set! texture (load-image "images/shot.png")) (set! batch (make-sprite-batch texture #:capacity num-sprites)) + (set-canvas-painter! stats-canvas stats-background) (script (forever (sleep 60) (set! stats-text (pk 'stats (stats-message)))))) -(define stats-text-pos (vec2 4.0 464.0)) (define (draw alpha) (sprite-batch-clear! batch) (for-each (match-lambda @@ -53,7 +60,8 @@ (sprite-batch-add* batch r matrix))) sprites) (draw-sprite-batch batch) - (draw-text stats-text stats-text-pos #:color black) + (draw-canvas stats-canvas) + (draw-text stats-text stats-text-pos #:color tango-aluminium-6) (let ((current-time (elapsed-time))) (set! avg-frame-time (+ (* (- current-time start-time) 0.1) diff --git a/examples/sprite.scm b/examples/sprite.scm index 24b7a24..753be4d 100644 --- a/examples/sprite.scm +++ b/examples/sprite.scm @@ -8,10 +8,11 @@ (define sprite #f) (define (load) - (pk (blending-factor-src 2)) (set! sprite (load-image "images/chickadee.png"))) (define (draw alpha) - (draw-sprite sprite (vec2 256.0 176.0))) + (draw-sprite sprite (vec2 256.0 176.0)) + ;;(abort-game) + ) (run-game #:load load #:draw draw) diff --git a/examples/text.scm b/examples/text.scm index be79edc..81e4021 100644 --- a/examples/text.scm +++ b/examples/text.scm @@ -7,7 +7,7 @@ (define avg-frame-time 16.0) (define stats-text "") (define stats-position (vec2 4.0 704.0)) -(define position (vec2 140.0 0.0)) +(define position (vec2 140.0 240.0)) (define text "The quick brown fox jumps over the lazy dog.\nFive hexing wizard bots jump quickly.") (define (stats-message) @@ -40,6 +40,4 @@ #:key-press key-press #:load load #:update update - #:window-title "text rendering" - #:window-width 1280 - #:window-height 720) + #:window-title "text rendering") diff --git a/examples/triangle.scm b/examples/triangle.scm new file mode 100644 index 0000000..2debc85 --- /dev/null +++ b/examples/triangle.scm @@ -0,0 +1,84 @@ +(use-modules (chickadee) + (chickadee math vector) + (chickadee graphics buffer) + (chickadee graphics engine) + (chickadee graphics shader)) + +(use-modules (gl enums)) + +(define vertex-array #f) +(define shader #f) + +(define (load) + (define verts + (make-buffer #f32(0.0 0.0 + 640.0 0.0 + 320.0 480.0))) + (define colors + (make-buffer #f32(1.0 0.0 0.0 1.0 + 0.0 1.0 0.0 1.0 + 0.0 0.0 1.0 1.0))) + ;; This isn't necessary for a single triangle, but we're doing it + ;; anyway just to exercise that code. + (define indices (make-buffer #u32(0 1 2) #:target 'index)) + (set! vertex-array + (make-vertex-array + #:indices (make-vertex-attribute + #:buffer indices + #:type 'scalar + #:component-type 'unsigned-int) + #:attributes `((0 . ,(make-vertex-attribute + #:buffer verts + #:type 'vec2 + #:component-type 'float)) + (1 . ,(make-vertex-attribute + #:buffer colors + #:type 'color + #:component-type 'float))))) + (set! shader (strings->shader + " +#ifdef GLSL330 +layout (location = 0) in vec2 position; +layout (location = 1) in vec4 color; +#elif defined(GLSL130) +in vec2 position; +in vec4 color; +#elif defined(GLSL120) +attribute vec2 position; +attribute vec4 color; +#endif +#ifdef GLSL120 +varying vec4 fragColor; +#else +out vec4 fragColor; +#endif +uniform mat4 mvp; + +void main(void) { + fragColor = color; + gl_Position = mvp * vec4(position, 0.0, 1.0); +} +" + " +#ifdef GLSL120 +varying vec4 fragColor; +#else +in vec4 fragColor; + #endif +#ifdef GLSL330 +out vec4 outFragColor; +#endif + +void main (void) { +#ifdef GLSL330 + outFragColor = fragColor; +#else + gl_FragColor = fragColor; +#endif +} +"))) + +(define (draw alpha) + (shader-apply shader vertex-array #:mvp (current-projection))) + +(run-game #:load load #:draw draw) |