diff options
Diffstat (limited to 'sdl2')
| -rw-r--r-- | sdl2/bindings.scm | 194 | ||||
| -rw-r--r-- | sdl2/config.scm.in | 5 | ||||
| -rw-r--r-- | sdl2/video.scm | 256 |
3 files changed, 455 insertions, 0 deletions
diff --git a/sdl2/bindings.scm b/sdl2/bindings.scm new file mode 100644 index 0000000..138d4fc --- /dev/null +++ b/sdl2/bindings.scm @@ -0,0 +1,194 @@ +;;; guile-sdl2 --- FFI bindings for SDL2 +;;; Copyright © 2015 David Thompson <davet@gnu.org> +;;; +;;; This file is part of guile-sdl2. +;;; +;;; Guile-sdl2 is free software; you can redistribute it and/or modify +;;; it under the terms of the GNU Lesser General Public License as +;;; published by the Free Software Foundation; either version 3 of the +;;; License, or (at your option) any later version. +;;; +;;; Guile-sdl2 is distributed in the hope that it will be useful, but +;;; WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;;; General Public License for more details. +;;; +;;; You should have received a copy of the GNU Lesser General Public +;;; License along with guile-sdl2. If not, see +;;; <http://www.gnu.org/licenses/>. + +;;; Commentary: +;; +;; Low-level FFI bindings. +;; +;;; Code: + +(define-module (sdl2 bindings) + #:use-module (system foreign) + #:use-module (sdl2 config) + #:export (boolean->sdl-bool + + SDL_INIT_TIMER + SDL_INIT_AUDIO + SDL_INIT_VIDEO + SDL_INIT_HAPTIC + SDL_INIT_GAMECONTROLLER + SDL_INIT_EVENTS + SDL_INIT_NOPARACHUTE + + SDL_WINDOW_FULLSCREEN + SDL_WINDOW_OPENGL + SDL_WINDOW_SHOWN + SDL_WINDOW_HIDDEN + SDL_WINDOW_BORDERLESS + SDL_WINDOW_RESIZABLE + SDL_WINDOW_MINIMIZED + SDL_WINDOW_MAXIMIZED + SDL_WINDOW_INPUT_GRABBED + SDL_WINDOW_INPUT_FOCUS + SDL_WINDOW_MOUSE_FOCUS + SDL_WINDOW_FULLSCREEN_DESKTOP + SDL_WINDOW_FOREIGN + SDL_WINDOW_ALLOW_HIGHDPI + SDL_WINDOW_MOUSE_CAPTURE)) + +(define sdl-func + (let ((lib (dynamic-link %libsdl2))) + (lambda (return-type function-name arg-types) + "Return a procedure for the foreign function FUNCTION-NAME in +the SDL2 shared library. That function must return a value of +RETURN-TYPE and accept arguments of ARG-TYPES." + (pointer->procedure return-type + (dynamic-func function-name lib) + arg-types)))) + +(define-syntax-rule (define-foreign name return-type func-name arg-types) + (define-public name + (sdl-func return-type func-name arg-types))) + + +;;; +;;; Foreign Types +;;; + +(define sdl-bool int) + +(define (boolean->sdl-bool b) + "Convert the boolean B to an SDL_bool." + (if b 1 0)) + + +;;; +;;; Errors +;;; + +(define-foreign sdl-get-error + '* "SDL_GetError" '()) + + +;;; +;;; Initialization +;;; + +(define SDL_INIT_TIMER #x00000001) +(define SDL_INIT_AUDIO #x00000010) +(define SDL_INIT_VIDEO #x00000020) +(define SDL_INIT_HAPTIC #x00001000) +(define SDL_INIT_GAMECONTROLLER #x00002000) +(define SDL_INIT_EVENTS #x00004000) + +(define-foreign sdl-init + int "SDL_Init" (list uint32)) + +(define-foreign sdl-quit + void "SDL_Quit" '()) + + +;;; +;;; Version +;;; + +(define-foreign sdl-get-version + void "SDL_GetVersion" '(*)) + + +;;; +;;; Video +;;; + +(define SDL_WINDOW_FULLSCREEN #x00000001) +(define SDL_WINDOW_OPENGL #x00000002) +(define SDL_WINDOW_SHOWN #x00000004) +(define SDL_WINDOW_HIDDEN #x00000008) +(define SDL_WINDOW_BORDERLESS #x00000010) +(define SDL_WINDOW_RESIZABLE #x00000020) +(define SDL_WINDOW_MINIMIZED #x00000040) +(define SDL_WINDOW_MAXIMIZED #x00000080) +(define SDL_WINDOW_INPUT_GRABBED #x00000100) +(define SDL_WINDOW_INPUT_FOCUS #x00000200) +(define SDL_WINDOW_MOUSE_FOCUS #x00000400) +(define SDL_WINDOW_FULLSCREEN_DESKTOP (logior SDL_WINDOW_FULLSCREEN + #x00001000)) +(define SDL_WINDOW_FOREIGN #x00000800) +(define SDL_WINDOW_ALLOW_HIGHDPI #x00002000) +(define SDL_WINDOW_MOUSE_CAPTURE #x00004000) + +(define-foreign sdl-create-window + '* "SDL_CreateWindow" (list '* int int int int uint32)) + +(define-foreign sdl-destroy-window + void "SDL_DestroyWindow" '(*)) + +(define-foreign sdl-get-window-title + '* "SDL_GetWindowTitle" '(*)) + +(define-foreign sdl-get-window-size + void "SDL_GetWindowSize" '(* * *)) + +(define-foreign sdl-get-window-position + void "SDL_GetWindowPosition" '(* * *)) + +(define-foreign sdl-get-window-id + uint32 "SDL_GetWindowID" '(*)) + +(define-foreign sdl-get-window-from-id + '* "SDL_GetWindowFromID" (list uint32)) + +(define-foreign sdl-hide-window + void "SDL_HideWindow" '(*)) + +(define-foreign sdl-show-window + void "SDL_ShowWindow" '(*)) + +(define-foreign sdl-maximize-window + void "SDL_MaximizeWindow" '(*)) + +(define-foreign sdl-minimize-window + void "SDL_MinimizeWindow" '(*)) + +(define-foreign sdl-raise-window + void "SDL_RaiseWindow" '(*)) + +(define-foreign sdl-restore-window + void "SDL_RestoreWindow" '(*)) + +(define-foreign sdl-set-window-bordered + void "SDL_SetWindowBordered" (list '* sdl-bool)) + +(define-foreign sdl-set-window-title + void "SDL_SetWindowTitle" '(* *)) + +(define-foreign sdl-set-window-position + void "SDL_SetWindowPosition" (list '* int int)) + +(define-foreign sdl-set-window-size + void "SDL_SetWindowSize" (list '* int int)) + +(define-foreign sdl-gl-create-context + '* "SDL_GL_CreateContext" '(*)) + +(define-foreign sdl-gl-delete-context + void "SDL_GL_DeleteContext" '(*)) + +(define-foreign sdl-gl-swap-window + void "SDL_GL_SwapWindow" '(*)) diff --git a/sdl2/config.scm.in b/sdl2/config.scm.in new file mode 100644 index 0000000..4ab9a06 --- /dev/null +++ b/sdl2/config.scm.in @@ -0,0 +1,5 @@ +(define-module (sdl2 config) + #:export (%libsdl2)) + +(define %libsdl2 + "@LIBSDL2@") diff --git a/sdl2/video.scm b/sdl2/video.scm new file mode 100644 index 0000000..f7697fc --- /dev/null +++ b/sdl2/video.scm @@ -0,0 +1,256 @@ +;;; guile-sdl2 --- FFI bindings for SDL2 +;;; Copyright © 2015 David Thompson <davet@gnu.org> +;;; +;;; This file is part of guile-sdl2. +;;; +;;; Guile-sdl2 is free software; you can redistribute it and/or modify +;;; it under the terms of the GNU Lesser General Public License as +;;; published by the Free Software Foundation; either version 3 of the +;;; License, or (at your option) any later version. +;;; +;;; Guile-sdl2 is distributed in the hope that it will be useful, but +;;; WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;;; General Public License for more details. +;;; +;;; You should have received a copy of the GNU Lesser General Public +;;; License along with guile-sdl2. If not, see +;;; <http://www.gnu.org/licenses/>. + +;;; Commentary: +;; +;; SDL display and window management functions. +;; +;;; Code: + +(define-module (sdl2 video) + #:use-module (ice-9 format) + #:use-module (ice-9 match) + #:use-module (rnrs bytevectors) + #:use-module (srfi srfi-4) + #:use-module (system foreign) + #:use-module ((sdl2 bindings) #:prefix ffi:) + #:use-module (sdl2) + #:export (sdl-window? + make-sdl-window + close-sdl-window! + call-with-sdl-window + sdl-window-title + sdl-window-size + sdl-window-position + sdl-window-id + id->sdl-window + hide-sdl-window! + show-sdl-window! + maximize-sdl-window! + minimize-sdl-window! + raise-sdl-window! + restore-sdl-window! + set-sdl-window-border! + set-sdl-window-title! + set-sdl-window-position! + set-sdl-window-size! + + make-gl-context + gl-context? + delete-gl-context! + call-with-gl-context + swap-gl-sdl-window)) + + +;;; +;;; Windows +;;; + +(define-wrapped-pointer-type <sdl-window> + sdl-window? + wrap-sdl-window unwrap-sdl-window + (lambda (window port) + (format port "#<sdl-window id: ~s title: ~s size: ~s position: ~s>" + (sdl-window-id window) + (sdl-window-title window) + (sdl-window-size window) + (sdl-window-position window)))) + +(define* (make-sdl-window #:key (title "Guile SDL2 Window") + (position '(0 0)) (size '(640 480)) + (maximize? #f) (minimize? #f) + (show? #t) (resizable? #f) + (opengl? #f) (border? #t) + (fullscreen? #f) (fullscreen-desktop? #f) + (grab-input? #f) (high-dpi? #f)) + "Create a new window named TITLE with dimensions SIZE located at +POSITION on the display. POSITION and SIZE are two-element lists in +the form '(x y)', where each coordinate is measured in pixels." + (define x (match-lambda ((x _) x))) + (define y (match-lambda ((_ y) y))) + + (let* ((flags (logior (if fullscreen? + ffi:SDL_WINDOW_FULLSCREEN + 0) + (if fullscreen-desktop? + ffi:SDL_WINDOW_FULLSCREEN_DESKTOP + 0) + (if opengl? + ffi:SDL_WINDOW_OPENGL + 0) + (if show? + 0 + ffi:SDL_WINDOW_HIDDEN) + (if border? + 0 + ffi:SDL_WINDOW_BORDERLESS) + (if resizable? + ffi:SDL_WINDOW_RESIZABLE + 0) + (if minimize? + ffi:SDL_WINDOW_MINIMIZED + 0) + (if maximize? + ffi:SDL_WINDOW_MAXIMIZED + 0) + (if grab-input? + ffi:SDL_WINDOW_INPUT_GRABBED + 0) + (if high-dpi? + ffi:SDL_WINDOW_ALLOW_HIGHDPI + 0))) + (ptr (ffi:sdl-create-window (string->pointer title) + (x position) (y position) + (x size) (y size) + flags))) + (if (null-pointer? ptr) + (sdl-error "make-sdl-window" "failed to create window") + (wrap-sdl-window ptr)))) + +(define (close-sdl-window! window) + "Close WINDOW." + (ffi:sdl-destroy-window (unwrap-sdl-window window))) + +(define (call-with-sdl-window args proc) + "Call PROC with a new window defined by ARGS, a list of keyword +arguments accepted by 'make-sdl-window', and close it when PROC +returns or otherwise exits." + (let ((window (apply make-sdl-window args))) + (dynamic-wind + (const #t) + (lambda () (proc window)) + (lambda () + (close-sdl-window! window))))) + +(define (sdl-window-title window) + "Return the title for WINDOW." + (pointer->string (ffi:sdl-get-window-title (unwrap-sdl-window window)))) + +(define (%get-coords window proc) + (let ((bv (make-bytevector (* 2 (sizeof int)) 0))) + (proc (unwrap-sdl-window window) + (bytevector->pointer bv) + (bytevector->pointer bv (sizeof int))) + (bytevector->sint-list bv (native-endianness) (sizeof int)))) + +(define (sdl-window-size window) + "Return the dimensions of WINDOW." + (%get-coords window ffi:sdl-get-window-size)) + +(define (sdl-window-position window) + "Return the position of WINDOW on the display." + (%get-coords window ffi:sdl-get-window-position)) + +(define (sdl-window-id window) + "Return the numeric ID of WINDOW." + (ffi:sdl-get-window-id (unwrap-sdl-window window))) + +(define (id->sdl-window id) + "Return the window corresponding to ID, a positive integer, or #f if +there is no such window." + (let ((ptr (ffi:sdl-get-window-from-id id))) + (if (null-pointer? ptr) + #f + (wrap-sdl-window ptr)))) + +(define (hide-sdl-window! window) + "Hide WINDOW." + (ffi:sdl-hide-window (unwrap-sdl-window window))) + +(define (show-sdl-window! window) + "Show WINDOW and focus on it." + (ffi:sdl-show-window (unwrap-sdl-window window))) + +(define (maximize-sdl-window! window) + "Make WINDOW as large as possible." + (ffi:sdl-maximize-window (unwrap-sdl-window window))) + +(define (minimize-sdl-window! window) + "Shrink WINDOW to an iconic representation." + (ffi:sdl-minimize-window (unwrap-sdl-window window))) + +(define (raise-sdl-window! window) + "Raise WINDOW above all other windows and set input focus." + (ffi:sdl-raise-window (unwrap-sdl-window window))) + +(define (restore-sdl-window! window) + "Restore the size and position of a minimized or maximized WINDOW." + (ffi:sdl-restore-window (unwrap-sdl-window window))) + +(define (set-sdl-window-border! window border?) + "When BORDER?, draw the usual border around WINDOW, otherwise remove +the border." + (ffi:sdl-set-window-bordered (unwrap-sdl-window window) + (ffi:boolean->sdl-bool border?))) + +(define (set-sdl-window-title! window title) + "Set the title of WINDOW to the string TITLE." + (ffi:sdl-set-window-title (unwrap-sdl-window window) + (string->pointer title))) + +(define (set-sdl-window-position! window position) + "Set the position of WINDOW to POSITION, a two-element list of (x,y) +coordinates measured in pixels." + (match position + ((x y) + (ffi:sdl-set-window-position (unwrap-sdl-window window) x y)))) + +(define (set-sdl-window-size! window size) + "Set the dimensions of WINDOW to SIZE, a two-element list +of (width,height) coordinates measured in pixels." + (match size + ((width height) + (ffi:sdl-set-window-size (unwrap-sdl-window window) width height)))) + + +;;; +;;; OpenGL +;;; + +(define-wrapped-pointer-type <gl-context> + gl-context? + wrap-gl-context unwrap-gl-context + (lambda (context port) + (format port "#<gl-context ~x>" + (pointer-address (unwrap-gl-context context))))) + +(define (make-gl-context window) + "Create an OpenGL context for WINDOW." + (let ((ptr (ffi:sdl-gl-create-context (unwrap-sdl-window window)))) + (if (null-pointer? ptr) + (sdl-error "make-gl-context" "failed to create OpenGL context") + (wrap-gl-context ptr)))) + +(define (delete-gl-context! context) + "Delete CONTEXT, an OpenGL context object." + (ffi:sdl-gl-delete-context (unwrap-gl-context context))) + +(define (call-with-gl-context window proc) + "Call PROC with a new OpenGL context created for WINDOW, and close +the context when PROC returns or otherwise exits.." + (let ((context (make-gl-context window))) + (dynamic-wind + (const #t) + (lambda () (proc context)) + (lambda () + (delete-gl-context! context))))) + +(define (swap-gl-sdl-window window) + "Update WINDOW with OpenGL rendering." + (ffi:sdl-gl-swap-window (unwrap-sdl-window window))) |