summaryrefslogtreecommitdiff
path: root/examples/cube.scm
diff options
context:
space:
mode:
Diffstat (limited to 'examples/cube.scm')
-rw-r--r--examples/cube.scm557
1 files changed, 557 insertions, 0 deletions
diff --git a/examples/cube.scm b/examples/cube.scm
new file mode 100644
index 0000000..74e131c
--- /dev/null
+++ b/examples/cube.scm
@@ -0,0 +1,557 @@
+;;; 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:
+;;
+;; 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 <mat4> (array 16 f32))
+(define (make-mat4) (bstruct-alloc <mat4>))
+(define (make-identity-mat4)
+ (bstruct-alloc
+ <mat4>
+ (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!
+ <mat4> 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!
+ <mat4> 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!
+ <mat4> 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 <mat4> a 0))
+ (a1 (bstruct-ref <mat4> a 1))
+ (a2 (bstruct-ref <mat4> a 2))
+ (a3 (bstruct-ref <mat4> a 3))
+ (a4 (bstruct-ref <mat4> a 4))
+ (a5 (bstruct-ref <mat4> a 5))
+ (a6 (bstruct-ref <mat4> a 6))
+ (a7 (bstruct-ref <mat4> a 7))
+ (a8 (bstruct-ref <mat4> a 8))
+ (a9 (bstruct-ref <mat4> a 9))
+ (a10 (bstruct-ref <mat4> a 10))
+ (a11 (bstruct-ref <mat4> a 11))
+ (a12 (bstruct-ref <mat4> a 12))
+ (a13 (bstruct-ref <mat4> a 13))
+ (a14 (bstruct-ref <mat4> a 14))
+ (a15 (bstruct-ref <mat4> a 15))
+ (b0 (bstruct-ref <mat4> b 0))
+ (b1 (bstruct-ref <mat4> b 1))
+ (b2 (bstruct-ref <mat4> b 2))
+ (b3 (bstruct-ref <mat4> b 3))
+ (b4 (bstruct-ref <mat4> b 4))
+ (b5 (bstruct-ref <mat4> b 5))
+ (b6 (bstruct-ref <mat4> b 6))
+ (b7 (bstruct-ref <mat4> b 7))
+ (b8 (bstruct-ref <mat4> b 8))
+ (b9 (bstruct-ref <mat4> b 9))
+ (b10 (bstruct-ref <mat4> b 10))
+ (b11 (bstruct-ref <mat4> b 11))
+ (b12 (bstruct-ref <mat4> b 12))
+ (b13 (bstruct-ref <mat4> b 13))
+ (b14 (bstruct-ref <mat4> b 14))
+ (b15 (bstruct-ref <mat4> b 15)))
+ (bstruct-set!
+ <mat4> 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 <mat4> modelview 14)))
+ (bstruct-set! <mat4> 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 <mat4> mvp))
+ (lambda (bv offset)
+ (push-gpu-vertex-uniform-data cmd 0 bv (bstruct-sizeof <mat4>) 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)
generated by cgit v1.2.3 (git 2.25.4) at 2024-11-23 08:04:14 +0000