453 lines
15 KiB
Scheme
453 lines
15 KiB
Scheme
(import (scheme)
|
|
(chicken base)
|
|
(chicken foreign))
|
|
(import-syntax (sdl3 internal utilities))
|
|
|
|
(foreign-declare "#include <SDL3/SDL_video.h>")
|
|
|
|
;;; Types
|
|
|
|
(define-foreign-type SDL_DisplayID unsigned-int32)
|
|
(define-foreign-type SDL_WindowID unsigned-int32)
|
|
(define-foreign-type SDL_EGLAttrib size_t)
|
|
(define-foreign-type SDL_EGLAttribArrayCallback
|
|
(function SDL_EGLAttrib () "SDLCALL"))
|
|
(define-foreign-type SDL_EGLDisplay c-pointer)
|
|
(define-foreign-type SDL_GLContext (c-pointer (struct "SDL_GLContextState")))
|
|
(define-foreign-type SDL_HitTest
|
|
(function SDL_HitTestResult ((c-pointer SDL_Window) (c-pointer SDL_Point) c-pointer)))
|
|
(define-foreign-type SDL_Window (struct "SDL_Window"))
|
|
(define-foreign-type SDL_DisplayMode (struct "SDL_DisplayMode"))
|
|
|
|
;;; Constants
|
|
|
|
(define-foreign-type SDL_DisplayOrientation (enum "SDL_DisplayOrientation"))
|
|
(define-sdl-const-values
|
|
orientation SDL_DisplayOrientation
|
|
unknown landscape landscape-flipped portrait portrait-flipped)
|
|
|
|
(define-foreign-type SDL_FlashOperation (enum "SDL_FlashOperation"))
|
|
(define-sdl-const-values
|
|
flash SDL_FlashOperation
|
|
cancel briefly until-focused)
|
|
|
|
(define-foreign-type SDL_GLattr (enum "SDL_GLattr"))
|
|
(define-sdl-const-values
|
|
gl SDL_GLattr
|
|
red-size green-size blue-size alpha-size buffer-size doublebuffer depth-size
|
|
stencil-size accum-red-size accum-green-size accum-blue-size accum-alpha-size
|
|
stereo multisamplebuffers multisamplesamples accelerated-visual retained-backing
|
|
context-major-version context-minor-version context-flags context-profile-mask
|
|
share-with-current-context framebuffer-srgb-capable context-release-behavior
|
|
context-reset-notification context-no-error floatbuffers egl-platform)
|
|
|
|
(define-foreign-type SDL_GLcontextFlag (enum "SDL_GLcontextFlag"))
|
|
(define-sdl-const-values
|
|
gl-context SDL_GLcontextFlag
|
|
debug-flag forward-compatible-flag robust-access-flag reset-isolation-flag)
|
|
|
|
(define-foreign-type SDL_GLcontextReleaseFlag (enum "SDL_GLcontextReleaseFlag"))
|
|
(define-sdl-const-values
|
|
gl-context-release-behavior SDL_GLcontextReleaseFlag
|
|
none flush)
|
|
|
|
(define-foreign-type SDL_GLContextResetNotification (enum "SDL_GLContextResetNotification"))
|
|
(define-sdl-const-values
|
|
gl-context-reset SDL_GLContextResetNotification
|
|
no-notification lose-context)
|
|
|
|
(define-foreign-type SDL_GLprofile (enum "SDL_GLprofile"))
|
|
(define-sdl-const-values
|
|
gl-context-profile SDL_GLprofile
|
|
core compatibility es)
|
|
|
|
(define-foreign-type SDL_HitTestResult (enum "SDL_HitTestResult"))
|
|
(define-sdl-const-values
|
|
hittest SDL_HitTestResult
|
|
normal draggable resize-topleft resize-top resize-topright resize-right
|
|
resize-bottomright resize-bottom resize-bottomleft resize-left)
|
|
|
|
(define-foreign-type SDL_SystemTheme (enum "SDL_SystemTheme"))
|
|
(define-sdl-const-values
|
|
system-theme SDL_SystemTheme
|
|
unknown light dark)
|
|
|
|
(define-foreign-type SDL_WindowFlags unsigned-integer64)
|
|
(define-sdl-const-values
|
|
window SDL_WindowFlags
|
|
fullscreen opengl occluded hidden borderless resizable minimized maximized
|
|
mouse-grabbed input-focus mouse-focus external modal high-pixel-density
|
|
mouse-capture mouse-relative-mode always-on-top utility tooltip popup-menu
|
|
keyboard-grabbed vulkan metal transparent not-focusable)
|
|
|
|
;; These are weird string properties for CreateWindowWithProperties
|
|
(define-sdl-const-values
|
|
prop-window-create c-string
|
|
always-on-top-boolean borderless-boolean external-graphics-context-boolean
|
|
focusable-boolean fullscreen-boolean height-number hidden-boolean
|
|
high-pixel-density-boolean maximized-boolean menu-boolean
|
|
metal-boolean minimized-boolean modal-boolean
|
|
mouse-grabbed-boolean opengl-boolean parent-pointer
|
|
resizable-boolean title-string transparent-boolean tooltip-boolean
|
|
utility-boolean vulkan-boolean width-number x-number y-number
|
|
cocoa-window-pointer cocoa-view-pointer
|
|
wayland-surface-role-custom-boolean
|
|
wayland-create-egl-window-boolean wayland-wl-surface-pointer
|
|
win32-hwnd-pointer win32-pixel-format-hwnd-pointer
|
|
x11-window-number)
|
|
|
|
;;; Procedures
|
|
|
|
(define (create-popup-window parent offset-x offset-y w h #!rest flags)
|
|
((foreign-lambda (c-pointer SDL_Window) "SDL_CreatePopupWindow"
|
|
(c-pointer SDL_Window) integer integer integer integer unsigned-integer64)
|
|
parent offset-x offset-y w h (foldl-uint-flags flags)))
|
|
|
|
(define (create-window title w h #!rest flags)
|
|
((foreign-lambda (c-pointer SDL_Window) "SDL_CreateWindow"
|
|
c-string int int unsigned-int32)
|
|
title w h (foldl-uint-flags flags)))
|
|
|
|
;; TODO: SDL_CreateWindowWithProperties
|
|
|
|
(define destroy-window
|
|
(foreign-lambda void "SDL_DestroyWindow" (c-pointer SDL_Window)))
|
|
|
|
(define destroy-window-surface
|
|
(foreign-lambda bool "SDL_DestroyWindowSurface" (c-pointer SDL_Window)))
|
|
|
|
(define disable-screen-saver
|
|
(foreign-lambda bool "SDL_DisableScreenSaver"))
|
|
|
|
(define egl-get-current-config
|
|
(foreign-lambda c-pointer "SDL_EGL_GetCurrentConfig"))
|
|
|
|
(define egl-get-current-display
|
|
(foreign-lambda c-pointer "SDL_EGL_GetCurrentDisplay"))
|
|
|
|
(define egl-get-proc-address
|
|
(foreign-lambda c-pointer "SDL_EGL_GetProcAddress" c-string))
|
|
|
|
(define egl-get-window-surface
|
|
(foreign-lambda c-pointer "SDL_EGL_GetWindowSurface" (c-pointer SDL_Window)))
|
|
|
|
;; TODO: SDL_EGL_SetAttributeCallbacks
|
|
|
|
(define enable-screen-saver
|
|
(foreign-lambda bool "SDL_EnableScreenSaver"))
|
|
|
|
(define flash-window
|
|
(foreign-lambda bool "SDL_FlashWindow" (c-pointer SDL_Window) SDL_FlashOperation))
|
|
|
|
(define get-closest-fullscreen-display-mode
|
|
(foreign-lambda bool "SDL_GetClosestFullscreenDisplayMode"
|
|
SDL_DisplayID int int float bool (c-pointer SDL_DisplayMode)))
|
|
|
|
(define get-current-display-mode
|
|
(foreign-lambda (c-pointer SDL_DisplayMode) "SDL_GetCurrentDisplayMode" SDL_DisplayID))
|
|
|
|
(define get-current-display-orientation
|
|
(foreign-lambda SDL_DisplayOrientation "SDL_GetCurrentDisplayOrientation"
|
|
SDL_DisplayID))
|
|
|
|
(define get-current-video-driver
|
|
(foreign-lambda c-string "SDL_GetCurrentVideoDriver"))
|
|
|
|
(define get-desktop-display-mode
|
|
(foreign-lambda (c-pointer SDL_DisplayMode) "SDL_GetDesktopDisplayMode"
|
|
SDL_DisplayID))
|
|
|
|
(define get-display-bounds
|
|
(foreign-lambda bool "SDL_GetDisplayBounds"
|
|
unsigned-int32 (c-pointer (struct "SDL_Rect"))))
|
|
|
|
(define get-display-content-scale
|
|
(foreign-lambda float "SDL_GetDisplayContentScale" unsigned-int32))
|
|
|
|
(define get-display-for-point
|
|
(foreign-lambda unsigned-int32 "SDL_GetDisplayForPoint"
|
|
(c-pointer (struct "SDL_Point"))))
|
|
|
|
(define get-display-for-rect
|
|
(foreign-lambda unsigned-int32 "SDL_GetDisplayForRect"
|
|
(c-pointer (struct "SDL_Rect"))))
|
|
|
|
(define get-display-for-window
|
|
(foreign-lambda unsigned-int32 "SDL_GetDisplayForWindow"
|
|
(c-pointer (struct "SDL_Window"))))
|
|
|
|
(define get-display-name
|
|
(foreign-lambda c-string "SDL_GetDisplayName" unsigned-int32))
|
|
|
|
(define get-display-properties
|
|
(foreign-lambda unsigned-int32 "SDL_GetDisplayProperties" unsigned-int32))
|
|
|
|
;; TODO: SDL_GetDisplays
|
|
|
|
(define get-display-usable-bounds
|
|
(foreign-lambda bool "SDL_GetDisplayUsableBounds"
|
|
unsigned-int32 (c-pointer (struct "SDL_Rect"))))
|
|
|
|
;; TODO: SDL_GetFullscreenDisplayModes
|
|
|
|
(define get-grabbed-window
|
|
(foreign-lambda (c-pointer (struct "SDL_Window")) "SDL_GetGrabbedWindow"))
|
|
|
|
(define get-natural-display-orientation
|
|
(foreign-lambda (enum "SDL_DisplayOrientation")
|
|
"SDL_GetNaturalDisplayOrientation" unsigned-int32))
|
|
|
|
(define get-num-video-drivers
|
|
(foreign-lambda int "SDL_GetNumVideoDrivers"))
|
|
|
|
(define get-primary-display
|
|
(foreign-lambda unsigned-int32 "SDL_GetPrimaryDisplay"))
|
|
|
|
(define get-system-theme
|
|
(foreign-lambda (enum "SDL_SystemTheme") "SDL_GetSystemTheme"))
|
|
|
|
(define get-video-driver
|
|
(foreign-lambda c-string "SDL_GetVideoDriver" int))
|
|
|
|
;; TODO: SDL_GetWindowAspectRatio
|
|
|
|
;; TODO: SDL_GetWindowBordersSize
|
|
|
|
(define get-window-display-scale
|
|
(foreign-lambda float "SDL_GetWindowDisplayScale" (c-pointer (struct "SDL_Window"))))
|
|
|
|
(define get-window-flags
|
|
(foreign-lambda unsigned-int32 "SDL_GetWindowFlags" (c-pointer (struct "SDL_Window"))))
|
|
|
|
(define get-window-from-id
|
|
(foreign-lambda (c-pointer (struct "SDL_Window")) "SDL_GetWindowFromID" unsigned-int32))
|
|
|
|
(define get-window-fullscreen-mode
|
|
(foreign-lambda (c-pointer (struct "SDL_DisplayMode")) "SDL_GetWindowFullscreenMode"
|
|
(c-pointer (struct "SDL_Window"))))
|
|
|
|
;; TODO: SDL_GetWindowICCProfile
|
|
|
|
(define get-window-id
|
|
(foreign-lambda unsigned-int32 "SDL_GetWindowID" (c-pointer (struct "SDL_Window"))))
|
|
|
|
(define get-window-keyboard-grab
|
|
(foreign-lambda bool "SDL_GetWindowKeyboardGrab" (c-pointer (struct "SDL_Window"))))
|
|
|
|
;; TODO: SDL_GetWindowMaximumSize
|
|
|
|
;; TODO: SDL_GetWindowMinimumSize
|
|
|
|
(define get-window-mouse-grab
|
|
(foreign-lambda bool "SDL_GetWindowMouseGrab" (c-pointer (struct "SDL_Window"))))
|
|
|
|
(define get-window-mouse-rect
|
|
(foreign-lambda (c-pointer (struct "SDL_Rect")) "SDL_GetWindowMouseRect"
|
|
(c-pointer (struct "SDL_Window"))))
|
|
|
|
(define get-window-opacity
|
|
(foreign-lambda float "SDL_GetWindowOpacity" (c-pointer (struct "SDL_Window"))))
|
|
|
|
(define get-window-parent
|
|
(foreign-lambda (c-pointer (struct "SDL_Window")) "SDL_GetWindowParent"
|
|
(c-pointer (struct "SDL_Window"))))
|
|
|
|
(define get-window-pixel-density
|
|
(foreign-lambda float "SDL_GetWindowPixelDensity" (c-pointer (struct "SDL_Window"))))
|
|
|
|
(define get-window-pixel-format
|
|
(foreign-lambda (enum "SDL_PixelFormat") "SDL_GetWindowPixelFormat"
|
|
(c-pointer (struct "SDL_Window"))))
|
|
|
|
;; TODO: SDL_GetWindowPosition
|
|
|
|
(define get-window-properties
|
|
(foreign-lambda unsigned-int32 "SDL_GetWindowProperties"
|
|
(c-pointer (struct "SDL_Window"))))
|
|
|
|
;; TODO: SDL_GetWindows
|
|
|
|
;; TODO: SDL_GetWindowSafeArea
|
|
|
|
;; TODO: SDL_GetWindowSize
|
|
|
|
;; TODO: SDL_GetWindowSizeInPixels
|
|
|
|
(define get-window-surface
|
|
(foreign-lambda (c-pointer (struct "SDL_Surface")) "SDL_GetWindowSurface"
|
|
(c-pointer (struct "SDL_Window"))))
|
|
|
|
;; TODO: SDL_GetWindowSurfaceVSync
|
|
|
|
(define get-window-title
|
|
(foreign-lambda c-string "SDL_GetWindowTitle" (c-pointer (struct "SDL_Window"))))
|
|
|
|
(define gl-create-context
|
|
(foreign-lambda (c-pointer (struct "SDL_GLContextState")) "SDL_GL_CreateContext"
|
|
(c-pointer (struct "SDL_Window"))))
|
|
|
|
(define gl-destroy-context
|
|
(foreign-lambda bool "SDL_GL_DestroyContext" (c-pointer (struct "SDL_GLContextState"))))
|
|
|
|
(define gl-extension-supported
|
|
(foreign-lambda bool "SDL_GL_ExtensionSupported" c-string))
|
|
|
|
;; TODO: SDL_GL_GetAttribute
|
|
|
|
(define gl-get-current-context
|
|
(foreign-lambda (c-pointer (struct "SDL_GLContextState")) "SDL_GL_GetCurrentContext"))
|
|
|
|
(define gl-get-current-window
|
|
(foreign-lambda (c-pointer (struct "SDL_Window")) "SDL_GL_GetCurrentWindow"))
|
|
|
|
(define gl-get-proc-address
|
|
(foreign-lambda c-pointer "SDL_GL_GetProcAddress" c-string))
|
|
|
|
;; TODO: SDL_GL_GetSwapInterval
|
|
|
|
(define gl-load-library
|
|
(foreign-lambda bool "SDL_GL_LoadLibrary" c-string))
|
|
|
|
(define gl-make-current
|
|
(foreign-lambda bool "SDL_GL_MakeCurrent"
|
|
(c-pointer (struct "SDL_Window")) (c-pointer (struct "SDL_GLContextState"))))
|
|
|
|
(define gl-reset-attributes
|
|
(foreign-lambda void "SDL_GL_ResetAttributes"))
|
|
|
|
(define gl-set-attribute
|
|
(foreign-lambda bool "SDL_GL_SetAttribute" (enum "SDL_GLattr") int))
|
|
|
|
(define gl-set-swap-interval
|
|
(foreign-lambda bool "SDL_GL_SetSwapInterval" int))
|
|
|
|
(define gl-swap-window
|
|
(foreign-lambda bool "SDL_GL_SwapWindow" (c-pointer (struct "SDL_Window"))))
|
|
|
|
(define gl-unload-library
|
|
(foreign-lambda void "SDL_GL_UnloadLibrary"))
|
|
|
|
(define hide-window
|
|
(foreign-lambda bool "SDL_HideWindow" (c-pointer (struct "SDL_Window"))))
|
|
|
|
(define maximize-window
|
|
(foreign-lambda bool "SDL_MaximizeWindow" (c-pointer (struct "SDL_Window"))))
|
|
|
|
(define minimize-window
|
|
(foreign-lambda bool "SDL_MinimizeWindow" (c-pointer (struct "SDL_Window"))))
|
|
|
|
(define raise-window
|
|
(foreign-lambda bool "SDL_RaiseWindow" (c-pointer (struct "SDL_Window"))))
|
|
|
|
(define restore-window
|
|
(foreign-lambda bool "SDL_RestoreWindow" (c-pointer (struct "SDL_Window"))))
|
|
|
|
(define screen-saver-enabled
|
|
(foreign-lambda bool "SDL_ScreenSaverEnabled"))
|
|
|
|
(define set-window-always-on-top
|
|
(foreign-lambda bool "SDL_SetWindowAlwaysOnTop" (c-pointer (struct "SDL_Window")) bool))
|
|
|
|
(define set-window-aspect-ratio
|
|
(foreign-lambda bool "SDL_SetWindowAspectRatio"
|
|
(c-pointer (struct "SDL_Window")) float float))
|
|
|
|
(define set-window-bordered
|
|
(foreign-lambda bool "SDL_SetWindowBordered" (c-pointer (struct "SDL_Window")) bool))
|
|
|
|
(define set-window-focusable
|
|
(foreign-lambda bool "SDL_SetWindowFocusable" (c-pointer (struct "SDL_Window")) bool))
|
|
|
|
(define set-window-fullscreen
|
|
(foreign-lambda bool "SDL_SetWindowFullscreen" (c-pointer (struct "SDL_Window")) bool))
|
|
|
|
(define set-window-fullscreen-mode
|
|
(foreign-lambda bool "SDL_SetWindowFullscreenMode"
|
|
(c-pointer (struct "SDL_Window"))
|
|
(c-pointer (struct "SDL_DisplayMode"))))
|
|
|
|
;; TODO: SDL_SetWindowHitTest
|
|
|
|
(define set-window-icon
|
|
(foreign-lambda bool "SDL_SetWindowIcon"
|
|
(c-pointer (struct "SDL_Window"))
|
|
(c-pointer (struct "SDL_Surface"))))
|
|
|
|
(define set-window-keyboard-grab
|
|
(foreign-lambda bool "SDL_SetWindowKeyboardGrab"
|
|
(c-pointer (struct "SDL_Window")) bool))
|
|
|
|
(define set-window-maximum-size
|
|
(foreign-lambda bool "SDL_SetWindowMaximumSize"
|
|
(c-pointer (struct "SDL_Window")) int int))
|
|
|
|
(define set-window-minimum-size
|
|
(foreign-lambda bool "SDL_SetWindowMinimumSize"
|
|
(c-pointer (struct "SDL_Window")) int int))
|
|
|
|
(define set-window-modal
|
|
(foreign-lambda bool "SDL_SetWindowModal" (c-pointer (struct "SDL_Window")) bool))
|
|
|
|
;; (define set-window-modal-for
|
|
;; (foreign-lambda bool "SDL_SetWindowModalFor"
|
|
;; (c-pointer (struct "SDL_Window"))
|
|
;; (c-pointer (struct "SDL_Window"))))
|
|
|
|
(define set-window-mouse-grab
|
|
(foreign-lambda bool "SDL_SetWindowMouseGrab"
|
|
(c-pointer (struct "SDL_Window")) bool))
|
|
|
|
(define set-window-mouse-rect
|
|
(foreign-lambda bool "SDL_SetWindowMouseRect"
|
|
(c-pointer (struct "SDL_Window"))
|
|
(c-pointer (struct "SDL_Rect"))))
|
|
|
|
(define set-window-opacity
|
|
(foreign-lambda bool "SDL_SetWindowOpacity"
|
|
(c-pointer (struct "SDL_Window")) float))
|
|
|
|
(define set-window-parent
|
|
(foreign-lambda bool "SDL_SetWindowParent"
|
|
(c-pointer (struct "SDL_Window"))
|
|
(c-pointer (struct "SDL_Window"))))
|
|
|
|
(define set-window-position
|
|
(foreign-lambda bool "SDL_SetWindowPosition"
|
|
(c-pointer (struct "SDL_Window")) int int))
|
|
|
|
(define set-window-resizable
|
|
(foreign-lambda bool "SDL_SetWindowResizable" (c-pointer (struct "SDL_Window")) bool))
|
|
|
|
(define set-window-shape
|
|
(foreign-lambda bool "SDL_SetWindowShape"
|
|
(c-pointer (struct "SDL_Window"))
|
|
(c-pointer (struct "SDL_Surface"))))
|
|
|
|
(define set-window-size
|
|
(foreign-lambda bool "SDL_SetWindowSize" (c-pointer (struct "SDL_Window")) int int))
|
|
|
|
(define set-window-surface-vsync
|
|
(foreign-lambda bool "SDL_SetWindowSurfaceVSync"
|
|
(c-pointer (struct "SDL_Window")) int))
|
|
|
|
(define set-window-title
|
|
(foreign-lambda bool "SDL_SetWindowTitle"
|
|
(c-pointer (struct "SDL_Window")) c-string))
|
|
|
|
(define show-window
|
|
(foreign-lambda bool "SDL_ShowWindow" (c-pointer (struct "SDL_Window"))))
|
|
|
|
(define show-window-system-menu
|
|
(foreign-lambda bool "SDL_ShowWindowSystemMenu"
|
|
(c-pointer (struct "SDL_Window")) int int))
|
|
|
|
(define sync-window
|
|
(foreign-lambda bool "SDL_SyncWindow" (c-pointer (struct "SDL_Window"))))
|
|
|
|
(define update-window-surface
|
|
(foreign-lambda bool "SDL_UpdateWindowSurface" (c-pointer (struct "SDL_Window"))))
|
|
|
|
;; TODO: SDL_UpdateWindowSurfaceRects
|
|
|
|
(define window-has-surface
|
|
(foreign-lambda bool "SDL_WindowHasSurface" (c-pointer (struct "SDL_Window"))))
|