From 90f08d32e5ce7be8b5f3c272bcd9a2773cd134ae Mon Sep 17 00:00:00 2001 From: David Thompson Date: Wed, 2 Oct 2024 21:22:19 -0400 Subject: First commit! --- examples/cube.scm | 557 ++++++++++++++++++++++++++++++++++++++++++++++++++++ examples/window.scm | 7 + 2 files changed, 564 insertions(+) create mode 100644 examples/cube.scm create mode 100644 examples/window.scm (limited to 'examples') diff --git a/examples/cube.scm b/examples/cube.scm new file mode 100644 index 0000000..14dd8ff --- /dev/null +++ b/examples/cube.scm @@ -0,0 +1,557 @@ +;;; 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: +;; +;; Adapted from https://github.com/thatcosmonaut/SDL/blob/main/test/testgpu_spinning_cube.c +;; +;;; Code: + +(use-modules (bstruct) + (ice-9 match) + (rnrs bytevectors) + (sdl3) + (sdl3 events) + (sdl3 gpu) + (sdl3 video)) + +;; These SPIR-V blobs are taken directly from SDL. +(define vert-spirv + #vu8( #x03 #x02 #x23 #x07 #x00 #x00 #x01 #x00 #x0b #x00 #x08 #x00 + #x2a #x00 #x00 #x00 #x00 #x00 #x00 #x00 #x11 #x00 #x02 #x00 + #x01 #x00 #x00 #x00 #x0b #x00 #x06 #x00 #x01 #x00 #x00 #x00 + #x47 #x4c #x53 #x4c #x2e #x73 #x74 #x64 #x2e #x34 #x35 #x30 + #x00 #x00 #x00 #x00 #x0e #x00 #x03 #x00 #x00 #x00 #x00 #x00 + #x01 #x00 #x00 #x00 #x0f #x00 #x09 #x00 #x00 #x00 #x00 #x00 + #x04 #x00 #x00 #x00 #x6d #x61 #x69 #x6e #x00 #x00 #x00 #x00 + #x09 #x00 #x00 #x00 #x0c #x00 #x00 #x00 #x18 #x00 #x00 #x00 + #x22 #x00 #x00 #x00 #x03 #x00 #x03 #x00 #x02 #x00 #x00 #x00 + #xc2 #x01 #x00 #x00 #x05 #x00 #x04 #x00 #x04 #x00 #x00 #x00 + #x6d #x61 #x69 #x6e #x00 #x00 #x00 #x00 #x05 #x00 #x05 #x00 + #x09 #x00 #x00 #x00 #x6f #x75 #x74 #x5f #x63 #x6f #x6c #x6f + #x72 #x00 #x00 #x00 #x05 #x00 #x05 #x00 #x0c #x00 #x00 #x00 + #x69 #x6e #x5f #x63 #x6f #x6c #x6f #x72 #x00 #x00 #x00 #x00 + #x05 #x00 #x06 #x00 #x16 #x00 #x00 #x00 #x67 #x6c #x5f #x50 + #x65 #x72 #x56 #x65 #x72 #x74 #x65 #x78 #x00 #x00 #x00 #x00 + #x06 #x00 #x06 #x00 #x16 #x00 #x00 #x00 #x00 #x00 #x00 #x00 + #x67 #x6c #x5f #x50 #x6f #x73 #x69 #x74 #x69 #x6f #x6e #x00 + #x06 #x00 #x07 #x00 #x16 #x00 #x00 #x00 #x01 #x00 #x00 #x00 + #x67 #x6c #x5f #x50 #x6f #x69 #x6e #x74 #x53 #x69 #x7a #x65 + #x00 #x00 #x00 #x00 #x06 #x00 #x07 #x00 #x16 #x00 #x00 #x00 + #x02 #x00 #x00 #x00 #x67 #x6c #x5f #x43 #x6c #x69 #x70 #x44 + #x69 #x73 #x74 #x61 #x6e #x63 #x65 #x00 #x06 #x00 #x07 #x00 + #x16 #x00 #x00 #x00 #x03 #x00 #x00 #x00 #x67 #x6c #x5f #x43 + #x75 #x6c #x6c #x44 #x69 #x73 #x74 #x61 #x6e #x63 #x65 #x00 + #x05 #x00 #x03 #x00 #x18 #x00 #x00 #x00 #x00 #x00 #x00 #x00 + #x05 #x00 #x03 #x00 #x1c #x00 #x00 #x00 #x55 #x42 #x4f #x00 + #x06 #x00 #x07 #x00 #x1c #x00 #x00 #x00 #x00 #x00 #x00 #x00 + #x6d #x6f #x64 #x65 #x6c #x56 #x69 #x65 #x77 #x50 #x72 #x6f + #x6a #x00 #x00 #x00 #x05 #x00 #x03 #x00 #x1e #x00 #x00 #x00 + #x00 #x00 #x00 #x00 #x05 #x00 #x05 #x00 #x22 #x00 #x00 #x00 + #x69 #x6e #x5f #x70 #x6f #x73 #x69 #x74 #x69 #x6f #x6e #x00 + #x47 #x00 #x04 #x00 #x09 #x00 #x00 #x00 #x1e #x00 #x00 #x00 + #x00 #x00 #x00 #x00 #x47 #x00 #x04 #x00 #x0c #x00 #x00 #x00 + #x1e #x00 #x00 #x00 #x01 #x00 #x00 #x00 #x48 #x00 #x05 #x00 + #x16 #x00 #x00 #x00 #x00 #x00 #x00 #x00 #x0b #x00 #x00 #x00 + #x00 #x00 #x00 #x00 #x48 #x00 #x05 #x00 #x16 #x00 #x00 #x00 + #x01 #x00 #x00 #x00 #x0b #x00 #x00 #x00 #x01 #x00 #x00 #x00 + #x48 #x00 #x05 #x00 #x16 #x00 #x00 #x00 #x02 #x00 #x00 #x00 + #x0b #x00 #x00 #x00 #x03 #x00 #x00 #x00 #x48 #x00 #x05 #x00 + #x16 #x00 #x00 #x00 #x03 #x00 #x00 #x00 #x0b #x00 #x00 #x00 + #x04 #x00 #x00 #x00 #x47 #x00 #x03 #x00 #x16 #x00 #x00 #x00 + #x02 #x00 #x00 #x00 #x48 #x00 #x04 #x00 #x1c #x00 #x00 #x00 + #x00 #x00 #x00 #x00 #x05 #x00 #x00 #x00 #x48 #x00 #x05 #x00 + #x1c #x00 #x00 #x00 #x00 #x00 #x00 #x00 #x23 #x00 #x00 #x00 + #x00 #x00 #x00 #x00 #x48 #x00 #x05 #x00 #x1c #x00 #x00 #x00 + #x00 #x00 #x00 #x00 #x07 #x00 #x00 #x00 #x10 #x00 #x00 #x00 + #x47 #x00 #x03 #x00 #x1c #x00 #x00 #x00 #x02 #x00 #x00 #x00 + #x47 #x00 #x04 #x00 #x1e #x00 #x00 #x00 #x22 #x00 #x00 #x00 + #x01 #x00 #x00 #x00 #x47 #x00 #x04 #x00 #x1e #x00 #x00 #x00 + #x21 #x00 #x00 #x00 #x00 #x00 #x00 #x00 #x47 #x00 #x04 #x00 + #x22 #x00 #x00 #x00 #x1e #x00 #x00 #x00 #x00 #x00 #x00 #x00 + #x13 #x00 #x02 #x00 #x02 #x00 #x00 #x00 #x21 #x00 #x03 #x00 + #x03 #x00 #x00 #x00 #x02 #x00 #x00 #x00 #x16 #x00 #x03 #x00 + #x06 #x00 #x00 #x00 #x20 #x00 #x00 #x00 #x17 #x00 #x04 #x00 + #x07 #x00 #x00 #x00 #x06 #x00 #x00 #x00 #x04 #x00 #x00 #x00 + #x20 #x00 #x04 #x00 #x08 #x00 #x00 #x00 #x03 #x00 #x00 #x00 + #x07 #x00 #x00 #x00 #x3b #x00 #x04 #x00 #x08 #x00 #x00 #x00 + #x09 #x00 #x00 #x00 #x03 #x00 #x00 #x00 #x17 #x00 #x04 #x00 + #x0a #x00 #x00 #x00 #x06 #x00 #x00 #x00 #x03 #x00 #x00 #x00 + #x20 #x00 #x04 #x00 #x0b #x00 #x00 #x00 #x01 #x00 #x00 #x00 + #x0a #x00 #x00 #x00 #x3b #x00 #x04 #x00 #x0b #x00 #x00 #x00 + #x0c #x00 #x00 #x00 #x01 #x00 #x00 #x00 #x2b #x00 #x04 #x00 + #x06 #x00 #x00 #x00 #x0e #x00 #x00 #x00 #x00 #x00 #x80 #x3f + #x15 #x00 #x04 #x00 #x13 #x00 #x00 #x00 #x20 #x00 #x00 #x00 + #x00 #x00 #x00 #x00 #x2b #x00 #x04 #x00 #x13 #x00 #x00 #x00 + #x14 #x00 #x00 #x00 #x01 #x00 #x00 #x00 #x1c #x00 #x04 #x00 + #x15 #x00 #x00 #x00 #x06 #x00 #x00 #x00 #x14 #x00 #x00 #x00 + #x1e #x00 #x06 #x00 #x16 #x00 #x00 #x00 #x07 #x00 #x00 #x00 + #x06 #x00 #x00 #x00 #x15 #x00 #x00 #x00 #x15 #x00 #x00 #x00 + #x20 #x00 #x04 #x00 #x17 #x00 #x00 #x00 #x03 #x00 #x00 #x00 + #x16 #x00 #x00 #x00 #x3b #x00 #x04 #x00 #x17 #x00 #x00 #x00 + #x18 #x00 #x00 #x00 #x03 #x00 #x00 #x00 #x15 #x00 #x04 #x00 + #x19 #x00 #x00 #x00 #x20 #x00 #x00 #x00 #x01 #x00 #x00 #x00 + #x2b #x00 #x04 #x00 #x19 #x00 #x00 #x00 #x1a #x00 #x00 #x00 + #x00 #x00 #x00 #x00 #x18 #x00 #x04 #x00 #x1b #x00 #x00 #x00 + #x07 #x00 #x00 #x00 #x04 #x00 #x00 #x00 #x1e #x00 #x03 #x00 + #x1c #x00 #x00 #x00 #x1b #x00 #x00 #x00 #x20 #x00 #x04 #x00 + #x1d #x00 #x00 #x00 #x02 #x00 #x00 #x00 #x1c #x00 #x00 #x00 + #x3b #x00 #x04 #x00 #x1d #x00 #x00 #x00 #x1e #x00 #x00 #x00 + #x02 #x00 #x00 #x00 #x20 #x00 #x04 #x00 #x1f #x00 #x00 #x00 + #x02 #x00 #x00 #x00 #x1b #x00 #x00 #x00 #x3b #x00 #x04 #x00 + #x0b #x00 #x00 #x00 #x22 #x00 #x00 #x00 #x01 #x00 #x00 #x00 + #x36 #x00 #x05 #x00 #x02 #x00 #x00 #x00 #x04 #x00 #x00 #x00 + #x00 #x00 #x00 #x00 #x03 #x00 #x00 #x00 #xf8 #x00 #x02 #x00 + #x05 #x00 #x00 #x00 #x3d #x00 #x04 #x00 #x0a #x00 #x00 #x00 + #x0d #x00 #x00 #x00 #x0c #x00 #x00 #x00 #x51 #x00 #x05 #x00 + #x06 #x00 #x00 #x00 #x0f #x00 #x00 #x00 #x0d #x00 #x00 #x00 + #x00 #x00 #x00 #x00 #x51 #x00 #x05 #x00 #x06 #x00 #x00 #x00 + #x10 #x00 #x00 #x00 #x0d #x00 #x00 #x00 #x01 #x00 #x00 #x00 + #x51 #x00 #x05 #x00 #x06 #x00 #x00 #x00 #x11 #x00 #x00 #x00 + #x0d #x00 #x00 #x00 #x02 #x00 #x00 #x00 #x50 #x00 #x07 #x00 + #x07 #x00 #x00 #x00 #x12 #x00 #x00 #x00 #x0f #x00 #x00 #x00 + #x10 #x00 #x00 #x00 #x11 #x00 #x00 #x00 #x0e #x00 #x00 #x00 + #x3e #x00 #x03 #x00 #x09 #x00 #x00 #x00 #x12 #x00 #x00 #x00 + #x41 #x00 #x05 #x00 #x1f #x00 #x00 #x00 #x20 #x00 #x00 #x00 + #x1e #x00 #x00 #x00 #x1a #x00 #x00 #x00 #x3d #x00 #x04 #x00 + #x1b #x00 #x00 #x00 #x21 #x00 #x00 #x00 #x20 #x00 #x00 #x00 + #x3d #x00 #x04 #x00 #x0a #x00 #x00 #x00 #x23 #x00 #x00 #x00 + #x22 #x00 #x00 #x00 #x51 #x00 #x05 #x00 #x06 #x00 #x00 #x00 + #x24 #x00 #x00 #x00 #x23 #x00 #x00 #x00 #x00 #x00 #x00 #x00 + #x51 #x00 #x05 #x00 #x06 #x00 #x00 #x00 #x25 #x00 #x00 #x00 + #x23 #x00 #x00 #x00 #x01 #x00 #x00 #x00 #x51 #x00 #x05 #x00 + #x06 #x00 #x00 #x00 #x26 #x00 #x00 #x00 #x23 #x00 #x00 #x00 + #x02 #x00 #x00 #x00 #x50 #x00 #x07 #x00 #x07 #x00 #x00 #x00 + #x27 #x00 #x00 #x00 #x24 #x00 #x00 #x00 #x25 #x00 #x00 #x00 + #x26 #x00 #x00 #x00 #x0e #x00 #x00 #x00 #x91 #x00 #x05 #x00 + #x07 #x00 #x00 #x00 #x28 #x00 #x00 #x00 #x21 #x00 #x00 #x00 + #x27 #x00 #x00 #x00 #x41 #x00 #x05 #x00 #x08 #x00 #x00 #x00 + #x29 #x00 #x00 #x00 #x18 #x00 #x00 #x00 #x1a #x00 #x00 #x00 + #x3e #x00 #x03 #x00 #x29 #x00 #x00 #x00 #x28 #x00 #x00 #x00 + #xfd #x00 #x01 #x00 #x38 #x00 #x01 #x00)) +(define frag-spirv + #vu8( #x03 #x02 #x23 #x07 #x00 #x00 #x01 #x00 #x0b #x00 #x08 #x00 + #x0d #x00 #x00 #x00 #x00 #x00 #x00 #x00 #x11 #x00 #x02 #x00 + #x01 #x00 #x00 #x00 #x0b #x00 #x06 #x00 #x01 #x00 #x00 #x00 + #x47 #x4c #x53 #x4c #x2e #x73 #x74 #x64 #x2e #x34 #x35 #x30 + #x00 #x00 #x00 #x00 #x0e #x00 #x03 #x00 #x00 #x00 #x00 #x00 + #x01 #x00 #x00 #x00 #x0f #x00 #x07 #x00 #x04 #x00 #x00 #x00 + #x04 #x00 #x00 #x00 #x6d #x61 #x69 #x6e #x00 #x00 #x00 #x00 + #x09 #x00 #x00 #x00 #x0b #x00 #x00 #x00 #x10 #x00 #x03 #x00 + #x04 #x00 #x00 #x00 #x07 #x00 #x00 #x00 #x03 #x00 #x03 #x00 + #x02 #x00 #x00 #x00 #xc2 #x01 #x00 #x00 #x05 #x00 #x04 #x00 + #x04 #x00 #x00 #x00 #x6d #x61 #x69 #x6e #x00 #x00 #x00 #x00 + #x05 #x00 #x05 #x00 #x09 #x00 #x00 #x00 #x6f #x75 #x74 #x5f + #x63 #x6f #x6c #x6f #x72 #x00 #x00 #x00 #x05 #x00 #x05 #x00 + #x0b #x00 #x00 #x00 #x69 #x6e #x5f #x63 #x6f #x6c #x6f #x72 + #x00 #x00 #x00 #x00 #x47 #x00 #x04 #x00 #x09 #x00 #x00 #x00 + #x1e #x00 #x00 #x00 #x00 #x00 #x00 #x00 #x47 #x00 #x04 #x00 + #x0b #x00 #x00 #x00 #x1e #x00 #x00 #x00 #x00 #x00 #x00 #x00 + #x13 #x00 #x02 #x00 #x02 #x00 #x00 #x00 #x21 #x00 #x03 #x00 + #x03 #x00 #x00 #x00 #x02 #x00 #x00 #x00 #x16 #x00 #x03 #x00 + #x06 #x00 #x00 #x00 #x20 #x00 #x00 #x00 #x17 #x00 #x04 #x00 + #x07 #x00 #x00 #x00 #x06 #x00 #x00 #x00 #x04 #x00 #x00 #x00 + #x20 #x00 #x04 #x00 #x08 #x00 #x00 #x00 #x03 #x00 #x00 #x00 + #x07 #x00 #x00 #x00 #x3b #x00 #x04 #x00 #x08 #x00 #x00 #x00 + #x09 #x00 #x00 #x00 #x03 #x00 #x00 #x00 #x20 #x00 #x04 #x00 + #x0a #x00 #x00 #x00 #x01 #x00 #x00 #x00 #x07 #x00 #x00 #x00 + #x3b #x00 #x04 #x00 #x0a #x00 #x00 #x00 #x0b #x00 #x00 #x00 + #x01 #x00 #x00 #x00 #x36 #x00 #x05 #x00 #x02 #x00 #x00 #x00 + #x04 #x00 #x00 #x00 #x00 #x00 #x00 #x00 #x03 #x00 #x00 #x00 + #xf8 #x00 #x02 #x00 #x05 #x00 #x00 #x00 #x3d #x00 #x04 #x00 + #x07 #x00 #x00 #x00 #x0c #x00 #x00 #x00 #x0b #x00 #x00 #x00 + #x3e #x00 #x03 #x00 #x09 #x00 #x00 #x00 #x0c #x00 #x00 #x00 + #xfd #x00 #x01 #x00 #x38 #x00 #x01 #x00)) + +(define data-vert + #f32( + ;; Front face. + ;; Bottom left + -0.5 0.5 -0.5 1.0 0.0 0.0 ; red + 0.5 -0.5 -0.5 0.0 0.0 1.0 ; blue + -0.5 -0.5 -0.5 0.0 1.0 0.0 ; green + ;; Top right + -0.5 0.5 -0.5 1.0 0.0 0.0 ; red + 0.5 0.5 -0.5 1.0 1.0 0.0 ; yellow + 0.5 -0.5 -0.5 0.0 0.0 1.0 ; blue + ;; Left face + ;; Bottom left + -0.5 0.5 0.5 1.0 1.0 1.0 ; white + -0.5 -0.5 -0.5 0.0 1.0 0.0 ; green + -0.5 -0.5 0.5 0.0 1.0 1.0 ; cyan + ;; Top right + -0.5 0.5 0.5 1.0 1.0 1.0 ; white + -0.5 0.5 -0.5 1.0 0.0 0.0 ; red + -0.5 -0.5 -0.5 0.0 1.0 0.0 ; green + ;; Top face + ;; Bottom left + -0.5 0.5 0.5 1.0 1.0 1.0 ; white + 0.5 0.5 -0.5 1.0 1.0 0.0 ; yellow + -0.5 0.5 -0.5 1.0 0.0 0.0 ; red + ;; Top right + -0.5 0.5 0.5 1.0 1.0 1.0 ; white + 0.5 0.5 0.5 0.0 0.0 0.0 ; black + 0.5 0.5 -0.5 1.0 1.0 0.0 ; yellow + ;; Right face + ;; Bottom left + 0.5 0.5 -0.5 1.0 1.0 0.0 ; yellow + 0.5 -0.5 0.5 1.0 0.0 1.0 ; magenta + 0.5 -0.5 -0.5 0.0 0.0 1.0 ; blue + ;; Top right + 0.5 0.5 -0.5 1.0 1.0 0.0 ; yellow + 0.5 0.5 0.5 0.0 0.0 0.0 ; black + 0.5 -0.5 0.5 1.0 0.0 1.0 ; magenta + ;; Back face + ;; Bottom left + 0.5 0.5 0.5 0.0 0.0 0.0 ; black + -0.5 -0.5 0.5 0.0 1.0 1.0 ; cyan + 0.5 -0.5 0.5 1.0 0.0 1.0 ; magenta + ;; Top right + 0.5 0.5 0.5 0.0 0.0 0.0 ; black + -0.5 0.5 0.5 1.0 1.0 1.0 ; white + -0.5 -0.5 0.5 0.0 1.0 1.0 ; cyan + ;; Bottom face + ;; Bottom left + -0.5 -0.5 -0.5 0.0 1.0 0.0 ; green + 0.5 -0.5 0.5 1.0 0.0 1.0 ; magenta + -0.5 -0.5 0.5 0.0 1.0 1.0 ; cyan + ;; Top right + -0.5 -0.5 -0.5 0.0 1.0 0.0 ; green + 0.5 -0.5 -0.5 0.0 0.0 1.0 ; blue + 0.5 -0.5 0.5 1.0 0.0 1.0 ; magenta + )) + +;; Initialize SDL. All we need is the video subsystem. +(sdl-init '(video)) + +;; Open window. +(define window (make-window "SDL3 GPU" 800 600)) + +;; Create GPU device. +(define device (make-gpu-device '(spirv))) +(claim-window-for-gpu-device! device window) + +;; Create shaders. +(define shader-vert (make-gpu-shader device 'vertex 'spirv vert-spirv + #:uniform-buffers 1)) +(define shader-frag (make-gpu-shader device 'fragment 'spirv frag-spirv)) + +;; Create empty vertex buffer +(define nbytes-vert (bytevector-length data-vert)) +(define buffer-vert (make-gpu-buffer device nbytes-vert '(vertex))) +(set-gpu-buffer-name! device buffer-vert "vertex buffer") + +;; Create transfer buffer and copy vertex data into it. +(define buffer-transfer (make-gpu-transfer-buffer device nbytes-vert 'upload)) +(define mapped (map-gpu-transfer-buffer! device buffer-transfer nbytes-vert)) +(bytevector-copy! data-vert 0 mapped 0 nbytes-vert) +(unmap-gpu-transfer-buffer! device buffer-transfer) + +;; Upload vertex data to vertex buffer. +(define cmd (acquire-gpu-command-buffer device)) +(define copy-pass (begin-gpu-copy-pass cmd)) +(upload-to-gpu-buffer copy-pass buffer-transfer 0 buffer-vert 0 nbytes-vert) +(end-gpu-copy-pass copy-pass) +(submit-gpu-command-buffer! cmd) +(release-gpu-transfer-buffer! device buffer-transfer) + +;; Figure out our sample rate. +(define swapchain-texture-format (gpu-swapchain-texture-format device window)) +(define sample-count + (if (gpu-texture-supports-sample-count? device swapchain-texture-format 4) + 4 1)) + +;; Setup graphics pipeline. +(define color-target-desc + (make-gpu-color-target-description + #:format swapchain-texture-format)) +(define target-info + (make-gpu-graphics-pipeline-target-info + #:color-targets (vector color-target-desc) + #:depth-stencil-format 'd16-unorm)) +(define depth-stencil-state + (make-gpu-depth-stencil-state + #:compare-op 'less-or-equal)) +(define multisample-state + (make-gpu-multisample-state + #:sample-count sample-count)) +(define vertex-buffer-desc + (make-gpu-vertex-buffer-description + #:slot 0 + #:pitch (* 4 6))) +(define vertex-attrib-position + (make-gpu-vertex-attribute + #:buffer-slot 0 + #:format 'float3 + #:location 0)) +(define vertex-attrib-color + (make-gpu-vertex-attribute + #:buffer-slot 0 + #:format 'float3 + #:location 1 + #:offset (* 4 3))) +(define vertex-input-state + (make-gpu-vertex-input-state + #:vertex-buffer-descriptions (vector vertex-buffer-desc) + #:vertex-attributes (vector vertex-attrib-position + vertex-attrib-color))) +(define pipeline + (make-gpu-graphics-pipeline device + #:vertex-shader shader-vert + #:fragment-shader shader-frag + #:vertex-input-state vertex-input-state + #:multisample-state multisample-state + #:depth-stencil-state depth-stencil-state + #:target-info target-info)) + +;; Shaders can be released once the pipeline has been built. +(release-gpu-shader! device shader-vert) +(release-gpu-shader! device shader-frag) + +;; Create textures. +(define-values (width height) (window-size-in-pixels window)) +(define tex-depth + (make-gpu-texture device + #:format 'd16-unorm + #:width width + #:height height + #:sample-count sample-count + #:usage '(depth-stencil-target))) +(define tex-msaa + (make-gpu-texture device + #:format swapchain-texture-format + #:width width + #:height height + #:sample-count sample-count)) +(define tex-resolve + (make-gpu-texture device + #:format swapchain-texture-format + #:width width + #:height height + #:usage '(color-target sampler))) + +;; Transformation matrices. +(define pi 3.1415926535897932) +(define tau (* 2.0 pi)) +(define-bstruct (array 16 float)) +(define (make-mat4) (bstruct-alloc )) +(define (make-identity-mat4) + (bstruct-alloc + + (0 1.0) (1 0.0) (2 0.0) (3 0.0) + (4 0.0) (5 1.0) (6 0.0) (7 0.0) + (8 0.0) (9 0.0) (10 1.0) (11 0.0) + (12 0.0) (13 0.0) (14 0.0) (15 1.0))) +(define (mat4-identity! m) + (bstruct-set! + m + (0 1.0) (1 0.0) (2 0.0) (3 0.0) + (4 0.0) (5 1.0) (6 0.0) (7 0.0) + (8 0.0) (9 0.0) (10 1.0) (11 0.0) + (12 0.0) (13 0.0) (14 0.0) (15 1.0))) +(define (mat4-perspective! m fovy aspect znear zfar) + (let ((f (/ 1.0 (tan (* fovy 0.5))))) + (bstruct-set! + m + (0 (/ f aspect)) (1 0.0) (2 0.0) (3 0.0) + (4 0.0) (5 f) (6 0.0) (7 0.0) + (8 0.0) (9 0.0) (10 (/ (+ znear zfar) (- znear zfar))) (11 -1.0) + (12 0.0) (13 0.0) (14 (/ (* 2.0 znear zfar) (- znear zfar))) (15 0.0)))) +(define (mat4-rotate! m angle x y z) + (let* ((c (cos angle)) + (s (sin angle)) + (xx (* x x)) + (yy (* y y)) + (zz (* z z)) + (xy (* x y)) + (xz (* x z)) + (yz (* y z))) + (bstruct-set! + m + (0 (+ xx (* c (- 1.0 xx)))) + (1 (+ (- xy (* c xy)) (* s z))) + (2 (- xz (* c xz) (* s y))) + (3 0.0) + (4 (- xy (* c xy) (* s z))) + (5 (+ yy (* c (- 1.0 yy)))) + (6 (+ (- yz (* c yz)) (* s x))) + (7 0.0) + (8 (+ (- xz (* c xz)) (* s y))) + (9 (- yz (* c yz) (* s x))) + (10 (+ zz (* c (- 1.0 zz)))) + (11 0.0) + (12 0.0) + (13 0.0) + (14 0.0) + (15 1.0)))) +(define (mat4-mult! a b c) + (let ((a0 (bstruct-ref a 0)) + (a1 (bstruct-ref a 1)) + (a2 (bstruct-ref a 2)) + (a3 (bstruct-ref a 3)) + (a4 (bstruct-ref a 4)) + (a5 (bstruct-ref a 5)) + (a6 (bstruct-ref a 6)) + (a7 (bstruct-ref a 7)) + (a8 (bstruct-ref a 8)) + (a9 (bstruct-ref a 9)) + (a10 (bstruct-ref a 10)) + (a11 (bstruct-ref a 11)) + (a12 (bstruct-ref a 12)) + (a13 (bstruct-ref a 13)) + (a14 (bstruct-ref a 14)) + (a15 (bstruct-ref a 15)) + (b0 (bstruct-ref b 0)) + (b1 (bstruct-ref b 1)) + (b2 (bstruct-ref b 2)) + (b3 (bstruct-ref b 3)) + (b4 (bstruct-ref b 4)) + (b5 (bstruct-ref b 5)) + (b6 (bstruct-ref b 6)) + (b7 (bstruct-ref b 7)) + (b8 (bstruct-ref b 8)) + (b9 (bstruct-ref b 9)) + (b10 (bstruct-ref b 10)) + (b11 (bstruct-ref b 11)) + (b12 (bstruct-ref b 12)) + (b13 (bstruct-ref b 13)) + (b14 (bstruct-ref b 14)) + (b15 (bstruct-ref b 15))) + (bstruct-set! + c + (0 (+ (* a0 b0) (* a1 b4) (* a2 b8) (* a3 b12))) + (1 (+ (* a0 b1) (* a1 b5) (* a2 b9) (* a3 b13))) + (2 (+ (* a0 b2) (* a1 b6) (* a2 b10) (* a3 b14))) + (3 (+ (* a0 b3) (* a1 b7) (* a2 b11) (* a3 b15))) + (4 (+ (* a4 b0) (* a5 b4) (* a6 b8) (* a7 b12))) + (5 (+ (* a4 b1) (* a5 b5) (* a6 b9) (* a7 b13))) + (6 (+ (* a4 b2) (* a5 b6) (* a6 b10) (* a7 b14))) + (7 (+ (* a4 b3) (* a5 b7) (* a6 b11) (* a7 b15))) + (8 (+ (* a8 b0) (* a9 b4) (* a10 b8) (* a11 b12))) + (9 (+ (* a8 b1) (* a9 b5) (* a10 b9) (* a11 b13))) + (10 (+ (* a8 b2) (* a9 b6) (* a10 b10) (* a11 b14))) + (11 (+ (* a8 b3) (* a9 b7) (* a10 b11) (* a11 b15))) + (12 (+ (* a12 b0) (* a13 b4) (* a14 b8) (* a15 b12))) + (13 (+ (* a12 b1) (* a13 b5) (* a14 b9) (* a15 b13))) + (14 (+ (* a12 b2) (* a13 b6) (* a14 b10) (* a15 b14))) + (15 (+ (* a12 b3) (* a13 b7) (* a14 b11) (* a15 b15)))))) +(define perspective (make-mat4)) +(define modelview (make-mat4)) +(define rotation (make-mat4)) +(define mvp (make-mat4)) +(define angle-x 0.0) +(define angle-y 0.0) +(define angle-z 0.0) +(define aspect-ratio (exact->inexact (/ width height))) + +;; Setup various command buffer state. +(define vertex-bindings + (vector (make-gpu-buffer-binding buffer-vert))) +(define main-color-target + (if (= sample-count 1) + (make-gpu-color-target #f #:load-op 'clear) + (make-gpu-color-target tex-msaa + #:load-op 'clear + #:store-op 'resolve + #:resolve-texture tex-resolve + #:cycle? #t + #:cycle-resolve-texture? #t))) +(define blit-info + (and (> sample-count 1) + (make-gpu-blit-info + #:source-texture tex-resolve + #:source-width width + #:source-height height + #:destination-texture tex-resolve + #:destination-width width + #:destination-height height))) +(define color-targets (vector main-color-target)) +(define depth-target + (make-gpu-depth-stencil-target tex-depth + #:load-op 'clear + #:clear-depth 1.0 + #:cycle? #t)) + +(define (render) + (define cmd (acquire-gpu-command-buffer device)) + ;; TODO: This could fail. Catch exception and try again next frame + ;; in that case. + (define-values (tex-swapchain width height) + (acquire-gpu-swapchain-texture cmd window)) + + ;; Setup transformation matrix. + (mat4-rotate! modelview angle-x 1.0 0.0 0.0) + (mat4-rotate! rotation angle-y 0.0 1.0 0.0) + (mat4-mult! modelview rotation modelview) + (mat4-rotate! rotation angle-z 0.0 1.0 0.0) + (mat4-mult! modelview rotation modelview) + (let ((z (bstruct-ref modelview 14))) + (bstruct-set! modelview (14 (- z 2.5)))) + (mat4-perspective! perspective 45.0 aspect-ratio 0.01 100.0) + (mat4-mult! modelview perspective mvp) + + ;; Setup matrix uniform buffer. + (call-with-values (lambda () (bstruct-unwrap mvp)) + (lambda (bv offset n) + (push-gpu-vertex-uniform-data cmd 0 bv (bstruct-sizeof ) offset))) + + ;; Step rotation. + (set! angle-x (+ angle-x 0.03)) + (set! angle-y (+ angle-y 0.02)) + (set! angle-z (+ angle-z 0.01)) + (when (>= angle-x tau) (set! angle-x (- angle-x tau))) + (when (>= angle-y tau) (set! angle-y (- angle-y tau))) + (when (>= angle-z tau) (set! angle-z (- angle-z tau))) + + ;; Write directly to swapchain texture when not multisampling. + (when (= sample-count 1) + (set-gpu-color-target-texture! main-color-target tex-swapchain)) + + ;; Draw the cube! + (define pass (begin-gpu-render-pass cmd color-targets depth-target)) + (bind-gpu-graphics-pipeline pass pipeline) + (bind-gpu-vertex-buffers pass 0 vertex-bindings) + (draw-gpu-primitives pass 36 1) + (end-gpu-render-pass pass) + + ;; Blit to swapchain texture when multisampling. + (when (> sample-count 1) + (set-gpu-blit-info-destination-texture! blit-info tex-swapchain) + (blit-gpu-texture cmd blit-info)) + + ;; Submit commands! + (submit-gpu-command-buffer! cmd)) + +(define (handle-events) + (match (poll-event) + (#f #t) + (event + (match (event-type event) + ((or 'quit 'key-down) #f) + (_ (handle-events)))))) + +(let lp () + (when (handle-events) + (render) + (lp))) + +(release-gpu-texture! device tex-depth) +(release-gpu-texture! device tex-msaa) +(release-gpu-texture! device tex-resolve) +(release-gpu-graphics-pipeline! device pipeline) +(release-gpu-buffer! device buffer-vert) +(release-window-from-gpu-device! device window) +(destroy-gpu-device! device) +(destroy-window! window) diff --git a/examples/window.scm b/examples/window.scm new file mode 100644 index 0000000..0a4d3f0 --- /dev/null +++ b/examples/window.scm @@ -0,0 +1,7 @@ +(use-modules (sdl3) + (sdl3 video)) + +(sdl-init) +(define window (make-window "Hello" 640 480)) +(sleep 3) +(destroy-window! window) -- cgit v1.2.3