summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--.gitignore11
-rw-r--r--COPYING165
-rw-r--r--Makefile.am52
-rw-r--r--README65
-rwxr-xr-xbootstrap3
-rw-r--r--configure.ac57
-rw-r--r--guix.scm63
-rw-r--r--pre-inst-env.in32
-rw-r--r--sdl2.scm79
-rw-r--r--sdl2/bindings.scm194
-rw-r--r--sdl2/config.scm.in5
-rw-r--r--sdl2/video.scm256
12 files changed, 982 insertions, 0 deletions
diff --git a/.gitignore b/.gitignore
new file mode 100644
index 0000000..bde866b
--- /dev/null
+++ b/.gitignore
@@ -0,0 +1,11 @@
+/Makefile
+/Makefile.in
+/aclocal.m4
+/autom4te.cache
+/build-aux
+/config.log
+/config.status
+/configure
+/pre-inst-env
+*.go
+/sdl2/config.scm
diff --git a/COPYING b/COPYING
new file mode 100644
index 0000000..65c5ca8
--- /dev/null
+++ b/COPYING
@@ -0,0 +1,165 @@
+ GNU LESSER GENERAL PUBLIC LICENSE
+ Version 3, 29 June 2007
+
+ Copyright (C) 2007 Free Software Foundation, Inc. <http://fsf.org/>
+ Everyone is permitted to copy and distribute verbatim copies
+ of this license document, but changing it is not allowed.
+
+
+ This version of the GNU Lesser General Public License incorporates
+the terms and conditions of version 3 of the GNU General Public
+License, supplemented by the additional permissions listed below.
+
+ 0. Additional Definitions.
+
+ As used herein, "this License" refers to version 3 of the GNU Lesser
+General Public License, and the "GNU GPL" refers to version 3 of the GNU
+General Public License.
+
+ "The Library" refers to a covered work governed by this License,
+other than an Application or a Combined Work as defined below.
+
+ An "Application" is any work that makes use of an interface provided
+by the Library, but which is not otherwise based on the Library.
+Defining a subclass of a class defined by the Library is deemed a mode
+of using an interface provided by the Library.
+
+ A "Combined Work" is a work produced by combining or linking an
+Application with the Library. The particular version of the Library
+with which the Combined Work was made is also called the "Linked
+Version".
+
+ The "Minimal Corresponding Source" for a Combined Work means the
+Corresponding Source for the Combined Work, excluding any source code
+for portions of the Combined Work that, considered in isolation, are
+based on the Application, and not on the Linked Version.
+
+ The "Corresponding Application Code" for a Combined Work means the
+object code and/or source code for the Application, including any data
+and utility programs needed for reproducing the Combined Work from the
+Application, but excluding the System Libraries of the Combined Work.
+
+ 1. Exception to Section 3 of the GNU GPL.
+
+ You may convey a covered work under sections 3 and 4 of this License
+without being bound by section 3 of the GNU GPL.
+
+ 2. Conveying Modified Versions.
+
+ If you modify a copy of the Library, and, in your modifications, a
+facility refers to a function or data to be supplied by an Application
+that uses the facility (other than as an argument passed when the
+facility is invoked), then you may convey a copy of the modified
+version:
+
+ a) under this License, provided that you make a good faith effort to
+ ensure that, in the event an Application does not supply the
+ function or data, the facility still operates, and performs
+ whatever part of its purpose remains meaningful, or
+
+ b) under the GNU GPL, with none of the additional permissions of
+ this License applicable to that copy.
+
+ 3. Object Code Incorporating Material from Library Header Files.
+
+ The object code form of an Application may incorporate material from
+a header file that is part of the Library. You may convey such object
+code under terms of your choice, provided that, if the incorporated
+material is not limited to numerical parameters, data structure
+layouts and accessors, or small macros, inline functions and templates
+(ten or fewer lines in length), you do both of the following:
+
+ a) Give prominent notice with each copy of the object code that the
+ Library is used in it and that the Library and its use are
+ covered by this License.
+
+ b) Accompany the object code with a copy of the GNU GPL and this license
+ document.
+
+ 4. Combined Works.
+
+ You may convey a Combined Work under terms of your choice that,
+taken together, effectively do not restrict modification of the
+portions of the Library contained in the Combined Work and reverse
+engineering for debugging such modifications, if you also do each of
+the following:
+
+ a) Give prominent notice with each copy of the Combined Work that
+ the Library is used in it and that the Library and its use are
+ covered by this License.
+
+ b) Accompany the Combined Work with a copy of the GNU GPL and this license
+ document.
+
+ c) For a Combined Work that displays copyright notices during
+ execution, include the copyright notice for the Library among
+ these notices, as well as a reference directing the user to the
+ copies of the GNU GPL and this license document.
+
+ d) Do one of the following:
+
+ 0) Convey the Minimal Corresponding Source under the terms of this
+ License, and the Corresponding Application Code in a form
+ suitable for, and under terms that permit, the user to
+ recombine or relink the Application with a modified version of
+ the Linked Version to produce a modified Combined Work, in the
+ manner specified by section 6 of the GNU GPL for conveying
+ Corresponding Source.
+
+ 1) Use a suitable shared library mechanism for linking with the
+ Library. A suitable mechanism is one that (a) uses at run time
+ a copy of the Library already present on the user's computer
+ system, and (b) will operate properly with a modified version
+ of the Library that is interface-compatible with the Linked
+ Version.
+
+ e) Provide Installation Information, but only if you would otherwise
+ be required to provide such information under section 6 of the
+ GNU GPL, and only to the extent that such information is
+ necessary to install and execute a modified version of the
+ Combined Work produced by recombining or relinking the
+ Application with a modified version of the Linked Version. (If
+ you use option 4d0, the Installation Information must accompany
+ the Minimal Corresponding Source and Corresponding Application
+ Code. If you use option 4d1, you must provide the Installation
+ Information in the manner specified by section 6 of the GNU GPL
+ for conveying Corresponding Source.)
+
+ 5. Combined Libraries.
+
+ You may place library facilities that are a work based on the
+Library side by side in a single library together with other library
+facilities that are not Applications and are not covered by this
+License, and convey such a combined library under terms of your
+choice, if you do both of the following:
+
+ a) Accompany the combined library with a copy of the same work based
+ on the Library, uncombined with any other library facilities,
+ conveyed under the terms of this License.
+
+ b) Give prominent notice with the combined library that part of it
+ is a work based on the Library, and explaining where to find the
+ accompanying uncombined form of the same work.
+
+ 6. Revised Versions of the GNU Lesser General Public License.
+
+ The Free Software Foundation may publish revised and/or new versions
+of the GNU Lesser General Public License from time to time. Such new
+versions will be similar in spirit to the present version, but may
+differ in detail to address new problems or concerns.
+
+ Each version is given a distinguishing version number. If the
+Library as you received it specifies that a certain numbered version
+of the GNU Lesser General Public License "or any later version"
+applies to it, you have the option of following the terms and
+conditions either of that published version or of any later version
+published by the Free Software Foundation. If the Library as you
+received it does not specify a version number of the GNU Lesser
+General Public License, you may choose any version of the GNU Lesser
+General Public License ever published by the Free Software Foundation.
+
+ If the Library as you received it specifies that a proxy can decide
+whether future versions of the GNU Lesser General Public License shall
+apply, that proxy's public statement of acceptance of any version is
+permanent authorization for you to choose that version for the
+Library.
diff --git a/Makefile.am b/Makefile.am
new file mode 100644
index 0000000..93c6e1f
--- /dev/null
+++ b/Makefile.am
@@ -0,0 +1,52 @@
+# 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/>.
+
+GOBJECTS = $(SOURCES:%.scm=%.go)
+
+nobase_mod_DATA = $(SOURCES) $(NOCOMP_SOURCES)
+nobase_go_DATA = $(GOBJECTS)
+
+# Make sure source files are installed first, so that the mtime of
+# installed compiled files is greater than that of installed source
+# files. See
+# <http://lists.gnu.org/archive/html/guile-devel/2010-07/msg00125.html>
+# for details.
+guile_install_go_files = install-nobase_goDATA
+$(guile_install_go_files): install-nobase_modDATA
+
+CLEANFILES = $(GOBJECTS)
+EXTRA_DIST = $(SOURCES) $(NOCOMP_SOURCES)
+GUILE_WARNINGS = -Wunbound-variable -Warity-mismatch -Wformat
+SUFFIXES = .scm .go
+.scm.go:
+ $(AM_V_GEN)$(top_builddir)/pre-inst-env $(GUILE_TOOLS) compile $(GUILE_WARNINGS) -o "$@" "$<"
+
+moddir=$(prefix)/share/guile/site/2.0
+godir=$(libdir)/guile/2.0/ccache
+
+SOURCES = \
+ sdl2.scm \
+ sdl2/config.scm \
+ sdl2/bindings.scm \
+ sdl2/video.scm
+
+EXTRA_DIST += \
+ pre-inst-env.in \
+ README \
+ guix.scm
diff --git a/README b/README
new file mode 100644
index 0000000..ac90aa9
--- /dev/null
+++ b/README
@@ -0,0 +1,65 @@
+-*- mode: org -*-
+
+Guile-sdl2 provides Guile Scheme bindings for the SDL2 C shared
+library. The bindings are written in pure Scheme by using Guile's
+foreign function interface.
+
+* Requirements
+
+ Guile-sdl2 currently depends on the following packages:
+
+ - GNU Guile >= 2.0.9
+ - SDL2 >= 2.0.0
+ - GNU Make
+ - GNU pkg-config
+
+ When building from a Git checkout, the following additional packages
+ are required:
+
+ - GNU Autoconf
+ - GNU Automake
+
+* Installing
+
+ Guile-sdl2 uses the standard GNU build system, so installation
+ requires the usual incantations:
+
+ # ./configure
+ # make
+ # make install
+
+ When building from a Git checkout, the following spell is necessary
+ before running the above commands:
+
+ # ./bootstrap
+
+ GNU Guix users may install the current development snapshot
+ described in =guix.scm= with the following command:
+
+ # guix package -f guix.scm
+
+* Developing
+
+ To build the source code from a Git checkout, run the following:
+
+ # ./bootstrap
+ # ./configure
+ # make
+
+ To start a Guile REPL with a pre-configured load path for using
+ guile-sdl2, use the =pre-inst-env= script:
+
+ # ./pre-inst-env guile
+
+ GNU Guix users may create a development environment with all of the
+ necessary dependencies by running the following command:
+
+ # guix environment -l guix.scm
+
+* Contact
+
+ Bug reports and patches may be sent to <davet@gnu.org>.
+
+ The maintainer of this library hangs out in the #guile channel on
+ irc.freenode.net, so help and general discussion may also be found
+ there.
diff --git a/bootstrap b/bootstrap
new file mode 100755
index 0000000..872167c
--- /dev/null
+++ b/bootstrap
@@ -0,0 +1,3 @@
+#!/bin/sh
+
+autoreconf -vif
diff --git a/configure.ac b/configure.ac
new file mode 100644
index 0000000..5d25c46
--- /dev/null
+++ b/configure.ac
@@ -0,0 +1,57 @@
+# -*- Autoconf -*-
+#
+# 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/>.
+
+AC_INIT(guile-sdl2, 0.1)
+AC_CONFIG_SRCDIR(sdl2)
+AC_CONFIG_AUX_DIR([build-aux])
+AM_INIT_AUTOMAKE([color-tests -Wall -Wno-portability foreign])
+AM_SILENT_RULES([yes])
+
+AC_CONFIG_FILES([Makefile sdl2/config.scm])
+AC_CONFIG_FILES([pre-inst-env], [chmod +x pre-inst-env])
+
+GUILE_PROGS([2.0.9])
+PKG_CHECK_MODULES([SDL2], [sdl2])
+
+LIBSDL2="libSDL2"
+LIBSDL2_LIBDIR="no"
+LIBSDL2_PREFIX="no"
+
+AC_ARG_WITH([libsdl2-prefix],
+ [AS_HELP_STRING([--with-libsdl2-prefix=DIR], [search for SDL2 in DIR])],
+ [case "$withval" in
+ yes|no)
+ ;;
+ *)
+ LIBSDL2="$withval/lib/libSDL2"
+ LIBSDL2_PREFIX="$withval"
+ LIBSDL2_LIBDIR="$withval/lib"
+ ;;
+ esac])
+
+dnl Library name suitable for `dynamic-link'.
+AC_MSG_CHECKING([for libSDL2 shared library name])
+AC_MSG_RESULT([$LIBSDL2])
+AC_SUBST([LIBSDL2])
+AC_SUBST([LIBSDL2_PREFIX])
+AC_SUBST([LIBSDL2_LIBDIR])
+
+AC_OUTPUT
diff --git a/guix.scm b/guix.scm
new file mode 100644
index 0000000..008796b
--- /dev/null
+++ b/guix.scm
@@ -0,0 +1,63 @@
+;;; 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:
+;;
+;; GNU Guix development package. To build and install, run:
+;;
+;; guix package -f guix.scm
+;;
+;; To use as the basis for a development environment, run:
+;;
+;; guix environment -l guix.scm
+;;
+;;; Code:
+
+(use-modules (guix packages)
+ (guix licenses)
+ (guix git-download)
+ (guix build-system gnu)
+ (gnu packages)
+ (gnu packages autotools)
+ (gnu packages guile)
+ (gnu packages pkg-config)
+ (gnu packages sdl))
+
+(package
+ (name "guile-sdl2")
+ (version "0.1")
+ (source #f)
+ (build-system gnu-build-system)
+ (arguments
+ '(#:phases
+ (modify-phases %standard-phases
+ (add-after 'unpack 'bootstrap
+ (lambda _ (zero? (system* "sh" "bootstrap")))))))
+ (native-inputs
+ `(("autoconf" ,autoconf)
+ ("automake" ,automake)
+ ("pkg-config" ,pkg-config)))
+ (inputs
+ `(("guile" ,guile-2.0)
+ ("sdl2" ,sdl2)))
+ (synopsis "Guile bindings for SDL2")
+ (description "Guile-sdl2 provides pure Guile Scheme bindings to the
+SDL2 C shared library via the foreign function interface.")
+ (home-page "https://git.dthompson.us/guile-sdl2.git")
+ (license lgpl3+))
diff --git a/pre-inst-env.in b/pre-inst-env.in
new file mode 100644
index 0000000..f1e1319
--- /dev/null
+++ b/pre-inst-env.in
@@ -0,0 +1,32 @@
+#!/bin/sh
+
+# 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/>.
+
+abs_top_srcdir="`cd "@abs_top_srcdir@" > /dev/null; pwd`"
+abs_top_builddir="`cd "@abs_top_builddir@" > /dev/null; pwd`"
+
+GUILE_LOAD_COMPILED_PATH="$abs_top_builddir${GUILE_LOAD_COMPILED_PATH:+:}$GUILE_LOAD_COMPILED_PATH"
+GUILE_LOAD_PATH="$abs_top_builddir:$abs_top_srcdir${GUILE_LOAD_PATH:+:}:$GUILE_LOAD_PATH"
+export GUILE_LOAD_COMPILED_PATH GUILE_LOAD_PATH
+
+PATH="$abs_top_builddir/scripts:$PATH"
+export PATH
+
+exec "$@"
diff --git a/sdl2.scm b/sdl2.scm
new file mode 100644
index 0000000..afed5c0
--- /dev/null
+++ b/sdl2.scm
@@ -0,0 +1,79 @@
+;;; 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 initialization and error handling.
+;;
+;;; Code:
+
+(define-module (sdl2)
+ #:use-module (ice-9 match)
+ #:use-module (srfi srfi-4)
+ #:use-module (system foreign)
+ #:use-module ((sdl2 bindings) #:prefix ffi:)
+ #:export (sdl-error-string
+ sdl-error
+ sdl-version
+ sdl-init
+ sdl-quit))
+
+(define %default-init-flags
+ '(timer audio video haptic game-controller events))
+
+(define (sdl-error-string)
+ "Return the current SDL error string."
+ (pointer->string (ffi:sdl-get-error)))
+
+(define (sdl-error func message . args)
+ (apply throw 'sdl-error func (string-append message ": ~A")
+ (append args (list (sdl-error-string)))))
+
+(define (sdl-version)
+ "Return a three element list containing the major, minor, and patch
+version of the linked SDL library."
+ (let ((bv (make-u8vector 3)))
+ (ffi:sdl-get-version (bytevector->pointer bv))
+ (u8vector->list bv)))
+
+(define* (sdl-init #:optional (subsystems %default-init-flags))
+ "Initialize the SDL library. This must be called before using any
+other SDL procedure.
+
+SUBSYSTEMS is an optional list of symbols that specifies the
+subsystems to initialize. All subsystems are initialized by default.
+The possible flags are 'timer', 'audio', 'video', 'haptic',
+'game-controller', and 'events'."
+ (let ((flags (apply logior
+ (map (match-lambda
+ ('timer ffi:SDL_INIT_TIMER)
+ ('audio ffi:SDL_INIT_AUDIO)
+ ('video ffi:SDL_INIT_VIDEO)
+ ('haptic ffi:SDL_INIT_HAPTIC)
+ ('game-controller ffi:SDL_INIT_GAMECONTROLLER)
+ ('events ffi:SDL_INIT_EVENTS))
+ subsystems))))
+ (unless (zero? (ffi:sdl-init flags))
+ (sdl-error "sdl-init" "failed to initialize subsystems ~S"
+ subsystems))))
+
+(define (sdl-quit)
+ "Quit all activated SDL subsystems. This procedure should be called
+upon all exit conditions."
+ (ffi:sdl-quit))
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)))