From 567863b2398b6832f686b258709396572af0e980 Mon Sep 17 00:00:00 2001 From: David Thompson Date: Wed, 2 Oct 2024 21:22:19 -0400 Subject: First commit! --- sdl3/bindings/error.scm | 26 ++++++++++++++ sdl3/bindings/gpu.scm | 62 ++++++++++++++++++++++++++++++++ sdl3/bindings/init.scm | 49 +++++++++++++++++++++++++ sdl3/bindings/utils.scm | 60 +++++++++++++++++++++++++++++++ sdl3/bindings/video.scm | 95 +++++++++++++++++++++++++++++++++++++++++++++++++ sdl3/config.scm.in | 22 ++++++++++++ sdl3/errors.scm | 54 ++++++++++++++++++++++++++++ sdl3/gpu.scm | 63 ++++++++++++++++++++++++++++++++ sdl3/guardian.scm | 30 ++++++++++++++++ sdl3/video.scm | 72 +++++++++++++++++++++++++++++++++++++ 10 files changed, 533 insertions(+) create mode 100644 sdl3/bindings/error.scm create mode 100644 sdl3/bindings/gpu.scm create mode 100644 sdl3/bindings/init.scm create mode 100644 sdl3/bindings/utils.scm create mode 100644 sdl3/bindings/video.scm create mode 100644 sdl3/config.scm.in create mode 100644 sdl3/errors.scm create mode 100644 sdl3/gpu.scm create mode 100644 sdl3/guardian.scm create mode 100644 sdl3/video.scm (limited to 'sdl3') 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 +;;; +;;; 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 +;;; +;;; 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? wrap-gpu-device unwrap-gpu-device + gpu-device-destroyed? set-gpu-device-destroyed! + (lambda (device port) + (display "#" 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 +;;; +;;; 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 +;;; +;;; 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 +;;; +;;; 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? wrap-window unwrap-window + window-destroyed? set-window-destroyed! + (lambda (window port) + (display "#" 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 +;;; +;;; 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 +;;; +;;; 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 +;;; +;;; 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 +;;; +;;; 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 +;;; +;;; 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))) -- cgit v1.2.3