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/gpu.scm | 63 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 63 insertions(+) create mode 100644 sdl3/gpu.scm (limited to 'sdl3/gpu.scm') 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)))) -- cgit v1.2.3