Initial commit.
authorDavid Thompson <dthompson2@worcester.edu>
Wed, 7 Oct 2015 02:05:20 +0000 (22:05 -0400)
committerDavid Thompson <dthompson2@worcester.edu>
Wed, 7 Oct 2015 02:05:20 +0000 (22:05 -0400)
Let's do this!

12 files changed:
.gitignore [new file with mode: 0644]
COPYING [new file with mode: 0644]
Makefile.am [new file with mode: 0644]
README [new file with mode: 0644]
bootstrap [new file with mode: 0755]
configure.ac [new file with mode: 0644]
guix.scm [new file with mode: 0644]
pre-inst-env.in [new file with mode: 0644]
sdl2.scm [new file with mode: 0644]
sdl2/bindings.scm [new file with mode: 0644]
sdl2/config.scm.in [new file with mode: 0644]
sdl2/video.scm [new file with mode: 0644]

diff --git a/.gitignore b/.gitignore
new file mode 100644 (file)
index 0000000..bde866b
--- /dev/null
@@ -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 (file)
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 (file)
index 0000000..93c6e1f
--- /dev/null
@@ -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 (file)
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 (executable)
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 (file)
index 0000000..5d25c46
--- /dev/null
@@ -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 (file)
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 (file)
index 0000000..f1e1319
--- /dev/null
@@ -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 (file)
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 (file)
index 0000000..138d4fc
--- /dev/null
@@ -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)))
+
+\f
+;;;
+;;; Foreign Types
+;;;
+
+(define sdl-bool int)
+
+(define (boolean->sdl-bool b)
+  "Convert the boolean B to an SDL_bool."
+  (if b 1 0))
+
+\f
+;;;
+;;; Errors
+;;;
+
+(define-foreign sdl-get-error
+  '* "SDL_GetError" '())
+
+\f
+;;;
+;;; 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" '())
+
+\f
+;;;
+;;; Version
+;;;
+
+(define-foreign sdl-get-version
+  void "SDL_GetVersion" '(*))
+
+\f
+;;;
+;;; 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 (file)
index 0000000..4ab9a06
--- /dev/null
@@ -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 (file)
index 0000000..f7697fc
--- /dev/null
@@ -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))
+
+\f
+;;;
+;;; 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))))
+
+\f
+;;;
+;;; 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)))