path: root/sdl3/gpu.scm

;;; 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* (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.
    (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)))
    (do ((i 0 (1+ i)))
        ((= i num-color-targets))
      (match (vector-ref color-targets i)
        (($ <gpu-color-target-description> format #f)
         (bstruct-pack!
          SDL_GPUColorTargetDescription
          color-target-descs
          (* (bstruct-sizeof SDL_GPUColorTargetDescription) i)
          (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-pack!
          SDL_GPUColorTargetDescription
          color-target-descs
          (* (bstruct-sizeof SDL_GPUColorTargetDescription) i)
          (format (symbol->gpu-texture-format format))
          ((blend_state src_color_blendfactor)
           (symbol->gpu-blend-factor src-color-factor))
          ((blend_state dst_color_blendfactor)
           (symbol->gpu-blend-factor dst-color-factor))
          ((blend_state color_blend_op)
           (symbol->gpu-blend-op color-op))
          ((blend_state src_alpha_blendfactor)
           (symbol->gpu-blend-factor src-alpha-factor))
          ((blend_state dst_alpha_blendfactor)
           (symbol->gpu-blend-factor dst-alpha-factor))
          ((blend_state alpha_blend_op)
           (symbol->gpu-blend-op alpha-op))
          ((blend_state color_write_mask)
           (symbols->gpu-color-component-flags color-write-mask))
          ((blend_state enable_blend) 1)
          ((blend_state enable_color_write_mask) 1)))))
    ;; Build giant pipeline descriptor struct.
    ;; TODO: bstructs should provide syntax for nested struct initialization
    (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))
       ((vertex_input_state num_vertex_buffers) num-vert-descs)
       ((vertex_input_state vertex_attributes) (bytevector->pointer vert-attrs))
       ((vertex_input_state num_vertex_attributes) num-vert-attrs)
       (primitive_type (symbol->gpu-primitive-type primitive-type))
       ((rasterizer_state fill_mode) (symbol->gpu-fill-mode fill-mode))
       ((rasterizer_state cull_mode) (symbol->gpu-cull-mode cull-mode))
       ((rasterizer_state front_face) (symbol->gpu-front-face front-face))
       ((rasterizer_state enable_depth_clip) (if depth-clip? 1 0))
       ((rasterizer_state enable_depth_bias)
        (if (and depth-bias-constant-factor
                 depth-bias-clamp
                 depth-bias-slope-factor)
            1 0))
       ((rasterizer_state depth_bias_constant_factor)
        (or depth-bias-constant-factor 0.0))
       ((rasterizer_state depth_bias_clamp)
        (or depth-bias-clamp 0.0))
       ((rasterizer_state depth_bias_slope_factor)
        (or depth-bias-slope-factor 0.0))
       ((multisample_state sample_count) (int->gpu-sample-count sample-count))
       ((multisample_state sample_mask) sample-mask)
       ((multisample_state enable_mask) 1)
       ((depth_stencil_state compare_op) (symbol->gpu-compare-op compare-op))
       ((depth_stencil_state back_stencil_state fail_op)
        (symbol->gpu-stencil-op back-fail))
       ((depth_stencil_state back_stencil_state pass_op)
        (symbol->gpu-stencil-op back-pass))
       ((depth_stencil_state back_stencil_state depth_fail_op)
        (symbol->gpu-stencil-op back-depth-fail))
       ((depth_stencil_state back_stencil_state compare_op)
        (symbol->gpu-compare-op back-compare))
       ((depth_stencil_state front_stencil_state fail_op)
        (symbol->gpu-stencil-op front-fail))
       ((depth_stencil_state front_stencil_state pass_op)
        (symbol->gpu-stencil-op front-pass))
       ((depth_stencil_state front_stencil_state depth_fail_op)
        (symbol->gpu-stencil-op front-depth-fail))
       ((depth_stencil_state front_stencil_state compare_op)
        (symbol->gpu-compare-op front-compare))
       ((depth_stencil_state compare_mask) compare-mask)
       ((depth_stencil_state write_mask) compare-mask)
       ((depth_stencil_state enable_depth_test) 1)
       ((depth_stencil_state enable_depth_write) 1)
       ((depth_stencil_state enable_stencil_test) 0)
       ((target_info color_target_descriptions)
        (bytevector->pointer color-target-descs))
       ((target_info num_color_targets) num-color-targets)
       ((target_info depth_stencil_format)
        (symbol->gpu-texture-format depth-stencil-format))
       ((target_info 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 u32)
   (height u32)))

;; 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))
   ((source mip_level) source-mip-level)
   ((source layer_or_depth_plane) source-layer-or-depth-plane)
   ((source x) source-x)
   ((source y) source-y)
   ((source w) source-width)
   ((source h) source-height)
   ((destination texture)
    (if destination-texture
        (unwrap-gpu-texture destination-texture)
        %null-pointer))
   ((destination mip_level) destination-mip-level)
   ((destination layer_or_depth_plane) destination-layer-or-depth-plane)
   ((destination x) destination-x)
   ((destination y) destination-y)
   ((destination w) destination-width)
   ((destination 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*)
          (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*)
          (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
;;;