First commit!main

1 files changed, 965 insertions, 0 deletions

diff --git a/sdl3/gpu.scm b/sdl3/gpu.scm
new file mode 100644
index 0000000..6dc136b
--- /dev/null
+++ b/sdl3/gpu.scm
@@ -0,0 +1,965 @@
+;;; guile-sdl3 -- Scheme bindings for SDL3
+;;; Copyright © 2024 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:
+;;
+;; SDL3 3D rendering and GPU compute.
+;;
+;;; Code:
+
+(define-module (sdl3 gpu)
+  #:use-module (bstruct)
+  #:use-module (ice-9 match)
+  #:use-module (rnrs bytevectors)
+  #:use-module (sdl3 bindings gpu)
+  #:use-module (sdl3 bindings surface)
+  #:use-module (sdl3 bindings video)
+  #:use-module (sdl3 errors)
+  #:use-module (srfi srfi-9)
+  #:use-module (system foreign)
+  #:export (num-gpu-drivers
+            gpu-driver
+
+            make-gpu-device
+            destroy-gpu-device!
+            gpu-device-driver
+            claim-window-for-gpu-device!
+            release-window-from-gpu-device!
+            gpu-texture-supports-sample-count?
+            gpu-swapchain-texture-format
+
+            make-gpu-buffer
+            release-gpu-buffer!
+            set-gpu-buffer-name!
+
+            make-gpu-transfer-buffer
+            release-gpu-transfer-buffer!
+            map-gpu-transfer-buffer!
+            unmap-gpu-transfer-buffer!
+
+            make-gpu-shader
+            release-gpu-shader!
+
+            make-gpu-texture
+            release-gpu-texture!
+
+            make-gpu-vertex-buffer-description
+            gpu-vertex-buffer-description?
+            gpu-vertex-buffer-description-slot
+            gpu-vertex-buffer-description-pitch
+            gpu-vertex-buffer-description-input-rate
+            gpu-vertex-buffer-description-instance-step-rate
+
+            make-gpu-vertex-attribute
+            gpu-vertex-attribute?
+            gpu-vertex-attribute-location
+            gpu-vertex-attribute-buffer-slot
+            gpu-vertex-attribute-format
+            gpu-vertex-attribute-offset
+
+            make-gpu-vertex-input-state
+            gpu-vertex-input-state?
+            gpu-vertex-input-state-vertex-buffer-descriptions
+            gpu-vertex-input-state-vertex-attributes
+
+            make-gpu-stencil-op-state
+            gpu-stencil-op-state?
+            gpu-stencil-op-state-fail
+            gpu-stencil-op-state-pass
+            gpu-stencil-op-state-depth-fail
+            gpu-stencil-op-state-compare
+
+            make-gpu-color-target-blend-state
+            gpu-color-target-blend-state?
+            gpu-color-target-blend-state-src-color-factor
+            gpu-color-target-blend-state-dst-color-factor
+            gpu-color-target-blend-state-color-op
+            gpu-color-target-blend-state-src-alpha-factor
+            gpu-color-target-blend-state-dst-alpha-factor
+            gpu-color-target-blend-state-alpha-op
+            gpu-color-target-blend-state-color-write-mask
+
+            make-gpu-rasterizer-state
+            gpu-rasterizer-state?
+            gpu-rasterizer-state-fill-mode
+            gpu-rasterizer-state-cull-mode
+            gpu-rasterizer-state-front-face
+            gpu-rasterizer-state-depth-bias-constant-factor
+            gpu-rasterizer-state-depth-bias-clamp
+            gpu-rasterizer-state-depth-bias-slope-factor
+            gpu-rasterizer-state-depth-clip?
+
+            make-gpu-multisample-state
+            gpu-multisample-state?
+            gpu-multisample-state-sample-count
+            gpu-multisample-state-sample-mask
+
+            make-gpu-depth-stencil-state
+            gpu-depth-stencil-state?
+            gpu-depth-stencil-state-compare-op
+            gpu-depth-stencil-state-back-stencil-state
+            gpu-depth-stencil-state-front-stencil-state
+            gpu-depth-stencil-state-compare-mask
+            gpu-depth-stencil-state-write-mask
+
+            make-gpu-color-target-description
+            gpu-color-target-description?
+            gpu-color-target-description-format
+            gpu-color-target-description-blend-state
+
+            make-gpu-graphics-pipeline-target-info
+            gpu-graphics-pipeline-target-info?
+            gpu-graphics-pipeline-target-info-color-targets
+            gpu-graphics-pipeline-target-info-depth-stencil-format
+
+            make-gpu-graphics-pipeline
+            release-gpu-graphics-pipeline!
+
+            acquire-gpu-command-buffer
+            submit-gpu-command-buffer!
+            acquire-gpu-swapchain-texture
+            push-gpu-fragment-uniform-data
+            push-gpu-vertex-uniform-data
+            make-gpu-blit-info
+            gpu-blit-info?
+            set-gpu-blit-info-source-texture!
+            set-gpu-blit-info-destination-texture!
+            blit-gpu-texture
+
+            begin-gpu-copy-pass
+            end-gpu-copy-pass
+            upload-to-gpu-buffer
+
+            make-gpu-color-target
+            set-gpu-color-target-texture!
+
+            make-gpu-depth-stencil-target
+            make-gpu-buffer-binding
+
+            begin-gpu-render-pass
+            end-gpu-render-pass
+            bind-gpu-graphics-pipeline
+            bind-gpu-vertex-buffers
+            draw-gpu-primitives)
+  #:re-export (gpu-device?
+               gpu-device-destroyed?
+
+               gpu-buffer?
+               gpu-buffer-released?
+
+               gpu-transfer-buffer?
+               gpu-transfer-buffer-released?
+
+               gpu-shader?
+               gpu-shader-released?
+
+               gpu-texture?
+               gpu-texture-released?
+
+               gpu-graphics-pipeline?
+               gpu-graphics-pipeline-released?
+
+               gpu-command-buffer?
+               gpu-copy-pass?
+               gpu-render-pass?
+               gpu-compute-pass?))
+
+(define-syntax-rule (define-record-type* name
+                      (constructor arg-spec ...)
+                      pred
+                      (field accessors ...)
+                      ...)
+  (begin
+    (define-record-type name
+      (%constructor field ...)
+      pred
+      (field accessors ...) ...)
+    (define* (constructor arg-spec ...)
+      (%constructor field ...))))
+
+(define-syntax-rule (bstruct-alloc-pointer type elems ...)
+  (bstruct->pointer type (bstruct-alloc type elems ...)))
+
+(define (gpu-num-gpu-drivers)
+  (SDL_GetNumGPUDrivers))
+
+(define (gpu-driver index)
+  (pointer->string
+   (sdl-assert-non-null
+    'gpu-driver
+    (SDL_GetGPUDriver index))))
+
+
+;;;
+;;; Devices
+;;;
+
+(define* (make-gpu-device shader-formats #:key debug? driver)
+  (wrap-gpu-device
+   (sdl-assert-non-null
+    'make-gpu-device
+    (SDL_CreateGPUDevice (symbols->gpu-shader-format shader-formats)
+                         (if debug? 1 0)
+                         (if driver
+                             (string->pointer driver)
+                             %null-pointer)))))
+
+(define (destroy-gpu-device! device)
+  (unless (gpu-device-destroyed? device)
+    (SDL_DestroyGPUDevice (unwrap-gpu-device device))
+    (set-gpu-device-destroyed! device #t)))
+
+(define (gpu-device-driver device)
+  (pointer->string
+   (sdl-assert-non-null
+    'gpu-device-driver
+    (SDL_GetGPUDeviceDriver (unwrap-gpu-device device)))))
+
+(define (claim-window-for-gpu-device! device window)
+  (sdl-assert
+   'claim-window-for-gpu-device!
+   (SDL_ClaimWindowForGPUDevice (unwrap-gpu-device device)
+                                (unwrap-window window))))
+
+(define (release-window-from-gpu-device! device window)
+  (SDL_ReleaseWindowFromGPUDevice (unwrap-gpu-device device)
+                                  (unwrap-window window)))
+
+(define (gpu-texture-supports-sample-count? device format sample-count)
+  (eq? (SDL_GPUTextureSupportsSampleCount (unwrap-gpu-device device)
+                                          (symbol->gpu-texture-format format)
+                                          (int->gpu-sample-count sample-count))
+       1))
+
+(define (gpu-swapchain-texture-format device window)
+  (gpu-texture-format->symbol
+   (SDL_GetGPUSwapchainTextureFormat (unwrap-gpu-device device)
+                                     (unwrap-window window))))
+
+
+;;;
+;;; Buffers
+;;;
+
+(define (make-gpu-buffer device size usage)
+  (wrap-gpu-buffer
+   (sdl-assert-non-null
+    'make-gpu-buffer
+    (SDL_CreateGPUBuffer (unwrap-gpu-device device)
+                         (bstruct-alloc-pointer
+                          SDL_GPUBufferCreateInfo
+                          (usage (symbols->gpu-buffer-usage-flags usage))
+                          (size size))))))
+
+(define (release-gpu-buffer! device buffer)
+  (unless (gpu-buffer-released? buffer)
+    (SDL_ReleaseGPUBuffer (unwrap-gpu-device device)
+                          (unwrap-gpu-buffer buffer))
+    (set-gpu-buffer-released! buffer #t)))
+
+(define (set-gpu-buffer-name! device buffer name)
+  (SDL_SetGPUBufferName (unwrap-gpu-device device)
+                        (unwrap-gpu-buffer buffer)
+                        (string->pointer name)))
+
+
+;;;
+;;; Transfer buffers
+;;;
+
+(define (make-gpu-transfer-buffer device size usage)
+  (wrap-gpu-transfer-buffer
+   (sdl-assert-non-null
+    'make-gpu-transfer-buffer
+    (SDL_CreateGPUTransferBuffer (unwrap-gpu-device device)
+                                 (bstruct-alloc-pointer
+                                  SDL_GPUTransferBufferCreateInfo
+                                  (usage (symbol->gpu-transfer-buffer-usage usage))
+                                  (size size))))))
+
+(define (release-gpu-transfer-buffer! device buffer)
+  (unless (gpu-transfer-buffer-released? buffer)
+    (SDL_ReleaseGPUTransferBuffer (unwrap-gpu-device device)
+                                  (unwrap-gpu-transfer-buffer buffer))
+    (set-gpu-transfer-buffer-released! buffer #t)))
+
+(define* (map-gpu-transfer-buffer! device buffer len #:optional cycle?)
+  (pointer->bytevector
+   (sdl-assert-non-null
+    'map-gpu-transfer-buffer!
+    (SDL_MapGPUTransferBuffer (unwrap-gpu-device device)
+                              (unwrap-gpu-transfer-buffer buffer)
+                              (if cycle? 1 0)))
+   len))
+
+(define (unmap-gpu-transfer-buffer! device buffer)
+  (SDL_UnmapGPUTransferBuffer (unwrap-gpu-device device)
+                              (unwrap-gpu-transfer-buffer buffer)))
+
+
+;;;
+;;; Shaders
+;;;
+
+(define* (make-gpu-shader device stage format code #:key
+                          (samplers 0)
+                          (storage-buffers 0)
+                          (uniform-buffers 0)
+                          (entry-point "main"))
+  (wrap-gpu-shader
+   (sdl-assert-non-null
+    'make-gpu-shader
+    (SDL_CreateGPUShader (unwrap-gpu-device device)
+                         (bstruct-alloc-pointer
+                          SDL_GPUShaderCreateInfo
+                          (code_size (bytevector-length code))
+                          (code (bytevector->pointer code))
+                          (entrypoint (string->pointer entry-point))
+                          (format (symbols->gpu-shader-format (list format)))
+                          (stage (symbol->gpu-shader-stage stage))
+                          (num_samplers samplers)
+                          (num_storage_buffers storage-buffers)
+                          (num_uniform_buffers uniform-buffers))))))
+
+(define (release-gpu-shader! device shader)
+  (unless (gpu-shader-released? shader)
+    (SDL_ReleaseGPUShader (unwrap-gpu-device device)
+                          (unwrap-gpu-shader shader))
+    (set-gpu-shader-released! shader #t)))
+
+
+;;;
+;;; Textures
+;;;
+
+(define* (make-gpu-texture device
+                           #:key
+                           (type '2d)
+                           (format 'r8g8b8a8-unorm)
+                           (usage '(color-target))
+                           (width 1)
+                           (height 1)
+                           (layer-count-or-depth 1)
+                           (levels 1)
+                           (sample-count 1))
+  (wrap-gpu-texture
+   (sdl-assert-non-null
+    'make-gpu-texture
+    (SDL_CreateGPUTexture (unwrap-gpu-device device)
+                          (bstruct-alloc-pointer
+                           SDL_GPUTextureCreateInfo
+                           (type (symbol->gpu-texture-type type))
+                           (format (symbol->gpu-texture-format format))
+                           (usage (symbols->gpu-texture-usage-flags usage))
+                           (width width)
+                           (height height)
+                           (layer_count_or_depth layer-count-or-depth)
+                           (num_levels levels)
+                           (sample_count (int->gpu-sample-count sample-count)))))))
+
+(define (release-gpu-texture! device texture)
+  (unless (gpu-texture-released? texture)
+    (SDL_ReleaseGPUTexture (unwrap-gpu-device device)
+                           (unwrap-gpu-texture texture))
+    (set-gpu-texture-released! texture #t)))
+
+
+;;;
+;;; Graphics pipelines
+;;;
+
+(define-record-type* <gpu-vertex-buffer-description>
+  (make-gpu-vertex-buffer-description #:key slot pitch (input-rate 'vertex) (instance-step-rate 0))
+  gpu-vertex-buffer-description?
+  (slot gpu-vertex-buffer-description-slot)
+  (pitch gpu-vertex-buffer-description-pitch)
+  (input-rate gpu-vertex-buffer-description-input-rate)
+  (instance-step-rate gpu-vertex-buffer-description-instance-step-rate))
+
+(define-record-type* <gpu-vertex-attribute>
+  (make-gpu-vertex-attribute #:key location buffer-slot format (offset 0))
+  gpu-vertex-attribute?
+  (location gpu-vertex-attribute-location)
+  (buffer-slot gpu-vertex-attribute-buffer-slot)
+  (format gpu-vertex-attribute-format)
+  (offset gpu-vertex-attribute-offset))
+
+(define-record-type* <gpu-vertex-input-state>
+  (make-gpu-vertex-input-state #:key
+                               (vertex-buffer-descriptions #())
+                               (vertex-attributes #()))
+  gpu-vertex-input-state?
+  (vertex-buffer-descriptions gpu-vertex-input-state-vertex-buffer-descriptions)
+  (vertex-attributes gpu-vertex-input-state-vertex-attributes))
+
+(define-record-type* <gpu-stencil-op-state>
+  (make-gpu-stencil-op-state #:key
+                             (fail 'keep)
+                             (pass 'keep)
+                             (depth-fail 'keep)
+                             (compare 'always))
+  gpu-stencil-op-state?
+  (fail gpu-stencil-op-state-fail)
+  (pass gpu-stencil-op-state-pass)
+  (depth-fail gpu-stencil-op-state-depth-fail)
+  (compare gpu-stencil-op-state-compare))
+
+(define-record-type* <gpu-color-target-blend-state>
+  (make-gpu-color-target-blend-state #:key
+                                     (src-color-factor 'one)
+                                     (dst-color-factor 'zero)
+                                     (color-op 'add)
+                                     (src-alpha-factor 'one)
+                                     (dst-alpha-factor 'zero)
+                                     (alpha-op 'add)
+                                     (color-write-mask '(r g b a)))
+  gpu-color-target-blend-state?
+  (src-color-factor gpu-color-target-blend-state-src-color-factor)
+  (dst-color-factor gpu-color-target-blend-state-dst-color-factor)
+  (color-op gpu-color-target-blend-state-color-op)
+  (src-alpha-factor gpu-color-target-blend-state-src-alpha-factor)
+  (dst-alpha-factor gpu-color-target-blend-state-dst-alpha-factor)
+  (alpha-op gpu-color-target-blend-state-alpha-op)
+  (color-write-mask gpu-color-target-blend-state-color-write-mask))
+
+(define-record-type* <gpu-rasterizer-state>
+  (make-gpu-rasterizer-state #:key
+                             (fill-mode 'fill)
+                             (cull-mode 'none)
+                             (front-face 'counter-clockwise)
+                             depth-bias-constant-factor
+                             depth-bias-clamp
+                             depth-bias-slope-factor
+                             depth-clip?)
+  gpu-rasterizer-state?
+  (fill-mode gpu-rasterizer-state-fill-mode)
+  (cull-mode gpu-rasterizer-state-cull-mode)
+  (front-face gpu-rasterizer-state-front-face)
+  (depth-bias-constant-factor gpu-rasterizer-state-depth-bias-constant-factor)
+  (depth-bias-clamp gpu-rasterizer-state-depth-bias-clamp)
+  (depth-bias-slope-factor gpu-rasterizer-state-depth-bias-slope-factor)
+  (depth-clip? gpu-rasterizer-state-depth-clip?))
+
+(define-record-type* <gpu-multisample-state>
+  (make-gpu-multisample-state #:key
+                              (sample-count 1)
+                              (sample-mask #xffffffff))
+  gpu-multisample-state?
+  (sample-count gpu-multisample-state-sample-count)
+  (sample-mask gpu-multisample-state-sample-mask))
+
+(define-record-type* <gpu-depth-stencil-state>
+  (make-gpu-depth-stencil-state #:key
+                                (compare-op 'always)
+                                (back-stencil-state (make-gpu-stencil-op-state))
+                                (front-stencil-state (make-gpu-stencil-op-state))
+                                (compare-mask #xff)
+                                (write-mask #xff))
+  gpu-depth-stencil-state?
+  (compare-op gpu-depth-stencil-state-compare-op)
+  (back-stencil-state gpu-depth-stencil-state-back-stencil-state)
+  (front-stencil-state gpu-depth-stencil-state-front-stencil-state)
+  (compare-mask gpu-depth-stencil-state-compare-mask)
+  (write-mask gpu-depth-stencil-state-write-mask))
+
+(define-record-type* <gpu-color-target-description>
+  (make-gpu-color-target-description #:key
+                                     format
+                                     (blend-state #f))
+  gpu-color-target-description?
+  (format gpu-color-target-description-format)
+  (blend-state gpu-color-target-description-blend-state))
+
+(define-record-type* <gpu-graphics-pipeline-target-info>
+  (make-gpu-graphics-pipeline-target-info #:key
+                                          (color-targets #())
+                                          depth-stencil-format)
+  gpu-graphics-pipeline-target-info?
+  (color-targets gpu-graphics-pipeline-target-info-color-targets)
+  (depth-stencil-format gpu-graphics-pipeline-target-info-depth-stencil-format))
+
+(define-syntax-rule (bstruct-vector->bytevector type v proc elem ...)
+  (let* ((n (vector-length v))
+         (bv (make-bytevector (* (bstruct-sizeof type) n))))
+    (do ((i 0 (1+ i)))
+        ((= i n))
+      (call-with-values (lambda () (proc (vector-ref n i)))
+        (lambda (elem ...)
+          (bstruct-pack type bv (* (bstruct-sizeof type) i)
+                        (elem elem) ...))))))
+
+(define* (make-gpu-graphics-pipeline device #:key
+                                     vertex-shader
+                                     fragment-shader
+                                     vertex-input-state
+                                     (primitive-type 'triangle-list)
+                                     (rasterizer-state (make-gpu-rasterizer-state))
+                                     multisample-state
+                                     depth-stencil-state
+                                     target-info)
+  (match-let ((($ <gpu-vertex-input-state> vertex-buffer-descriptions
+                                           vertex-attributes)
+               vertex-input-state)
+              (($ <gpu-rasterizer-state> fill-mode
+                                         cull-mode
+                                         front-face
+                                         depth-bias-constant-factor
+                                         depth-bias-clamp
+                                         depth-bias-slope-factor
+                                         depth-clip?)
+               rasterizer-state)
+              (($ <gpu-multisample-state> sample-count sample-mask)
+               multisample-state)
+              (($ <gpu-depth-stencil-state> compare-op
+                                            ($ <gpu-stencil-op-state> back-fail
+                                                                      back-pass
+                                                                      back-depth-fail
+                                                                      back-compare)
+                                            ($ <gpu-stencil-op-state> front-fail
+                                                                      front-pass
+                                                                      front-depth-fail
+                                                                      front-compare)
+                                            compare-mask
+                                            write-mask)
+               depth-stencil-state)
+              (($ <gpu-graphics-pipeline-target-info> color-targets
+                                                      depth-stencil-format)
+               target-info))
+    ;; Build vertex buffer description structs.
+    ;; TODO: bstructs should provide a macro to make this easier.
+    ;; (bstruct-vector->bytevector SDL_GPUVertexBufferDescription
+    ;;                             vertex-buffer-descriptions)
+    (define num-vert-descs (vector-length vertex-buffer-descriptions))
+    (define vert-descs
+      (make-bytevector (* (bstruct-sizeof SDL_GPUVertexBufferDescription)
+                          num-vert-descs)))
+    (do ((i 0 (1+ i)))
+        ((= i num-vert-descs))
+      (match (vector-ref vertex-buffer-descriptions i)
+        (($ <gpu-vertex-buffer-description> slot pitch input-rate
+                                            instance-step-rate)
+         (bstruct-pack!
+          SDL_GPUVertexBufferDescription
+          vert-descs
+          (* (bstruct-sizeof SDL_GPUVertexBufferDescription) i)
+          (slot slot)
+          (pitch pitch)
+          (input_rate (symbol->gpu-vertex-input-rate input-rate))
+          (instance_step_rate instance-step-rate)))))
+    ;; Build vertex attrifbute structsl
+    (define num-vert-attrs (vector-length vertex-attributes))
+    (define vert-attrs
+      (make-bytevector (* (bstruct-sizeof SDL_GPUVertexAttribute)
+                          num-vert-attrs)))
+    (do ((i 0 (1+ i)))
+        ((= i num-vert-attrs))
+      (match (vector-ref vertex-attributes i)
+        (($ <gpu-vertex-attribute> location buffer-slot format offset)
+         (bstruct-pack!
+          SDL_GPUVertexAttribute
+          vert-attrs
+          (* (bstruct-sizeof SDL_GPUVertexAttribute) i)
+          (location location)
+          (buffer_slot buffer-slot)
+          (format (symbol->gpu-vertex-element-format format))
+          (offset offset)))))
+    ;; Build color target structs.
+    (define num-color-targets (vector-length color-targets))
+    ;; (define color-target-descs
+    ;;   (make-bytevector (* (bstruct-sizeof SDL_GPUColorTargetDescription)
+    ;;                       num-color-targets)))
+    (define color-target-descs
+      (bstruct-alloc (SDL_GPUColorTargetDescription num-color-targets)))
+    (do ((i 0 (1+ i)))
+        ((= i num-color-targets))
+      (match (vector-ref color-targets i)
+        (($ <gpu-color-target-description> format #f)
+         (bstruct-set!
+          (SDL_GPUColorTargetDescription i)
+          color-target-descs
+          (format (symbol->gpu-texture-format format))))
+        (($ <gpu-color-target-description>
+            format
+            ($ <gpu-color-target-blend-state>
+               src-color-factor
+               dst-color-factor
+               color-op
+               src-alpha-factor
+               dst-alpha-factor
+               alpha-op
+               color-write-mask))
+         (bstruct-set!
+          (SDL_GPUColorTargetDescription i)
+          color-target-descs
+          (format (symbol->gpu-texture-format format))
+          (-> blend_state
+              (src_color_blendfactor (symbol->gpu-blend-factor src-color-factor))
+              (dst_color_blendfactor (symbol->gpu-blend-factor dst-color-factor))
+              (color_blend_op (symbol->gpu-blend-op color-op))
+              (src_alpha_blendfactor (symbol->gpu-blend-factor src-alpha-factor))
+              (dst_alpha_blendfactor (symbol->gpu-blend-factor dst-alpha-factor))
+              (alpha_blend_op (symbol->gpu-blend-op alpha-op))
+              (color_write_mask (symbols->gpu-color-component-flags color-write-mask))
+              (enable_blend 1)
+              (enable_color_write_mask 1))))))
+    ;; Build giant pipeline descriptor struct.
+    (define desc
+      (bstruct-alloc
+       SDL_GPUGraphicsPipelineCreateInfo
+       (vertex_shader (unwrap-gpu-shader vertex-shader))
+       (fragment_shader (unwrap-gpu-shader fragment-shader))
+       (-> vertex_input_state
+           (vertex_buffer_descriptions (bytevector->pointer vert-descs))
+           (num_vertex_buffers num-vert-descs)
+           (vertex_attributes (bytevector->pointer vert-attrs))
+           (num_vertex_attributes num-vert-attrs))
+       (primitive_type (symbol->gpu-primitive-type primitive-type))
+       (-> rasterizer_state
+           (fill_mode (symbol->gpu-fill-mode fill-mode))
+           (cull_mode (symbol->gpu-cull-mode cull-mode))
+           (front_face (symbol->gpu-front-face front-face))
+           (enable_depth_clip (if depth-clip? 1 0))
+           (enable_depth_bias (if (and depth-bias-constant-factor
+                                       depth-bias-clamp
+                                       depth-bias-slope-factor)
+                                  1 0))
+           (depth_bias_constant_factor (or depth-bias-constant-factor 0.0))
+           (depth_bias_clamp (or depth-bias-clamp 0.0))
+           (depth_bias_slope_factor (or depth-bias-slope-factor 0.0)))
+       (-> multisample_state
+           (sample_count (int->gpu-sample-count sample-count))
+           (sample_mask sample-mask)
+           (enable_mask 1))
+       (-> depth_stencil_state
+           (compare_op (symbol->gpu-compare-op compare-op))
+           (-> back_stencil_state
+               (fail_op (symbol->gpu-stencil-op back-fail))
+               (pass_op (symbol->gpu-stencil-op back-pass))
+               (depth_fail_op (symbol->gpu-stencil-op back-depth-fail))
+               (compare_op (symbol->gpu-compare-op back-compare)))
+           (-> front_stencil_state
+               (fail_op (symbol->gpu-stencil-op front-fail))
+               (pass_op (symbol->gpu-stencil-op front-pass))
+               (depth_fail_op (symbol->gpu-stencil-op front-depth-fail))
+               (compare_op (symbol->gpu-compare-op front-compare)))
+           (compare_mask compare-mask)
+           (write_mask compare-mask)
+           (enable_depth_test 1)
+           (enable_depth_write 1)
+           (enable_stencil_test 0))
+       (-> target_info
+           (color_target_descriptions (bstruct->pointer SDL_GPUColorTargetDescription
+                                                        color-target-descs))
+           (num_color_targets num-color-targets)
+           (depth_stencil_format (symbol->gpu-texture-format depth-stencil-format))
+           (has_depth_stencil_target 1))))
+    (wrap-gpu-graphics-pipeline
+     (sdl-assert-non-null
+      'make-gpu-graphics-pipeline
+      (SDL_CreateGPUGraphicsPipeline (unwrap-gpu-device device)
+                                     (bstruct->pointer
+                                      SDL_GPUGraphicsPipelineCreateInfo
+                                      desc))))))
+
+(define (release-gpu-graphics-pipeline! device graphics-pipeline)
+  (unless (gpu-graphics-pipeline-released? graphics-pipeline)
+    (SDL_ReleaseGPUGraphicsPipeline (unwrap-gpu-device device)
+                                    (unwrap-gpu-graphics-pipeline
+                                     graphics-pipeline))
+    (set-gpu-graphics-pipeline-released! graphics-pipeline #t)))
+
+
+;;;
+;;; Command buffers
+;;;
+
+;; TODO: Do the same pointers get used over and over for buffers and
+;; passes? If so we should cache them to avoid allocation of FFI
+;; pointer objects.
+(define (acquire-gpu-command-buffer device)
+  (wrap-gpu-command-buffer
+   (sdl-assert-non-null
+    'acquire-gpu-command-buffer
+    (SDL_AcquireGPUCommandBuffer (unwrap-gpu-device device)))))
+
+(define (submit-gpu-command-buffer! cmd)
+  (sdl-assert
+   'submit-gpu-command-buffer
+   (SDL_SubmitGPUCommandBuffer (unwrap-gpu-command-buffer cmd))))
+
+(define-bstruct <swapchain-info>
+  (struct
+   (texture (* void))
+   (width uint32)
+   (height uint32)))
+
+;; TODO: This gets called every frame so we need to get rid of the
+;; allocation.  The swapchain texture is cycled so the same pointers
+;; get reused over and over.
+(define (acquire-gpu-swapchain-texture cmd window)
+  (let ((info (bstruct-alloc <swapchain-info>)))
+    (sdl-assert
+     'acquire-gpu-swapchain-texture
+     (SDL_AcquireGPUSwapchainTexture (unwrap-gpu-command-buffer cmd)
+                                     (unwrap-window window)
+                                     (bstruct->pointer <swapchain-info>
+                                                       info texture)
+                                     (bstruct->pointer <swapchain-info>
+                                                       info width)
+                                     (bstruct->pointer <swapchain-info>
+                                                       info height)))
+    (values (wrap-gpu-texture (bstruct-ref <swapchain-info> info texture))
+            (bstruct-ref <swapchain-info> info width)
+            (bstruct-ref <swapchain-info> info height))))
+
+(define* (push-gpu-fragment-uniform-data cmd slot data #:optional
+                                         (length (bytevector-length data))
+                                         (offset 0))
+  (SDL_PushGPUFragmentUniformData (unwrap-gpu-command-buffer cmd)
+                                  slot
+                                  (bytevector->pointer data offset)
+                                  length))
+
+(define* (push-gpu-vertex-uniform-data cmd slot data #:optional
+                                       (length (bytevector-length data))
+                                       (offset 0))
+  (SDL_PushGPUVertexUniformData (unwrap-gpu-command-buffer cmd)
+                                slot
+                                (bytevector->pointer data offset)
+                                length))
+
+(define* (make-gpu-blit-info #:key
+                             source-texture
+                             (source-mip-level 0)
+                             (source-layer-or-depth-plane 0)
+                             (source-x 0)
+                             (source-y 0)
+                             (source-width 0)
+                             (source-height 0)
+                             destination-texture
+                             (destination-mip-level 0)
+                             (destination-layer-or-depth-plane 0)
+                             (destination-x 0)
+                             (destination-y 0)
+                             (destination-width 0)
+                             (destination-height 0)
+                             (load-op 'dont-care)
+                             (clear-color 'todo)
+                             (flip-mode 'none)
+                             (filter 'linear)
+                             cycle?)
+  (bstruct-alloc
+   SDL_GPUBlitInfo
+   (-> source
+       (texture (if source-texture
+                    (unwrap-gpu-texture source-texture)
+                    %null-pointer))
+       (mip_level source-mip-level)
+       (layer_or_depth_plane source-layer-or-depth-plane)
+       (x source-x)
+       (y source-y)
+       (w source-width)
+       (h source-height))
+   (-> destination
+       (texture (if destination-texture
+                    (unwrap-gpu-texture destination-texture)
+                    %null-pointer))
+       (mip_level destination-mip-level)
+       (layer_or_depth_plane destination-layer-or-depth-plane)
+       (x destination-x)
+       (y destination-y)
+       (w destination-width)
+       (h destination-height))
+   (load_op (symbol->gpu-load-op load-op))
+   (flip_mode (symbol->flip-mode flip-mode))
+   (filter (symbol->gpu-filter filter))
+   (cycle (if cycle? 1 0))))
+
+(define (gpu-blit-info? obj)
+  (bstruct? SDL_GPUBlitInfo obj))
+
+(define (set-gpu-blit-info-source-texture! blit-info texture)
+  (bstruct-set! SDL_GPUBlitInfo blit-info
+                ((source texture) (unwrap-gpu-texture texture))))
+
+(define (set-gpu-blit-info-destination-texture! blit-info texture)
+  (bstruct-set! SDL_GPUBlitInfo blit-info
+                ((destination texture) (unwrap-gpu-texture texture))))
+
+(define (blit-gpu-texture cmd blit-info)
+  (SDL_BlitGPUTexture (unwrap-gpu-command-buffer cmd)
+                      (bstruct->pointer SDL_GPUBlitInfo blit-info)))
+
+
+;;;
+;;; Copy passes
+;;;
+
+(define (begin-gpu-copy-pass cmd)
+  (wrap-gpu-copy-pass
+   (sdl-assert-non-null
+    'begin-gpu-copy-pass
+    (SDL_BeginGPUCopyPass (unwrap-gpu-command-buffer cmd)))))
+
+(define (end-gpu-copy-pass pass)
+  (SDL_EndGPUCopyPass (unwrap-gpu-copy-pass pass)))
+
+(define* (upload-to-gpu-buffer pass source source-start target target-start
+                               len #:optional cycle?)
+  (SDL_UploadToGPUBuffer (unwrap-gpu-copy-pass pass)
+                         (bstruct-alloc-pointer
+                          SDL_GPUTransferBufferLocation
+                          (transfer_buffer (unwrap-gpu-transfer-buffer source))
+                          (offset source-start))
+                         (bstruct-alloc-pointer
+                          SDL_GPUBufferRegion
+                          (buffer (unwrap-gpu-buffer target))
+                          (offset target-start)
+                          (size len))
+                         (if cycle? 1 0)))
+
+
+;;;
+;;; Render passes
+;;;
+
+(define* (make-gpu-color-target texture #:key
+                                (mip-level 0)
+                                (layer-or-depth-plane 0)
+                                (clear-color 'todo)
+                                (load-op 'load)
+                                (store-op 'store)
+                                resolve-texture
+                                (resolve-mip-level 0)
+                                (resolve-layer 0)
+                                cycle?
+                                cycle-resolve-texture?)
+  (bstruct-alloc
+   SDL_GPUColorTargetInfo
+   (texture (if (gpu-texture? texture)
+                (unwrap-gpu-texture texture)
+                %null-pointer))
+   (mip_level mip-level)
+   (layer_or_depth_plane layer-or-depth-plane)
+   ;; ((clear_color r) 0.6)
+   ;; ((clear_color g) 0.2)
+   ;; ((clear_color b) 0.4)
+   ;; ((clear_color a) 1.0)
+   (load_op (symbol->gpu-load-op load-op))
+   (store_op (symbol->gpu-store-op store-op))
+   (resolve_texture (if resolve-texture
+                        (unwrap-gpu-texture resolve-texture)
+                        %null-pointer))
+   (resolve_mip_level resolve-mip-level)
+   (resolve_layer resolve-layer)
+   (cycle (if cycle? 1 0))
+   (cycle_resolve_texture (if cycle-resolve-texture? 1 0))))
+
+(define (set-gpu-color-target-texture! color-target texture)
+  (bstruct-set! SDL_GPUColorTargetInfo color-target
+                (texture (unwrap-gpu-texture texture))))
+
+(define* (make-gpu-depth-stencil-target texture #:key
+                                        (clear-depth 1.0)
+                                        (load-op 'load)
+                                        (store-op 'store)
+                                        (stencil-load-op 'dont-care)
+                                        (stencil-store-op 'dont-care)
+                                        cycle?
+                                        (clear-stencil 0))
+  (bstruct-alloc
+   SDL_GPUDepthStencilTargetInfo
+   (texture (unwrap-gpu-texture texture))
+   (clear_depth clear-depth)
+   (load_op (symbol->gpu-load-op load-op))
+   (store_op (symbol->gpu-store-op store-op))
+   (stencil_load_op (symbol->gpu-load-op stencil-load-op))
+   (stencil_store_op (symbol->gpu-store-op stencil-store-op))
+   (cycle (if cycle? 1 0))
+   (clear_stencil clear-stencil)))
+
+(define* (make-gpu-buffer-binding buffer #:optional (offset 0))
+  (bstruct-alloc
+   SDL_GPUBufferBinding
+   (buffer (unwrap-gpu-buffer buffer))
+   (offset offset)))
+
+(define (begin-gpu-render-pass cmd color-targets depth-stencil-target)
+  (define color-target-size (bstruct-sizeof SDL_GPUColorTargetInfo))
+  (define num-color-targets (vector-length color-targets))
+  (define color-target-infos
+    (make-bytevector (* color-target-size num-color-targets)))
+  (do ((i 0 (1+ i)))
+      ((= i num-color-targets))
+    (let ((offset (* color-target-size i)))
+      (call-with-values
+          (lambda ()
+            (bstruct-unwrap SDL_GPUColorTargetInfo
+                            (vector-ref color-targets i)))
+        (lambda (bv offset* n)
+          (bytevector-copy! bv offset*
+                            color-target-infos offset
+                            color-target-size)))))
+  (wrap-gpu-render-pass
+   (sdl-assert-non-null
+    'begin-gpu-render-pass
+    (SDL_BeginGPURenderPass (unwrap-gpu-command-buffer cmd)
+                            (bytevector->pointer color-target-infos)
+                            num-color-targets
+                            (bstruct->pointer
+                             SDL_GPUDepthStencilTargetInfo
+                             depth-stencil-target)))))
+
+(define (end-gpu-render-pass pass)
+  (SDL_EndGPURenderPass (unwrap-gpu-render-pass pass)))
+
+(define (bind-gpu-graphics-pipeline pass pipeline)
+  (SDL_BindGPUGraphicsPipeline (unwrap-gpu-render-pass pass)
+                               (unwrap-gpu-graphics-pipeline pipeline)))
+
+(define (bind-gpu-vertex-buffers pass first-slot bindings)
+  (define binding-size (bstruct-sizeof SDL_GPUBufferBinding))
+  (define num-bindings (vector-length bindings))
+  (define bindings*
+    (make-bytevector (* binding-size num-bindings)))
+  (do ((i 0 (1+ i)))
+      ((= i num-bindings))
+    (let ((offset (* binding-size i)))
+      (call-with-values (lambda ()
+                          (bstruct-unwrap SDL_GPUBufferBinding
+                                          (vector-ref bindings i)))
+        (lambda (bv offset* n)
+          (bytevector-copy! bv offset*
+                            bindings* offset
+                            binding-size)))))
+  (SDL_BindGPUVertexBuffers (unwrap-gpu-render-pass pass)
+                            first-slot
+                            (bytevector->pointer bindings*)
+                            (vector-length bindings)))
+
+(define* (draw-gpu-primitives pass num-vertices #:optional
+                              (num-instances 1)
+                              (first-vertex 0)
+                              (first-instance 0))
+  (SDL_DrawGPUPrimitives (unwrap-gpu-render-pass pass)
+                         num-vertices
+                         num-instances
+                         first-vertex
+                         first-instance))
+
+
+;;;
+;;; Compute passes
+;;;