From 9b1d91b4c68477145434021ea7392c16d849ebaa Mon Sep 17 00:00:00 2001
From: David Thompson <dthompson2@worcester.edu>
Date: Wed, 2 Oct 2024 21:22:19 -0400
Subject: First commit!

---
 examples/cube.scm | 557 ++++++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 557 insertions(+)
 create mode 100644 examples/cube.scm

(limited to 'examples/cube.scm')

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)
-- 
cgit v1.2.3