From 90f08d32e5ce7be8b5f3c272bcd9a2773cd134ae Mon Sep 17 00:00:00 2001 From: David Thompson Date: Wed, 2 Oct 2024 21:22:19 -0400 Subject: First commit! --- sdl3/gpu.scm | 965 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 965 insertions(+) create mode 100644 sdl3/gpu.scm (limited to 'sdl3/gpu.scm') 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 +;;; +;;; 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 +;;; -- cgit v1.2.3