First commit!main

1 files changed, 85 insertions, 0 deletions

diff --git a/sdl3/video.scm b/sdl3/video.scm
new file mode 100644
index 0000000..35a37c8
--- /dev/null
+++ b/sdl3/video.scm
@@ -0,0 +1,85 @@
+;;; 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 (rnrs bytevectors)
+  #:use-module (sdl3 bindings video)
+  #:use-module (sdl3 errors)
+  #:use-module (system foreign)
+  #:export (make-window
+            destroy-window!
+            window-size-in-pixels)
+  #: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)))
+
+(define (window-size-in-pixels window)
+  (let* ((size (sizeof int))
+         (bv (make-bytevector (* size 2))))
+    (sdl-assert
+     'window-size-in-pixels
+     (SDL_GetWindowSizeInPixels (unwrap-window window)
+                                (bytevector->pointer bv)
+                                (bytevector->pointer bv size)))
+    (values (bytevector-sint-ref bv 0 (native-endianness) size)
+            (bytevector-sint-ref bv size (native-endianness) size))))