;;; guile-sdl3 -- Scheme bindings for SDL3 ;;; Copyright © 2024 David Thompson ;;; ;;; 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* (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* (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* (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* (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* (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* (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* (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* (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* (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* (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 ((($ vertex-buffer-descriptions vertex-attributes) vertex-input-state) (($ fill-mode cull-mode front-face depth-bias-constant-factor depth-bias-clamp depth-bias-slope-factor depth-clip?) rasterizer-state) (($ sample-count sample-mask) multisample-state) (($ compare-op ($ back-fail back-pass back-depth-fail back-compare) ($ front-fail front-pass front-depth-fail front-compare) compare-mask write-mask) depth-stencil-state) (($ 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) (($ 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) (($ 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) (($ format #f) (bstruct-set! (SDL_GPUColorTargetDescription i) color-target-descs (format (symbol->gpu-texture-format format)))) (($ format ($ 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 (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 ))) (sdl-assert 'acquire-gpu-swapchain-texture (SDL_AcquireGPUSwapchainTexture (unwrap-gpu-command-buffer cmd) (unwrap-window window) (bstruct->pointer info texture) (bstruct->pointer info width) (bstruct->pointer info height))) (values (wrap-gpu-texture (bstruct-ref info texture)) (bstruct-ref info width) (bstruct-ref 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 ;;;