First commit!main

10 files changed, 533 insertions, 0 deletions

diff --git a/sdl3/bindings/error.scm b/sdl3/bindings/error.scm
new file mode 100644
index 0000000..71e5885
--- /dev/null
+++ b/sdl3/bindings/error.scm
@@ -0,0 +1,26 @@
+;;; 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:
+;;
+;; Low-level bindings for SDL_error.h.
+;;
+;;; Code:
+
+(define-module (sdl3 bindings error)
+  #:use-module (sdl3 bindings utils)
+  #:export (SDL_GetError))
+
+(define-sdl SDL_GetError -> '*)
diff --git a/sdl3/bindings/gpu.scm b/sdl3/bindings/gpu.scm
new file mode 100644
index 0000000..6de7ef4
--- /dev/null
+++ b/sdl3/bindings/gpu.scm
@@ -0,0 +1,62 @@
+;;; 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:
+;;
+;; Low-level bindings for SDL_gpu.h.
+;;
+;;; Code:
+
+(define-module (sdl3 bindings gpu)
+  #:use-module (sdl3 bindings utils)
+  #:use-module (system foreign)
+  #:export (;; SDL_gpu.h
+            SDL_GPUShaderFormat
+            SDL_GPU_SHADERFORMAT_INVALID
+            SDL_GPU_SHADERFORMAT_PRIVATE
+            SDL_GPU_SHADERFORMAT_SPIRV
+            SDL_GPU_SHADERFORMAT_DXBC
+            SDL_GPU_SHADERFORMAT_DXIL
+            SDL_GPU_SHADERFORMAT_MSL
+            SDL_GPU_SHADERFORMAT_METALLIB
+
+            gpu-device?
+            wrap-gpu-device
+            unwrap-gpu-device
+            gpu-device-destroyed?
+            set-gpu-device-destroyed!
+
+            SDL_CreateGPUDevice
+            SDL_DestroyGPUDevice
+            SDL_ClaimWindowForGPUDevice))
+
+(define SDL_GPUShaderFormat uint32)
+(define SDL_GPU_SHADERFORMAT_INVALID  0)
+(define SDL_GPU_SHADERFORMAT_PRIVATE  1)
+(define SDL_GPU_SHADERFORMAT_SPIRV    2)
+(define SDL_GPU_SHADERFORMAT_DXBC     4)
+(define SDL_GPU_SHADERFORMAT_DXIL     8)
+(define SDL_GPU_SHADERFORMAT_MSL      16)
+(define SDL_GPU_SHADERFORMAT_METALLIB 32)
+
+(define-sdl-pointer-type <gpu-device>
+  gpu-device? wrap-gpu-device unwrap-gpu-device
+  gpu-device-destroyed? set-gpu-device-destroyed!
+  (lambda (device port)
+    (display "#<gpu-device>" port)))
+
+(define-sdl SDL_CreateGPUDevice SDL_GPUShaderFormat bool '* -> '*)
+(define-sdl SDL_DestroyGPUDevice '*)
+(define-sdl SDL_ClaimWindowForGPUDevice '* '* -> bool)
diff --git a/sdl3/bindings/init.scm b/sdl3/bindings/init.scm
new file mode 100644
index 0000000..ac92829
--- /dev/null
+++ b/sdl3/bindings/init.scm
@@ -0,0 +1,49 @@
+;;; 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:
+;;
+;; Low-level bindings for SDL_init.h.
+;;
+;;; Code:
+
+(define-module (sdl3 bindings init)
+  #:use-module (sdl3 bindings utils)
+  #:use-module (system foreign)
+  #:export (SDL_InitFlags
+            SDL_INIT_AUDIO
+            SDL_INIT_VIDEO
+            SDL_INIT_JOYSTICK
+            SDL_INIT_HAPTIC
+            SDL_INIT_GAMEPAD
+            SDL_INIT_EVENTS
+            SDL_INIT_SENSOR
+            SDL_INIT_CAMERA
+
+            SDL_Init
+            SDL_Quit))
+
+(define SDL_InitFlags uint32)
+(define SDL_INIT_AUDIO    #x00000010)
+(define SDL_INIT_VIDEO    #x00000020)
+(define SDL_INIT_JOYSTICK #x00000200)
+(define SDL_INIT_HAPTIC   #x00001000)
+(define SDL_INIT_GAMEPAD  #x00002000)
+(define SDL_INIT_EVENTS   #x00004000)
+(define SDL_INIT_SENSOR   #x00008000)
+(define SDL_INIT_CAMERA   #x00010000)
+
+(define-sdl SDL_Init SDL_InitFlags -> bool)
+(define-sdl SDL_Quit)
diff --git a/sdl3/bindings/utils.scm b/sdl3/bindings/utils.scm
new file mode 100644
index 0000000..738f2bc
--- /dev/null
+++ b/sdl3/bindings/utils.scm
@@ -0,0 +1,60 @@
+;;; 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:
+;;
+;; Low-level FFI binding utilities.
+;;
+;;; Code:
+
+(define-module (sdl3 bindings utils)
+  #:use-module (sdl3 config)
+  #:use-module (sdl3 guardian)
+  #:use-module (srfi srfi-9)
+  #:use-module (srfi srfi-9 gnu)
+  #:use-module (system foreign)
+  #:use-module (system foreign-library)
+  #:export (bool
+            define-sdl
+            define-sdl-pointer-type))
+
+;; Type aliases:
+(define bool uint8)
+
+(define-syntax define-sdl
+  (lambda (stx)
+    (syntax-case stx (->)
+      ((_ name arg-type ... -> return-type)
+       #`(define name
+           (foreign-library-function %libsdl3
+                                     #,(symbol->string (syntax->datum #'name))
+                                     #:arg-types (list arg-type ...)
+                                     #:return-type return-type)))
+      ((_ name arg-type ...)
+       #'(define-sdl name arg-type ... -> void)))))
+
+(define-syntax-rule (define-sdl-pointer-type name
+                      pred wrap unwrap
+                      destroyed-pred set-destroyed
+                      print)
+  (begin
+    (define-record-type name
+      (ctor ptr)
+      pred
+      (ptr unwrap)
+      (destroyed? destroyed-pred set-destroyed))
+    (define (wrap ptr)
+      (sdl-protect (ctor ptr)))
+    (set-record-type-printer! name print)))
diff --git a/sdl3/bindings/video.scm b/sdl3/bindings/video.scm
new file mode 100644
index 0000000..a9c55ac
--- /dev/null
+++ b/sdl3/bindings/video.scm
@@ -0,0 +1,95 @@
+;;; 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:
+;;
+;; Low-level bindings for SDL_video.h.
+;;
+;;; Code:
+
+(define-module (sdl3 bindings video)
+  #:use-module (sdl3 bindings utils)
+  #:use-module (system foreign)
+  #:export (SDL_WindowFlags
+            SDL_WINDOW_FULLSCREEN
+            SDL_WINDOW_OPENGL
+            SDL_WINDOW_OCCLUDED
+            SDL_WINDOW_HIDDEN
+            SDL_WINDOW_BORDERLESS
+            SDL_WINDOW_RESIZABLE
+            SDL_WINDOW_MINIMIZED
+            SDL_WINDOW_MAXIMIZED
+            SDL_WINDOW_MOUSE_GRABBED
+            SDL_WINDOW_INPUT_FOCUS
+            SDL_WINDOW_MOUSE_FOCUS
+            SDL_WINDOW_EXTERNAL
+            SDL_WINDOW_MODAL
+            SDL_WINDOW_HIGH_PIXEL_DENSITY
+            SDL_WINDOW_MOUSE_CAPTURE
+            SDL_WINDOW_MOUSE_RELATIVE_MODE
+            SDL_WINDOW_ALWAYS_ON_TOP
+            SDL_WINDOW_UTILITY
+            SDL_WINDOW_TOOLTIP
+            SDL_WINDOW_POPUP_MENU
+            SDL_WINDOW_KEYBOARD_GRABBED
+            SDL_WINDOW_VULKAN
+            SDL_WINDOW_METAL
+            SDL_WINDOW_TRANSPARENT
+            SDL_WINDOW_NOT_FOCUSABLE
+
+            window?
+            wrap-window
+            unwrap-window
+            window-destroyed?
+            set-window-destroyed!
+
+            SDL_CreateWindow
+            SDL_DestroyWindow))
+
+(define SDL_WindowFlags uint64)
+(define SDL_WINDOW_FULLSCREEN          #x0000000000000001)
+(define SDL_WINDOW_OPENGL              #x0000000000000002)
+(define SDL_WINDOW_OCCLUDED            #x0000000000000004)
+(define SDL_WINDOW_HIDDEN              #x0000000000000008)
+(define SDL_WINDOW_BORDERLESS          #x0000000000000010)
+(define SDL_WINDOW_RESIZABLE           #x0000000000000020)
+(define SDL_WINDOW_MINIMIZED           #x0000000000000040)
+(define SDL_WINDOW_MAXIMIZED           #x0000000000000080)
+(define SDL_WINDOW_MOUSE_GRABBED       #x0000000000000100)
+(define SDL_WINDOW_INPUT_FOCUS         #x0000000000000200)
+(define SDL_WINDOW_MOUSE_FOCUS         #x0000000000000400)
+(define SDL_WINDOW_EXTERNAL            #x0000000000000800)
+(define SDL_WINDOW_MODAL               #x0000000000001000)
+(define SDL_WINDOW_HIGH_PIXEL_DENSITY  #x0000000000002000)
+(define SDL_WINDOW_MOUSE_CAPTURE       #x0000000000004000)
+(define SDL_WINDOW_MOUSE_RELATIVE_MODE #x0000000000008000)
+(define SDL_WINDOW_ALWAYS_ON_TOP       #x0000000000010000)
+(define SDL_WINDOW_UTILITY             #x0000000000020000)
+(define SDL_WINDOW_TOOLTIP             #x0000000000040000)
+(define SDL_WINDOW_POPUP_MENU          #x0000000000080000)
+(define SDL_WINDOW_KEYBOARD_GRABBED    #x0000000000100000)
+(define SDL_WINDOW_VULKAN              #x0000000010000000)
+(define SDL_WINDOW_METAL               #x0000000020000000)
+(define SDL_WINDOW_TRANSPARENT         #x0000000040000000)
+(define SDL_WINDOW_NOT_FOCUSABLE       #x0000000080000000)
+
+(define-sdl-pointer-type <window>
+  window? wrap-window unwrap-window
+  window-destroyed? set-window-destroyed!
+  (lambda (window port)
+    (display "#<window>" port)))
+
+(define-sdl SDL_CreateWindow '* int int SDL_WindowFlags -> '*)
+(define-sdl SDL_DestroyWindow '*)
diff --git a/sdl3/config.scm.in b/sdl3/config.scm.in
new file mode 100644
index 0000000..af6c8e1
--- /dev/null
+++ b/sdl3/config.scm.in
@@ -0,0 +1,22 @@
+;;; 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.
+
+(define-module (sdl3 config)
+  #:export (%libsdl3))
+
+(define %libsdl3
+  "/gnu/store/5z28wrn3f770x3myhcmfki5zdyjbg9r7-sdl3-2.30.1/lib/libSDL3.so.0.1.2"
+  ;; "@SDL3_LIBDIR@/libSDL3"
+  )
diff --git a/sdl3/errors.scm b/sdl3/errors.scm
new file mode 100644
index 0000000..3d48647
--- /dev/null
+++ b/sdl3/errors.scm
@@ -0,0 +1,54 @@
+;;; 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:
+;;
+;; SDL3 errors.
+;;
+;;; Code:
+
+(define-module (sdl3 errors)
+  #:use-module (ice-9 exceptions)
+  #:use-module (sdl3 bindings error)
+  #:use-module (system foreign)
+  #:export (sdl-get-error
+            make-sdl-error
+            sdl-assert
+            sdl-assert-non-null))
+
+(define (sdl-get-error)
+  (pointer->string (SDL_GetError)))
+
+(define-exception-type &sdl-exception &error
+  make-sdl-exception
+  sdl-exception?)
+
+(define* (make-sdl-error origin #:key
+                         (message (sdl-get-error))
+                         (irritants '()))
+  (make-exception
+   (make-sdl-exception)
+   (make-exception-with-message message)
+   (make-exception-with-irritants irritants)
+   (make-exception-with-origin origin)))
+
+(define (sdl-assert origin bool)
+  (unless (eq? bool 1)
+    (raise-exception (make-sdl-error origin))))
+
+(define (sdl-assert-non-null origin pointer)
+  (when (null-pointer? pointer)
+    (raise-exception (make-sdl-error origin)))
+  pointer)
diff --git a/sdl3/gpu.scm b/sdl3/gpu.scm
new file mode 100644
index 0000000..d1129f3
--- /dev/null
+++ b/sdl3/gpu.scm
@@ -0,0 +1,63 @@
+;;; 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:
+;;
+;; SDL3 3D rendering and GPU compute.
+;;
+;;; Code:
+
+(define-module (sdl3 gpu)
+  #:use-module (ice-9 match)
+  #:use-module (sdl3 bindings gpu)
+  #:use-module (sdl3 bindings video)
+  #:use-module (sdl3 errors)
+  #:use-module (srfi srfi-1)
+  #:use-module (system foreign)
+  #:export (make-gpu-device
+            destroy-gpu-device!
+            claim-window-for-gpu-device!)
+  #:re-export (gpu-device?
+               gpu-device-destroyed?))
+
+(define* (make-gpu-device shader-formats #:key debug? driver)
+  (wrap-gpu-device
+   (sdl-assert-non-null
+    'make-gpu-device
+    (SDL_CreateGPUDevice (fold (lambda (format prev)
+                                 (logior (match format
+                                           ('private SDL_GPU_SHADERFORMAT_PRIVATE)
+                                           ('spirv SDL_GPU_SHADERFORMAT_SPIRV)
+                                           ('dxbc SDL_GPU_SHADERFORMAT_DXBC)
+                                           ('dxil SDL_GPU_SHADERFORMAT_DXIL)
+                                           ('msl SDL_GPU_SHADERFORMAT_MSL)
+                                           ('metallib SDL_GPU_SHADERFORMAT_METALLIB))
+                                         prev))
+                               0 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 (claim-window-for-gpu-device! device window)
+  (sdl-assert
+   'claim-window-for-gpu-device!
+   (SDL_ClaimWindowForGPUDevice (unwrap-gpu-device device)
+                                (unwrap-window window))))
diff --git a/sdl3/guardian.scm b/sdl3/guardian.scm
new file mode 100644
index 0000000..d0a812b
--- /dev/null
+++ b/sdl3/guardian.scm
@@ -0,0 +1,30 @@
+;;; 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:
+;;
+;; SDL3 foreign object guardian.
+;;
+;;; Code:
+
+(define-module (sdl3 guardian)
+  #:export (sdl-guardian
+            sdl-protect))
+
+(define sdl-guardian (make-guardian))
+
+(define (sdl-protect obj)
+  (sdl-guardian obj)
+  obj)
diff --git a/sdl3/video.scm b/sdl3/video.scm
new file mode 100644
index 0000000..20cfd2d
--- /dev/null
+++ b/sdl3/video.scm
@@ -0,0 +1,72 @@
+;;; 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:
+;;
+;; SDL3 display and window management.
+;;
+;;; Code:
+
+(define-module (sdl3 video)
+  #:use-module (sdl3 bindings video)
+  #:use-module (sdl3 errors)
+  #:use-module (system foreign)
+  #:export (make-window
+            destroy-window!)
+  #:re-export (window?
+               window-destroyed?))
+
+(define* (make-window title width height #:key
+                      opengl?
+                      vulkan?
+                      metal?
+                      (shown? #t)
+                      fullscreen?
+                      borderless?
+                      transparent?
+                      resizable?
+                      (focusable? #t)
+                      high-pixel-density?
+                      always-on-top?
+                      utility?)
+  "Open a window with the specified @var{title} and dimensions
+@var{width} by @var{height} pixels and return a handle to that window."
+  (wrap-window
+   (sdl-assert-non-null
+    'make-window
+    (SDL_CreateWindow (string->pointer title)
+                      width height
+                      (logior
+                       (if opengl? SDL_WINDOW_OPENGL 0)
+                       (if vulkan? SDL_WINDOW_VULKAN 0)
+                       (if metal? SDL_WINDOW_METAL 0)
+                       (if fullscreen? SDL_WINDOW_FULLSCREEN 0)
+                       (if shown? 0 SDL_WINDOW_HIDDEN)
+                       (if borderless? SDL_WINDOW_BORDERLESS 0)
+                       (if transparent? SDL_WINDOW_TRANSPARENT 0)
+                       (if resizable? SDL_WINDOW_RESIZABLE 0)
+                       (if focusable? 0 SDL_WINDOW_NOT_FOCUSABLE)
+                       (if high-pixel-density? SDL_WINDOW_HIGH_PIXEL_DENSITY 0)
+                       (if always-on-top? SDL_WINDOW_ALWAYS_ON_TOP 0)
+                       (if utility? SDL_WINDOW_UTILITY 0))))))
+
+;; FIXME: SDL_DestroyWindow recursively destroys child windows.  Do we
+;; need to keep track of those in Scheme, then?
+(define (destroy-window! window)
+  "Close @var{window} and make handle unusable for further window
+management calls."
+  (unless (window-destroyed? window)
+    (SDL_DestroyWindow (unwrap-window window))
+    (set-window-destroyed! window #t)))