First commit!
authorDavid Thompson <dthompson2@worcester.edu>
Thu, 5 Jan 2017 03:16:26 +0000 (22:16 -0500)
committerDavid Thompson <dthompson2@worcester.edu>
Thu, 5 Jan 2017 03:16:26 +0000 (22:16 -0500)
27 files changed:
.dir-locals.el [new file with mode: 0644]
.gitignore [new file with mode: 0644]
Makefile.am [new file with mode: 0644]
README [new file with mode: 0644]
bootstrap [new file with mode: 0755]
chickadee.scm [new file with mode: 0644]
chickadee/color.scm [new file with mode: 0644]
chickadee/config.scm.in [new file with mode: 0644]
chickadee/input/controller.scm [new file with mode: 0644]
chickadee/math.scm [new file with mode: 0644]
chickadee/math/matrix.scm [new file with mode: 0644]
chickadee/math/vector.scm [new file with mode: 0644]
chickadee/render.scm [new file with mode: 0644]
chickadee/render/blend.scm [new file with mode: 0644]
chickadee/render/gl.scm [new file with mode: 0644]
chickadee/render/gpu.scm [new file with mode: 0644]
chickadee/render/shader.scm [new file with mode: 0644]
chickadee/render/shapes.scm [new file with mode: 0644]
chickadee/render/sprite.scm [new file with mode: 0644]
chickadee/render/texture.scm [new file with mode: 0644]
chickadee/render/vertex-buffer.scm [new file with mode: 0644]
chickadee/window.scm [new file with mode: 0644]
configure.ac [new file with mode: 0644]
doc/chickadee.texi [new file with mode: 0644]
doc/fdl.texi [new file with mode: 0644]
guix.scm [new file with mode: 0644]
pre-inst-env.in [new file with mode: 0644]

diff --git a/.dir-locals.el b/.dir-locals.el
new file mode 100644 (file)
index 0000000..86a4575
--- /dev/null
@@ -0,0 +1,13 @@
+((scheme-mode
+  .
+  ((eval . (put 'with-blend-mode 'scheme-indent-function 1))
+   (eval . (put 'with-depth-test 'scheme-indent-function 1))
+   (eval . (put 'with-texture 'scheme-indent-function 1))
+   (eval . (put 'with-shader 'scheme-indent-function 1))
+   (eval . (put 'with-vertex-array 'scheme-indent-function 1))
+   (eval . (put 'with-projection 'scheme-indent-function 1))
+   (eval . (put 'with-framebuffer 'scheme-indent-function 1))
+   (eval . (put 'with-viewport 'scheme-indent-function 1))
+   (eval . (put 'with-mapped-vertex-buffer 'scheme-indent-function 1))
+   (eval . (put 'uniform-let 'scheme-indent-function 1))
+   (eval . (put 'call-with-surface 'scheme-indent-function 1)))))
diff --git a/.gitignore b/.gitignore
new file mode 100644 (file)
index 0000000..245393f
--- /dev/null
@@ -0,0 +1,13 @@
+*.go
+
+/configure
+/config.status
+/config.log
+/Makefile
+/Makefile.in
+/aclocal.m4
+/pre-inst-env
+/chickadee/config.scm
+/doc/chickadee.info
+/autom4te.cache
+/build-aux
diff --git a/Makefile.am b/Makefile.am
new file mode 100644 (file)
index 0000000..780a085
--- /dev/null
@@ -0,0 +1,64 @@
+## Chickadee Game Toolkit
+## Copyright © 2016 David Thompson <davet@gnu.org>
+##
+## Chickadee is free software: you can redistribute it and/or modify
+## it under the terms of the GNU General Public License as published
+## by the Free Software Foundation, either version 3 of the License,
+## or (at your option) any later version.
+##
+## Chickadee 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 General Public License
+## along with this program.  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/$(GUILE_EFFECTIVE_VERSION)
+godir=$(libdir)/guile/$(GUILE_EFFECTIVE_VERSION)/ccache
+
+SOURCES =                                      \
+  chickadee/config.scm                         \
+  chickadee/input/controller.scm               \
+  chickadee/math.scm                           \
+  chickadee/math/vector.scm                    \
+  chickadee/math/matrix.scm                    \
+  chickadee/color.scm                          \
+  chickadee/render/gl.scm                      \
+  chickadee/render/gpu.scm                     \
+  chickadee/render/blend.scm                   \
+  chickadee/render/texture.scm                 \
+  chickadee/render/shader.scm                  \
+  chickadee/render/vertex-buffer.scm           \
+  chickadee/render/shapes.scm                  \
+  chickadee/render/sprite.scm                  \
+  chickadee/render.scm                         \
+  chickadee/window.scm                         \
+  chickadee.scm
+
+info_TEXINFOS = doc/chickadee.texi
+
+chickadee_TEXINFOS =                           \
+  doc/fdl.texi                                 \
+  doc/chickadee.texi
diff --git a/README b/README
new file mode 100644 (file)
index 0000000..daa87c3
--- /dev/null
+++ b/README
@@ -0,0 +1,47 @@
+-*- org -*-
+
+#+TITLE The Chickadee Game Development Toolkit
+
+* About
+
+  Chickadee is a game development toolkit for Guile Scheme.
+
+  #+BEGIN_SRC scheme
+    (use-modules (chickadee))
+
+    (define sprite #f)
+
+    (define (load)
+      (set! sprite (load-image "chickadee.png")))
+
+    (define (render alpha)
+      (draw-sprite sprite (vector2 320 240)))
+
+    (run-game #:load load #:render render)
+  #+END_SRC
+
+* Features
+
+  Chickadee supports the following features:
+
+  - 2D/3D rendering engine via OpenGL
+    - Efficient sprite rendering
+    - Signed distance field font rendering
+    - Particles
+    - Simple geometric shapes
+    - GLSL shaders
+  - Keyboard/mouse/joystick input
+  - Sound effects and music
+  - 2D/3D/4D vector math library
+  - Axis-aligned bounding box library
+  - Fixed timestep game loop
+
+* Dependencies
+
+  - Guile >= 2.1.4
+  - Guile-OpenGL >= 0.1.0
+  - Guile-SDL2 >= 0.2.0
+
+* License
+
+  GNU GPL version 3 or later
diff --git a/bootstrap b/bootstrap
new file mode 100755 (executable)
index 0000000..e756b42
--- /dev/null
+++ b/bootstrap
@@ -0,0 +1,3 @@
+#! /bin/sh
+
+autoreconf -vif
diff --git a/chickadee.scm b/chickadee.scm
new file mode 100644 (file)
index 0000000..e3d128a
--- /dev/null
@@ -0,0 +1,185 @@
+;;; Chickadee Game Toolkit
+;;; Copyright © 2016 David Thompson <davet@gnu.org>
+;;;
+;;; Chickadee is free software: you can redistribute it and/or modify
+;;; it under the terms of the GNU General Public License as published
+;;; by the Free Software Foundation, either version 3 of the License,
+;;; or (at your option) any later version.
+;;;
+;;; Chickadee 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 General Public License
+;;; along with this program.  If not, see
+;;; <http://www.gnu.org/licenses/>.
+
+(define-module (chickadee)
+  #:use-module (gl)
+  #:use-module (sdl2)
+  #:use-module (sdl2 events)
+  #:use-module (sdl2 input text)
+  #:use-module (chickadee window)
+  #:use-module (chickadee render gl)
+  #:export (load-hook
+            update-hook
+            before-draw-hook
+            draw-hook
+            after-draw-hook
+            quit-hook
+            key-press-hook
+            key-release-hook
+            text-input-hook
+            mouse-press-hook
+            mouse-release-hook
+            mouse-move-hook
+            controller-add-hook
+            controller-remove-hook
+            controller-press-hook
+            controller-release-hook
+            controller-move-hook
+            run-game
+            abort-game
+            time))
+
+(define load-hook (make-hook 0))
+(define update-hook (make-hook 1))
+(define before-draw-hook (make-hook 0))
+(define after-draw-hook (make-hook 0))
+(define draw-hook (make-hook 1))
+(define quit-hook (make-hook 0))
+(define key-press-hook (make-hook 4))
+(define key-release-hook (make-hook 3))
+(define text-input-hook (make-hook 1))
+(define mouse-press-hook (make-hook 4))
+(define mouse-release-hook (make-hook 3))
+(define mouse-move-hook (make-hook 5))
+(define controller-add-hook (make-hook 1))
+(define controller-remove-hook (make-hook 1))
+(define controller-press-hook (make-hook 2))
+(define controller-release-hook (make-hook 2))
+(define controller-move-hook (make-hook 3))
+
+(define open-controller (@@ (chickadee input controller) open-controller))
+(define close-controller (@@ (chickadee input controller) close-controller))
+(define lookup-controller (@@ (chickadee input controller) lookup-controller))
+
+(define game-loop-prompt-tag (make-prompt-tag 'game-loop))
+
+(define* (run-game #:key
+                   (window-title "Chickadee!")
+                   (window-width 640)
+                   (window-height 480)
+                   window-fullscreen?
+                   (update-hz 60))
+  (sdl-init)
+  (start-text-input)
+  (let ((window (open-window #:title window-title
+                             #:width window-width
+                             #:height window-height
+                             #:fullscreen? window-fullscreen?)))
+    (define (process-event event)
+      (cond
+       ((quit-event? event)
+        (run-hook quit-hook))
+       ((keyboard-down-event? event)
+        (run-hook key-press-hook
+                  (keyboard-event-key event)
+                  (keyboard-event-scancode event)
+                  (keyboard-event-modifiers event)
+                  (keyboard-event-repeat event)))
+       ((keyboard-up-event? event)
+        (run-hook key-release-hook
+                  (keyboard-event-key event)
+                  (keyboard-event-scancode event)
+                  (keyboard-event-modifiers event)))
+       ((text-input-event? event)
+        (run-hook text-input-hook (text-input-event-text event)))
+       ((mouse-button-down-event? event)
+        (run-hook mouse-press-hook
+                  (mouse-button-event-button event)
+                  (mouse-button-event-clicks event)
+                  (mouse-button-event-x event)
+                  (mouse-button-event-y event)))
+       ((mouse-button-up-event? event)
+        (run-hook mouse-release-hook
+                  (mouse-button-event-button event)
+                  (mouse-button-event-x event)
+                  (mouse-button-event-y event)))
+       ((mouse-motion-event? event)
+        (run-hook mouse-move-hook
+                  (mouse-motion-event-x event)
+                  (mouse-motion-event-y event)
+                  (mouse-motion-event-x-rel event)
+                  (mouse-motion-event-y-rel event)
+                  (mouse-motion-event-buttons event)))
+       ((and (controller-device-event? event)
+             (eq? (controller-device-event-action event) 'added))
+        (run-hook controller-add-hook
+                  (open-controller (controller-device-event-which event))))
+       ((and (controller-device-event? event)
+             (eq? (controller-device-event-action event) 'removed))
+        (let ((controller (lookup-controller
+                           (controller-device-event-which event))))
+          (run-hook controller-remove-hook controller)
+          (close-controller controller)))
+       ((controller-button-down-event? event)
+        (run-hook controller-press-hook
+                  (lookup-controller
+                   (controller-button-event-which event))
+                  (controller-button-event-button event)))
+       ((controller-button-up-event? event)
+        (run-hook controller-release-hook
+                  (lookup-controller
+                   (controller-button-event-which event))
+                  (controller-button-event-button event)))
+       ((controller-axis-event? event)
+        (run-hook controller-move-hook
+                  (lookup-controller
+                   (controller-axis-event-which event))
+                  (controller-axis-event-axis event)
+                  (/ (controller-axis-event-value event) 32768.0)))))
+    (with-window window
+      (let ((update-interval (round (/ 1000 update-hz))))
+        (call-with-prompt game-loop-prompt-tag
+          (lambda ()
+            ;; Catch SIGINT and kill the loop.
+            (sigaction SIGINT
+              (lambda (signum)
+                (abort-game)))
+            (run-hook load-hook)
+            (let loop ((previous-time (sdl-ticks))
+                       (lag 0))
+              (let* ((current-time (sdl-ticks))
+                     (delta (- current-time previous-time)))
+                (let update-loop ((lag (+ lag delta)))
+                  (if (>= lag update-interval)
+                      (begin
+                        ;; Process all pending events.
+                        (let loop ((event (poll-event)))
+                          (when event
+                            (process-event event)
+                            (loop (poll-event))))
+                        ;; Advance the simulation.
+                        (run-hook update-hook update-interval)
+                        (update-loop (- lag update-interval)))
+                      (begin
+                        ;; Render a frame.
+                        (run-hook before-draw-hook)
+                        (gl-clear-color 0.267 0.141 0.204 1.0)
+                        (gl-clear (logior (attrib-mask color-buffer)
+                                          (attrib-mask depth-buffer)
+                                          (attrib-mask stencil-buffer)))
+                        (run-hook draw-hook (/ lag update-interval))
+                        (swap-buffers window)
+                        (run-hook after-draw-hook)
+                        (loop current-time lag)))))))
+          (lambda (cont callback)
+            #f))))))
+
+(define (abort-game)
+  (abort-to-prompt game-loop-prompt-tag #f))
+
+(define (time)
+  (sdl-ticks))
diff --git a/chickadee/color.scm b/chickadee/color.scm
new file mode 100644 (file)
index 0000000..e40deb4
--- /dev/null
@@ -0,0 +1,182 @@
+;;; Chickadee Game Toolkit
+;;; Copyright © 2016 David Thompson <davet@gnu.org>
+;;;
+;;; Chickadee is free software: you can redistribute it and/or modify
+;;; it under the terms of the GNU General Public License as published
+;;; by the Free Software Foundation, either version 3 of the License,
+;;; or (at your option) any later version.
+;;;
+;;; Chickadee 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 General Public License
+;;; along with this program.  If not, see
+;;; <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+;;
+;; Colors!
+;;
+;;; Code:
+
+(define-module (chickadee color)
+  #:use-module (ice-9 match)
+  #:use-module (srfi srfi-9)
+  #:use-module (srfi srfi-1)
+  #:use-module (chickadee math)
+  #:export (<color>
+            make-color
+            color?
+            color-r color-g color-b color-a
+            rgba rgb transparency
+            color* color+ color- color-inverse color-lerp
+
+            white black red green blue yellow magenta cyan transparent
+            tango-light-butter tango-butter tango-dark-butter
+            tango-light-orange tango-orange tango-dark-orange
+            tango-light-chocolate tango-chocolate tango-dark-chocolate
+            tango-light-chameleon tango-chameleon tango-dark-chameleon
+            tango-light-sky-blue tango-sky-blue tango-dark-sky-blue
+            tango-light-plum tango-plum tango-dark-plum
+            tango-light-scarlet-red tango-scarlet-red tango-dark-scarlet-red
+            tango-aluminium-1 tango-aluminium-2 tango-aluminium-3
+            tango-aluminium-4 tango-aluminium-5 tango-aluminium-6))
+
+(define-record-type <color>
+  (%make-color r g b a)
+  color?
+  (r color-r)
+  (g color-g)
+  (b color-b)
+  (a color-a))
+
+(define (make-color r g b a)
+  "Return a newly allocated color with the given RGBA channel values.
+Each channel is clamped to the range [0, 1]."
+  (%make-color (clamp 0 1 r)
+               (clamp 0 1 g)
+               (clamp 0 1 b)
+               (clamp 0 1 a)))
+
+(define (color-component color-code offset)
+  "Return the value of an 8-bit color channel in the range [0,1] for
+the integer COLOR-CODE, given an OFFSET in bits."
+  (let ((mask (ash #xff offset)))
+    (/ (ash (logand mask color-code)
+            (- offset))
+       255.0)))
+
+(define (rgba color-code)
+  "Translate an RGBA format string COLOR-CODE into a color object.
+For example: #xffffffff will return a color with RGBA values 1, 1, 1,
+1."
+  (%make-color (color-component color-code 24)
+               (color-component color-code 16)
+               (color-component color-code 8)
+               (color-component color-code 0)))
+
+(define (rgb color-code)
+  "Translate an RGB format string COLOR-CODE into a color object.
+For example: #xffffff will return a color with RGBA values 1, 1, 1,
+1."
+  (%make-color (color-component color-code 16)
+               (color-component color-code 8)
+               (color-component color-code 0)
+               1.0))
+
+(define (transparency alpha)
+  "Create a new color that is white with a transparency value of
+ALPHA.  ALPHA is clamped to the range [0, 1]."
+  (make-color 1 1 1 alpha))
+
+;; (define-method (* (a <<color>>) (b <<color>>))
+;;   (make-color (* (color-r a) (color-r b))
+;;               (* (color-g a) (color-g b))
+;;               (* (color-b a) (color-b b))
+;;               (* (color-a a) (color-a b))))
+
+(define color*
+  (match-lambda*
+   ((($ <color> r1 g1 b1 a1) ($ <color> r2 g2 b2 a2))
+    (make-color (* r1 r2)
+                (* g1 g2)
+                (* b1 b2)
+                (* a1 a2)))
+   ((($ <color> r g b a) (? number? k))
+    (make-color (* r k)
+                (* g k)
+                (* b k)
+                (* a k)))))
+
+(define color+
+  (match-lambda*
+   ((($ <color> r1 g1 b1 a1) ($ <color> r2 g2 b2 a2))
+    (make-color (+ r1 r2)
+                (+ g1 g2)
+                (+ b1 b2)
+                (+ a1 a2)))))
+
+(define color-
+  (match-lambda*
+   ((($ <color> r1 g1 b1 a1) ($ <color> r2 g2 b2 a2))
+    (make-color (- r1 r2)
+                (- g1 g2)
+                (- b1 b2)
+                (- a1 a2)))))
+
+(define color-inverse
+  (match-lambda
+   (($ <color> r g b a)
+    (make-color (- 1 r)
+                (- 1 g)
+                (- 1 b)
+                a)))) ; Do not alter alpha channel.
+
+;;(define color-lerp (make-lerp color+ color*))
+
+;;;
+;;; Pre-defined Colors
+;;;
+
+;; Basic
+(define white (rgb #xffffff))
+(define black (rgb #x000000))
+(define red (rgb #xff0000))
+(define green (rgb #x00ff00))
+(define blue (rgb #x0000ff))
+(define yellow (rgb #xffff00))
+(define magenta (rgb #xff00ff))
+(define cyan (rgb #x00ffff))
+(define transparent (make-color 0 0 0 0))
+
+;; Tango color pallete
+;; http://tango.freedesktop.org
+(define tango-light-butter (rgb #xfce94f))
+(define tango-butter (rgb #xedd400))
+(define tango-dark-butter (rgb #xc4a000))
+(define tango-light-orange (rgb #xfcaf3e))
+(define tango-orange (rgb #xf57900))
+(define tango-dark-orange (rgb #xce5c00))
+(define tango-light-chocolate (rgb #xe9b96e))
+(define tango-chocolate (rgb #xc17d11))
+(define tango-dark-chocolate (rgb #x8f5902))
+(define tango-light-chameleon (rgb #x8ae234))
+(define tango-chameleon (rgb #x73d216))
+(define tango-dark-chameleon (rgb #x4e9a06))
+(define tango-light-sky-blue (rgb #x729fcf))
+(define tango-sky-blue (rgb #x3465a4))
+(define tango-dark-sky-blue (rgb #x204a87))
+(define tango-light-plum (rgb #xad7fa8))
+(define tango-plum (rgb #x75507b))
+(define tango-dark-plum (rgb #x5c3566))
+(define tango-light-scarlet-red (rgb #xef2929))
+(define tango-scarlet-red (rgb #xcc0000))
+(define tango-dark-scarlet-red (rgb #xa40000))
+(define tango-aluminium-1 (rgb #xeeeeec))
+(define tango-aluminium-2 (rgb #xd3d7cf))
+(define tango-aluminium-3 (rgb #xbabdb6))
+(define tango-aluminium-4 (rgb #x888a85))
+(define tango-aluminium-5 (rgb #x555753))
+(define tango-aluminium-6 (rgb #x2e3436))
diff --git a/chickadee/config.scm.in b/chickadee/config.scm.in
new file mode 100644 (file)
index 0000000..86aaeb5
--- /dev/null
@@ -0,0 +1,36 @@
+;;; Chickadee Game Toolkit
+;;; Copyright © 2016 David Thompson <davet@gnu.org>
+;;;
+;;; Chickadee 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.
+;;;
+;;; Chickadee 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 Lesser General
+;;; Public License for more details.
+;;;
+;;; You should have received a copy of the GNU Lesser General Public
+;;; License along with this program.  If not, see
+;;; <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+;;
+;; Build time configuration.
+;;
+;;; Code:
+
+(define-module (chickadee config)
+  #:export (%datadir
+            %sly-version
+            scope-datadir))
+
+(define %datadir
+  (or (getenv "SLY_DATADIR") "@chickadee_datadir@/chickadee"))
+
+(define %chickadee-version "@PACKAGE_VERSION@")
+
+(define (scope-datadir file)
+  "Append the Chickadee data directory to FILE."
+  (string-append %datadir file))
diff --git a/chickadee/input/controller.scm b/chickadee/input/controller.scm
new file mode 100644 (file)
index 0000000..e78623e
--- /dev/null
@@ -0,0 +1,87 @@
+;;; Chickadee Game Toolkit
+;;; Copyright © 2016 David Thompson <davet@gnu.org>
+;;;
+;;; Chickadee is free software: you can redistribute it and/or modify
+;;; it under the terms of the GNU General Public License as published
+;;; by the Free Software Foundation, either version 3 of the License,
+;;; or (at your option) any later version.
+;;;
+;;; Chickadee 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 General Public License
+;;; along with this program.  If not, see
+;;; <http://www.gnu.org/licenses/>.
+
+(define-module (chickadee input controller)
+  #:use-module (srfi srfi-9)
+  #:use-module (sdl2)
+  #:use-module ((sdl2 input game-controller) #:prefix sdl2:)
+  #:use-module ((sdl2 input joystick) #:prefix sdl2:)
+  #:export (controller?
+            controller-name
+            controller-power-level
+            controller-button-pressed?
+            controller-axis))
+
+(define-record-type <controller>
+  (wrap-controller sdl-controller)
+  controller?
+  (sdl-controller unwrap-controller))
+
+(define %controllers (make-hash-table))
+
+(define (open-controller index)
+  (let* ((sdl-controller (sdl2:open-game-controller index))
+         (controller (wrap-controller sdl-controller)))
+    ;; Register controller in global hash table for future lookup.
+    (hash-set! %controllers
+               (sdl2:joystick-instance-id
+                (sdl2:game-controller-joystick sdl-controller))
+               controller)
+    controller))
+
+(define (close-controller controller)
+  (hash-remove! %controllers
+                (sdl2:joystick-instance-id
+                 (sdl2:game-controller-joystick
+                  (unwrap-controller controller))))
+  (sdl2:close-game-controller (unwrap-controller controller)))
+
+(define (lookup-controller instance-id)
+  (hash-ref %controllers instance-id))
+
+(define (controller-name controller)
+  "Return the human readable model name of CONTROLLER."
+  (sdl2:game-controller-name (unwrap-controller controller)))
+
+(define (controller-power-level controller)
+  "Return the symbolic power level for CONTROLLER.
+
+Possible return values are:
+- unknown
+- empty
+- low
+- medium
+- full
+- wired"
+  (sdl2:joystick-power-level
+   (sdl2:game-controller-joystick
+    (unwrap-controller controller))))
+
+(define (controller-connected? controller)
+  "Return #t if CONTROLLER is currently in use."
+  (sdl2:game-controller-attached? (unwrap-controller controller)))
+
+(define (controller-button-pressed? controller button)
+  "Return #t if BUTTON is currently being pressed on CONTROLLER."
+  (sdl2:game-controller-button-pressed? (unwrap-controller controller) button))
+
+(define (controller-axis controller axis)
+  "Return a floating point value in the range [-1, 1] corresponding to
+how much AXIS is being pushed on CONTROLLER.  0 is returned if AXIS is
+not being pushed at all."
+  (/ (sdl2:game-controller-axis (unwrap-controller controller) axis)
+     32768.0))
diff --git a/chickadee/math.scm b/chickadee/math.scm
new file mode 100644 (file)
index 0000000..753f70d
--- /dev/null
@@ -0,0 +1,26 @@
+;;; Chickadee Game Toolkit
+;;; Copyright © 2016 David Thompson <davet@gnu.org>
+;;;
+;;; Chickadee is free software: you can redistribute it and/or modify
+;;; it under the terms of the GNU General Public License as published
+;;; by the Free Software Foundation, either version 3 of the License,
+;;; or (at your option) any later version.
+;;;
+;;; Chickadee 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 General Public License
+;;; along with this program.  If not, see
+;;; <http://www.gnu.org/licenses/>.
+
+(define-module (chickadee math)
+  #:export (clamp))
+
+(define (clamp min max x)
+  "Restrict X to the range defined by MIN and MAX. Assumes that MIN is
+actually less than MAX."
+  (cond ((< x min) min)
+        ((> x max) max)
+        (else x)))
diff --git a/chickadee/math/matrix.scm b/chickadee/math/matrix.scm
new file mode 100644 (file)
index 0000000..be307ab
--- /dev/null
@@ -0,0 +1,315 @@
+;;; Chickadee Game Toolkit
+;;; Copyright © 2016 David Thompson <davet@gnu.org>
+;;;
+;;; Chickadee is free software: you can redistribute it and/or modify
+;;; it under the terms of the GNU General Public License as published
+;;; by the Free Software Foundation, either version 3 of the License,
+;;; or (at your option) any later version.
+;;;
+;;; Chickadee 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 General Public License
+;;; along with this program.  If not, see
+;;; <http://www.gnu.org/licenses/>.
+
+(define-module (chickadee math matrix)
+  #:use-module (ice-9 match)
+  #:use-module (rnrs bytevectors)
+  #:use-module (srfi srfi-9)
+  #:use-module (srfi srfi-9 gnu)
+  #:use-module (srfi srfi-4)
+  #:use-module (system foreign)
+  #:use-module (chickadee math vector)
+  #:export (make-matrix4
+            make-null-matrix4
+            matrix4?
+            matrix4-mult!
+            matrix4*
+            matrix4-identity!
+            make-identity-matrix4
+            orthographic-projection
+            matrix4-translate!
+            matrix4-translate
+            matrix4-scale!
+            matrix4-scale
+            matrix4-rotate-z!
+            matrix4-rotate-z
+            transform))
+
+;; 4x4 matrix
+(define-record-type <matrix4>
+  (%make-matrix4 bv ptr)
+  matrix4?
+  (bv matrix4-bv)
+  (ptr matrix4-ptr))
+
+(define-inlinable (matrix-set! matrix row column x)
+  (f32vector-set! matrix (+ (* row 4) column) x))
+
+(define-inlinable (matrix-ref matrix row column)
+  (f32vector-ref matrix (+ (* row 4) column)))
+
+(define (init-matrix4 matrix
+                      aa ab ac ad
+                      ba bb bc bd
+                      ca cb cc cd
+                      da db dc dd)
+  (let ((bv (matrix4-bv matrix)))
+    (matrix-set! bv 0 0 aa)
+    (matrix-set! bv 0 1 ab)
+    (matrix-set! bv 0 2 ac)
+    (matrix-set! bv 0 3 ad)
+    (matrix-set! bv 1 0 ba)
+    (matrix-set! bv 1 1 bb)
+    (matrix-set! bv 1 2 bc)
+    (matrix-set! bv 1 3 bd)
+    (matrix-set! bv 2 0 ca)
+    (matrix-set! bv 2 1 cb)
+    (matrix-set! bv 2 2 cc)
+    (matrix-set! bv 2 3 cd)
+    (matrix-set! bv 3 0 da)
+    (matrix-set! bv 3 1 db)
+    (matrix-set! bv 3 2 dc)
+    (matrix-set! bv 3 3 dd)))
+
+(define (make-null-matrix4)
+  (let ((bv (make-f32vector 16)))
+    (%make-matrix4 bv (bytevector->pointer bv))))
+
+(define (make-matrix4 aa ab ac ad
+                      ba bb bc bd
+                      ca cb cc cd
+                      da db dc dd)
+  "Return a new 4x4 matrix initialized with the given 16 values in
+column-major format."
+  (let ((matrix (make-null-matrix4)))
+    (init-matrix4 matrix
+                  aa ab ac ad
+                  ba bb bc bd
+                  ca cb cc cd
+                  da db dc dd)
+    matrix))
+
+(define (matrix4-mult! dest a b)
+  "Multiply matrices A and B, storing the result in DEST."
+  (let ((m1 (matrix4-bv a))
+        (m2 (matrix4-bv b))
+        (m3 (matrix4-bv dest)))
+    (let ((m1-0-0 (matrix-ref m1 0 0))
+          (m1-0-1 (matrix-ref m1 0 1))
+          (m1-0-2 (matrix-ref m1 0 2))
+          (m1-0-3 (matrix-ref m1 0 3))
+          (m1-1-0 (matrix-ref m1 1 0))
+          (m1-1-1 (matrix-ref m1 1 1))
+          (m1-1-2 (matrix-ref m1 1 2))
+          (m1-1-3 (matrix-ref m1 1 3))
+          (m1-2-0 (matrix-ref m1 2 0))
+          (m1-2-1 (matrix-ref m1 2 1))
+          (m1-2-2 (matrix-ref m1 2 2))
+          (m1-2-3 (matrix-ref m1 2 3))
+          (m1-3-0 (matrix-ref m1 3 0))
+          (m1-3-1 (matrix-ref m1 3 1))
+          (m1-3-2 (matrix-ref m1 3 2))
+          (m1-3-3 (matrix-ref m1 3 3))
+          (m2-0-0 (matrix-ref m2 0 0))
+          (m2-0-1 (matrix-ref m2 0 1))
+          (m2-0-2 (matrix-ref m2 0 2))
+          (m2-0-3 (matrix-ref m2 0 3))
+          (m2-1-0 (matrix-ref m2 1 0))
+          (m2-1-1 (matrix-ref m2 1 1))
+          (m2-1-2 (matrix-ref m2 1 2))
+          (m2-1-3 (matrix-ref m2 1 3))
+          (m2-2-0 (matrix-ref m2 2 0))
+          (m2-2-1 (matrix-ref m2 2 1))
+          (m2-2-2 (matrix-ref m2 2 2))
+          (m2-2-3 (matrix-ref m2 2 3))
+          (m2-3-0 (matrix-ref m2 3 0))
+          (m2-3-1 (matrix-ref m2 3 1))
+          (m2-3-2 (matrix-ref m2 3 2))
+          (m2-3-3 (matrix-ref m2 3 3)))
+      (matrix-set! m3 0 0
+                   (+ (* m1-0-0 m2-0-0)
+                      (* m1-0-1 m2-1-0)
+                      (* m1-0-2 m2-2-0)
+                      (* m1-0-3 m2-3-0)))
+      (matrix-set! m3 0 1
+                   (+ (* m1-0-0 m2-0-1)
+                      (* m1-0-1 m2-1-1)
+                      (* m1-0-2 m2-2-1)
+                      (* m1-0-3 m2-3-1)))
+      (matrix-set! m3 0 2
+                   (+ (* m1-0-0 m2-0-2)
+                      (* m1-0-1 m2-1-2)
+                      (* m1-0-2 m2-2-2)
+                      (* m1-0-3 m2-3-2)))
+      (matrix-set! m3 0 3
+                   (+ (* m1-0-0 m2-0-3)
+                      (* m1-0-1 m2-1-3)
+                      (* m1-0-2 m2-2-3)
+                      (* m1-0-3 m2-3-3)))
+      (matrix-set! m3 1 0
+                   (+ (* m1-1-0 m2-0-0)
+                      (* m1-1-1 m2-1-0)
+                      (* m1-1-2 m2-2-0)
+                      (* m1-1-3 m2-3-0)))
+      (matrix-set! m3 1 1
+                   (+ (* m1-1-0 m2-0-1)
+                      (* m1-1-1 m2-1-1)
+                      (* m1-1-2 m2-2-1)
+                      (* m1-1-3 m2-3-1)))
+      (matrix-set! m3 1 2
+                   (+ (* m1-1-0 m2-0-2)
+                      (* m1-1-1 m2-1-2)
+                      (* m1-1-2 m2-2-2)
+                      (* m1-1-3 m2-3-2)))
+      (matrix-set! m3 1 3
+                   (+ (* m1-1-0 m2-0-3)
+                      (* m1-1-1 m2-1-3)
+                      (* m1-1-2 m2-2-3)
+                      (* m1-1-3 m2-3-3)))
+      (matrix-set! m3 2 0
+                   (+ (* m1-2-0 m2-0-0)
+                      (* m1-2-1 m2-1-0)
+                      (* m1-2-2 m2-2-0)
+                      (* m1-2-3 m2-3-0)))
+      (matrix-set! m3 2 1
+                   (+ (* m1-2-0 m2-0-1)
+                      (* m1-2-1 m2-1-1)
+                      (* m1-2-2 m2-2-1)
+                      (* m1-2-3 m2-3-1)))
+      (matrix-set! m3 2 2
+                   (+ (* m1-2-0 m2-0-2)
+                      (* m1-2-1 m2-1-2)
+                      (* m1-2-2 m2-2-2)
+                      (* m1-2-3 m2-3-2)))
+      (matrix-set! m3 2 3
+                   (+ (* m1-2-0 m2-0-3)
+                      (* m1-2-1 m2-1-3)
+                      (* m1-2-2 m2-2-3)
+                      (* m1-2-3 m2-3-3)))
+      (matrix-set! m3 3 0
+                   (+ (* m1-3-0 m2-0-0)
+                      (* m1-3-1 m2-1-0)
+                      (* m1-3-2 m2-2-0)
+                      (* m1-3-3 m2-3-0)))
+      (matrix-set! m3 3 1
+                   (+ (* m1-3-0 m2-0-1)
+                      (* m1-3-1 m2-1-1)
+                      (* m1-3-2 m2-2-1)
+                      (* m1-3-3 m2-3-1)))
+      (matrix-set! m3 3 2
+                   (+ (* m1-3-0 m2-0-2)
+                      (* m1-3-1 m2-1-2)
+                      (* m1-3-2 m2-2-2)
+                      (* m1-3-3 m2-3-2)))
+      (matrix-set! m3 3 3
+                   (+ (* m1-3-0 m2-0-3)
+                      (* m1-3-1 m2-1-3)
+                      (* m1-3-2 m2-2-3)
+                      (* m1-3-3 m2-3-3))))))
+
+(define (matrix4-copy matrix)
+  (let ((bv (bytevector-copy (matrix4-bv matrix))))
+    (%make-matrix4 bv (bytevector->pointer bv))))
+
+(define (matrix4* . matrices)
+  "Return the product of MATRICES."
+  (match matrices
+    (() (make-identity-matrix4))
+    ((a b)
+     (let ((result (make-identity-matrix4)))
+       (matrix4-mult! result a b)
+       result))
+    ((first . rest)
+     (let loop ((temp (make-identity-matrix4))
+                (prev (matrix4-copy first))
+                (matrices rest))
+       (match matrices
+         (() prev)
+         ((current . rest)
+          (matrix4-mult! temp prev current)
+          (loop prev temp rest)))))))
+
+(define (matrix4-identity! matrix)
+  (init-matrix4 matrix
+                1.0 0.0 0.0 0.0
+                0.0 1.0 0.0 0.0
+                0.0 0.0 1.0 0.0
+                0.0 0.0 0.0 1.0))
+
+(define (make-identity-matrix4)
+  (let ((matrix (make-null-matrix4)))
+    (matrix4-identity! matrix)
+    matrix))
+
+(define (orthographic-projection left right top bottom near far)
+  "Return a new transform that represents an orthographic projection
+for the vertical clipping plane LEFT and RIGHT, the horizontal
+clipping plane TOP and BOTTOM, and the depth clipping plane NEAR and
+FAR."
+  (make-matrix4 (/ 2 (- right left)) 0 0 0
+                0 (/ 2 (- top bottom)) 0 0
+                0 0 (/ 2 (- far near)) 0
+                (- (/ (+ right left) (- right left)))
+                (- (/ (+ top bottom) (- top bottom)))
+                (- (/ (+ far near) (- far near)))
+                1))
+
+(define (matrix4-translate! matrix v)
+  (cond
+   ((vector2? v)
+    (init-matrix4  matrix
+                   1 0 0 0
+                   0 1 0 0
+                   0 0 1 0
+                   (vx v) (vy v) 0 1))
+   ((vector3? v)
+    (init-matrix4  matrix
+                   1 0 0 0
+                   0 1 0 0
+                   0 0 1 0
+                   (vx v) (vy v) (vz v) 1))
+   (else
+    (error "invalid translation vector" v))))
+
+(define (matrix4-translate v)
+  (let ((matrix (make-null-matrix4)))
+    (matrix4-translate! matrix v)
+    matrix))
+
+(define (matrix4-scale! matrix s)
+  (init-matrix4  matrix
+                 s    0.0  0.0  0.0
+                 0.0  s    0.0  0.0
+                 0.0  0.0  s    0.0
+                 0.0  0.0  0.0  1.0))
+
+(define (matrix4-scale s)
+  (let ((matrix (make-null-matrix4)))
+    (matrix4-scale! matrix s)
+    matrix))
+
+(define (matrix4-rotate-z! matrix angle)
+  (init-matrix4 matrix
+                (cos angle) (- (sin angle)) 0.0 0.0
+                (sin angle) (cos angle)     0.0 0.0
+                0.0         0.0             1.0 0.0
+                0.0         0.0             0.0 1.0))
+
+(define (matrix4-rotate-z angle)
+  "Return a new matrix that rotates the Z axis by ANGLE radians."
+  (let ((matrix (make-null-matrix4)))
+    (matrix4-rotate-z! matrix angle)
+    matrix))
+
+(define (transform matrix x y)
+  (let ((bv (matrix4-bv matrix)))
+    (values (+ (* x (matrix-ref bv 0 0))
+               (* y (matrix-ref bv 1 0))
+               (matrix-ref bv 3 0))
+            (+ (* x (matrix-ref bv 0 1))
+               (* y (matrix-ref bv 1 1))
+               (matrix-ref bv 3 1)))))
diff --git a/chickadee/math/vector.scm b/chickadee/math/vector.scm
new file mode 100644 (file)
index 0000000..66a21fd
--- /dev/null
@@ -0,0 +1,201 @@
+;;; Chickadee Game Toolkit
+;;; Copyright © 2016 David Thompson <davet@gnu.org>
+;;;
+;;; Chickadee is free software: you can redistribute it and/or modify
+;;; it under the terms of the GNU General Public License as published
+;;; by the Free Software Foundation, either version 3 of the License,
+;;; or (at your option) any later version.
+;;;
+;;; Chickadee 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 General Public License
+;;; along with this program.  If not, see
+;;; <http://www.gnu.org/licenses/>.
+
+(define-module (chickadee math vector)
+  #:use-module (ice-9 match)
+  #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-9)
+  #:export (<vector2>
+            <vector3>
+            <vector4>
+            vector2 vector3 vector4
+            vector2? vector3? vector4?
+            polar2
+            vx vy vz vw
+
+            vadd! vmul!
+            vx-in-range? vy-in-range?
+
+            vmap v+ v- v* vdot vcross
+            magnitude normalize
+            anchor-vector)
+  #:replace (magnitude))
+
+(define-inlinable (square x)
+  (* x x))
+
+(define-record-type <vector2>
+  (vector2 x y)
+  vector2?
+  (x vector2-x)
+  (y vector2-y))
+
+(define-record-type <vector3>
+  (vector3 x y z)
+  vector3?
+  (x vector3-x)
+  (y vector3-y)
+  (z vector3-z))
+
+(define-record-type <vector4>
+  (vector4 x y z w)
+  vector4?
+  (x vector4-x)
+  (y vector4-y)
+  (z vector4-z)
+  (w vector4-w))
+
+(define vx
+  (match-lambda
+   ((or ($ <vector2> x _)
+        ($ <vector3> x _ _)
+        ($ <vector4> x _ _ _))
+    x)))
+
+(define vy
+  (match-lambda
+   ((or ($ <vector2> _ y)
+        ($ <vector3> _ y _)
+        ($ <vector4> _ y _ _))
+    y)))
+
+(define vz
+  (match-lambda
+   ((or ($ <vector3> _ _ z)
+        ($ <vector4> _ _ z _))
+    z)))
+
+(define vw vector4-w)
+
+(define (polar2 r theta)
+  "Create a new 2D vector from the polar coordinate (R, THETA) where R
+is the radius and THETA is the angle."
+  (vector2 (* r (cos theta))
+           (* r (sin theta))))
+
+(define (vmap proc v)
+  "Return a new vector that is the result of applying PROC to each
+element of the 2D/3D/4D vector V."
+  (match v
+    (($ <vector2> x y)
+     (vector2 (proc x) (proc y)))
+    (($ <vector3> x y z)
+     (vector3 (proc x) (proc y) (proc z)))
+    (($ <vector4> x y z w)
+     (vector4 (proc x) (proc y) (proc z) (proc w)))))
+
+(define-syntax-rule (vector-lambda proc)
+  (match-lambda*
+   ((($ <vector2> x1 y1) ($ <vector2> x2 y2))
+    (vector2 (proc x1 x2) (proc y1 y2)))
+   ((($ <vector2> x y) (? number? k))
+    (vector2 (proc x k) (proc y k)))
+   (((? number? k) ($ <vector2> x y))
+    (vector2 (proc k x) (proc k y)))
+   ((($ <vector3> x1 y1 z1) ($ <vector3> x2 y2 z2))
+    (vector3 (proc x1 x2) (proc y1 y2) (proc z1 z2)))
+   ((($ <vector3> x y z) (? number? k))
+    (vector3 (proc x k) (proc y k) (proc z k)))
+   (((? number? k) ($ <vector3> x y z))
+    (vector3 (proc k x) (proc k y) (proc k z)))
+   ((($ <vector4> x1 y1 z1 w1) ($ <vector4> x2 y2 z2 w2))
+    (vector4 (proc x1 x2) (proc y1 y2) (proc z1 z2) (proc w1 w2)))
+   ((($ <vector4> x y z w) (? number? k))
+    (vector4 (proc x k) (proc y k) (proc z k) (proc w k)))
+   (((? number? k) ($ <vector4> x y z w))
+    (vector4 (proc k x) (proc k y) (proc k z) (proc k w)))))
+
+(define (v+ . vectors)
+  (reduce (vector-lambda +) 0 vectors))
+
+(define v-
+  (match-lambda*
+   ((v) (v- 0 v))
+   ((v v* ...)
+    (fold-right (let ((- (vector-lambda -)))
+                  (lambda (prev v)
+                    (- v prev)))
+                v v*))))
+
+(define (v* . vectors)
+  (reduce (vector-lambda *) 1 vectors))
+
+(define vdot
+  (match-lambda*
+   ((($ <vector2> x1 y1) ($ <vector2> x2 y2))
+    (+ (* x1 x2) (* y1 y2)))
+   ((($ <vector3> x1 y1 z1) ($ <vector3> x2 y2 z2))
+    (+ (* x1 x2) (* y1 y2) (* z1 z2)))
+   ((($ <vector4> x1 y1 z1 w1) ($ <vector4> x2 y2 z2 w2))
+    (+ (* x1 x2) (* y1 y2) (* z1 z2) (* w1 w2)))))
+
+(define vcross
+  (match-lambda*
+   ((($ <vector3> x1 y1 z1) ($ <vector3> x2 y2 z2))
+    (vector3 (- (* y1 z2) (* z1 y2))
+             (- (* z1 x2) (* x1 z2))
+             (- (* x1 y2) (* y1 x2))))))
+
+(define (magnitude v)
+  "Return the magnitude of the vector V."
+  (sqrt
+   (match v
+     (($ <vector2> x y)
+      (+ (square x) (square y)))
+     (($ <vector3> x y z)
+      (+ (square x) (square y) (square z)))
+     (($ <vector4> x y z w)
+      (+ (square x) (square y) (square z) (square w))))))
+
+(define (normalize v)
+  "Return the normalized form of the vector V."
+  (let ((m (magnitude v)))
+    (if (zero? m)
+        v
+        (match v
+          (($ <vector2> x y)
+           (vector2 (/ x m) (/ y m)))
+          (($ <vector3> x y z)
+           (vector3 (/ x m) (/ y m) (/ z m)))
+          (($ <vector4> x y z w)
+           (vector4 (/ x m) (/ y m) (/ z m) (/ w m)))))))
+
+(define (anchor-vector width height anchor)
+  "Create an anchor point vector from the description ANCHOR within
+the rectangular defined by WIDTH and HEIGHT.  Valid values for ANCHOR
+are: 'center', 'top-left', 'top-right', 'bottom-left', 'bottom-right',
+'top-center', 'bottom-center', or any 2D vector.  When ANCHOR is a 2D
+vector, the return value is simply the same vector."
+  (match anchor
+    ((? vector2? anchor)
+     anchor)
+    ('center
+     (vector2 (/ width 2)
+              (/ height 2)))
+    ('top-left
+     (vector2 0 height))
+    ('top-right
+     (vector2 width height))
+    ('bottom-left
+     (vector2 0 0))
+    ('bottom-right
+     (vector2 width 0))
+    ('top-center
+     (vector2 (/ width 2) height))
+    ('bottom-center
+     (vector2 (/ width 2) 0))
+    (_ (error "Invalid anchor type: " anchor))))
diff --git a/chickadee/render.scm b/chickadee/render.scm
new file mode 100644 (file)
index 0000000..d55c76e
--- /dev/null
@@ -0,0 +1,135 @@
+;;; Chickadee Game Toolkit
+;;; Copyright © 2016 David Thompson <davet@gnu.org>
+;;;
+;;; Chickadee is free software: you can redistribute it and/or modify
+;;; it under the terms of the GNU General Public License as published
+;;; by the Free Software Foundation, either version 3 of the License,
+;;; or (at your option) any later version.
+;;;
+;;; Chickadee 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 General Public License
+;;; along with this program.  If not, see
+;;; <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+;;
+;; High-level rendering API.
+;;
+;;; Code:
+
+(define-module (chickadee render)
+  #:use-module (srfi srfi-88)
+  #:use-module (chickadee math matrix)
+  #:use-module (chickadee render gpu)
+  #:use-module (chickadee render blend)
+  #:use-module (chickadee render shader)
+  #:use-module (chickadee render texture)
+  #:use-module (chickadee render vertex-buffer)
+  #:export (current-blend-mode
+            current-depth-test
+            current-texture
+            current-projection
+            with-blend-mode
+            with-depth-test
+            with-texture
+            with-projection
+            gpu-apply
+            gpu-apply*))
+
+(define *current-blend-mode* 'replace)
+(define *current-depth-test* #f)
+(define *current-texture* null-texture)
+(define *current-projection* (make-identity-matrix4))
+
+(define (current-blend-mode)
+  *current-blend-mode*)
+
+(define (current-depth-test)
+  *current-depth-test*)
+
+(define (current-texture)
+  *current-texture*)
+
+(define (current-projection)
+  *current-projection*)
+
+(define-syntax-rule (with (name value) body ...)
+  (let ((prev name))
+    (dynamic-wind
+      (lambda () (set! name value))
+      (lambda () body ...)
+      (lambda () (set! name prev)))))
+
+(define-syntax-rule (with-blend-mode blend-mode body ...)
+  (with (*current-blend-mode* blend-mode) body ...))
+
+(define-syntax-rule (with-depth-test depth-test body ...)
+  (with (*current-depth-test* depth-test) body ...))
+
+(define-syntax-rule (with-texture texture body ...)
+  (with (*current-texture* texture) body ...))
+
+(define-syntax-rule (with-shader shader body ...)
+  (with (*current-shader* shader)
+        (initialize-uniforms)
+        body ...))
+
+(define-syntax-rule (with-vertex-array vertex-array body ...)
+  (with (*current-vertex-array* vertex-array) body ...))
+
+(define-syntax-rule (with-projection matrix body ...)
+  (with (*current-projection* matrix) body ...))
+
+;; (define (initialize-uniforms)
+;;   (hash-for-each (lambda (name uniform)
+;;                    (unless (hash-get-handle *current-uniforms* name)
+;;                      (hash-set! *current-uniforms* name
+;;                                 (uniform-default-value uniform))))
+;;                  (shader-uniforms *current-shader*)))
+
+;; (define-syntax uniform-let
+;;   (syntax-rules ()
+;;     ((_ () body ...) (begin body ...))
+;;     ((_ ((name value) . rest) body ...)
+;;      (let ((uniform (shader-uniform (current-shader) name))
+;;            (prev (hash-ref *current-uniforms* name)))
+;;        (if uniform
+;;            (dynamic-wind
+;;              (lambda ()
+;;                (hash-set! *current-uniforms* name value))
+;;              (lambda ()
+;;                (uniform-let rest body ...))
+;;              (lambda ()
+;;                (hash-set! *current-uniforms* name prev)))
+;;            (error "no such uniform: " name))))))
+
+;; (define (uniform-ref name)
+;;   (uniform-value (shader-uniform (current-shader) name)))
+
+(define-syntax uniform-apply
+  (lambda (x)
+    (syntax-case x ()
+      ((_ shader ()) (datum->syntax x #t))
+      ((_ shader (name value . rest))
+       (with-syntax ((sname (datum->syntax x (keyword->string
+                                              (syntax->datum #'name)))))
+         #'(begin
+             (set-uniform-value! (shader-uniform shader sname) value)
+             (uniform-apply shader rest)))))))
+
+(define-syntax-rule (gpu-apply* shader vertex-array count . uniforms)
+  (begin
+    (gpu-state-set! *blend-mode-state* (current-blend-mode))
+    (gpu-state-set! *depth-test-state* (current-depth-test))
+    (gpu-state-set! *texture-state* (current-texture))
+    (gpu-state-set! *shader-state* shader)
+    (gpu-state-set! *vertex-array-state* vertex-array)
+    (uniform-apply shader uniforms)
+    (render-vertices count)))
+
+(define-syntax-rule (gpu-apply shader vertex-array uniforms ...)
+  (gpu-apply* shader vertex-array #f uniforms ...))
diff --git a/chickadee/render/blend.scm b/chickadee/render/blend.scm
new file mode 100644 (file)
index 0000000..2e8ebb0
--- /dev/null
@@ -0,0 +1,73 @@
+;;; Chickadee Game Toolkit
+;;; Copyright © 2016 David Thompson <davet@gnu.org>
+;;;
+;;; Chickadee is free software: you can redistribute it and/or modify
+;;; it under the terms of the GNU General Public License as published
+;;; by the Free Software Foundation, either version 3 of the License,
+;;; or (at your option) any later version.
+;;;
+;;; Chickadee 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 General Public License
+;;; along with this program.  If not, see
+;;; <http://www.gnu.org/licenses/>.
+
+(define-module (chickadee render blend)
+  #:use-module (ice-9 match)
+  #:use-module (gl)
+  #:use-module (chickadee render gl)
+  #:use-module (chickadee render gpu)
+  #:export (*blend-mode-state*
+            *depth-test-state*))
+
+(define (apply-blend-mode blend-mode)
+  (if blend-mode
+      (begin
+        (gl-enable (enable-cap blend))
+        (match blend-mode
+          ('alpha
+           (gl-blend-equation (blend-equation-mode-ext func-add-ext))
+           (gl-blend-func (blending-factor-src src-alpha)
+                          (blending-factor-dest one-minus-src-alpha)))
+          ('multiply
+           (gl-blend-equation (blend-equation-mode-ext func-add-ext))
+           (gl-blend-func (blending-factor-src dst-color)
+                          (blending-factor-dest zero)))
+          ('subtract
+           (gl-blend-equation
+            (blend-equation-mode-ext func-reverse-subtract-ext))
+           (gl-blend-func (blending-factor-src one)
+                          (blending-factor-dest zero)))
+          ('add
+           (gl-blend-equation (blend-equation-mode-ext func-add-ext))
+           (gl-blend-func (blending-factor-src one)
+                          (blending-factor-dest zero)))
+          ('lighten
+           (gl-blend-equation (blend-equation-mode-ext max-ext))
+           (gl-blend-func (blending-factor-src one)
+                          (blending-factor-dest zero)))
+          ('darken
+           (gl-blend-equation (blend-equation-mode-ext min-ext))
+           (gl-blend-func (blending-factor-src one)
+                          (blending-factor-dest zero)))
+          ('screen
+           (gl-blend-equation (blend-equation-mode-ext func-add-ext))
+           (gl-blend-func (blending-factor-src one)
+                          (blending-factor-dest one-minus-src-color)))
+          ('replace
+           (gl-blend-equation (blend-equation-mode-ext func-add-ext))
+           (gl-blend-func (blending-factor-src one)
+                          (blending-factor-dest zero)))))
+      (gl-disable (enable-cap blend))))
+
+(define *blend-mode-state* (make-gpu-state apply-blend-mode 'replace))
+
+(define (apply-depth-test depth-test?)
+  (if depth-test?
+      (gl-enable (enable-cap depth-test))
+      (gl-disable (enable-cap depth-test))))
+
+(define *depth-test-state* (make-gpu-state apply-depth-test #f))
diff --git a/chickadee/render/gl.scm b/chickadee/render/gl.scm
new file mode 100644 (file)
index 0000000..bc93d13
--- /dev/null
@@ -0,0 +1,275 @@
+;;; Chickadee Game Toolkit
+;;; Copyright © 2016 David Thompson <davet@gnu.org>
+;;;
+;;; Chickadee is free software: you can redistribute it and/or modify
+;;; it under the terms of the GNU General Public License as published
+;;; by the Free Software Foundation, either version 3 of the License,
+;;; or (at your option) any later version.
+;;;
+;;; Chickadee 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 General Public License
+;;; along with this program.  If not, see
+;;; <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+;;
+;; Custom wrappers over low level OpenGL commands that aren't part of
+;; guile-opengl.
+;;
+;;; Code:
+
+(define-module (chickadee render gl)
+  #:use-module (srfi srfi-4)
+  #:use-module ((system foreign) #:select (bytevector->pointer))
+  #:use-module (gl)
+  #:use-module ((gl low-level) #:renamer (symbol-prefix-proc '%))
+  #:use-module (gl enums)
+  #:use-module (gl runtime)
+  #:use-module (gl types))
+
+(re-export (%glClearColor . gl-clear-color)
+           (%glScissor . gl-scissor)
+           (%glBlendFunc . gl-blend-func)
+           (%glBlendEquation . gl-blend-equation))
+
+;;;
+;;; 3.8.1 Texture Image Specification
+;;;
+
+(re-export (%glTexImage3D . gl-texture-image-3d)
+           (%glTexImage2D . gl-texture-image-2d)
+           (%glTexImage1D . gl-texture-image-1d))
+
+;;;
+;;; 3.8.2 Alternate Texture Image Specification Commands
+;;;
+
+(re-export (%glCopyTexImage2D . gl-copy-texture-image-2d)
+           (%glCopyTexImage1D . gl-copy-texture-image-1d)
+           (%glCopyTexSubImage3D . gl-copy-texture-sub-image-3d)
+           (%glCopyTexSubImage2D . gl-copy-texture-sub-image-2d)
+           (%glCopyTexSubImage1D . gl-copy-texture-sub-image-1d)
+           (%glTexSubImage3D . gl-texture-sub-image-3d)
+           (%glTexSubImage2D . gl-texture-sub-image-2d)
+           (%glTexSubImage1D . gl-texture-sub-image-1d))
+
+;;;
+;;; 3.8.3 Compressed Texture Images
+;;;
+
+(re-export (%glCompressedTexImage1D . gl-compressed-texture-image-1d)
+           (%glCompressedTexImage2D . gl-compressed-texture-image-2d)
+           (%glCompressedTexImage3D . gl-compressed-texture-image-3d)
+           (%glCompressedTexSubImage1D . gl-compressed-texture-sub-image-1d)
+           (%glCompressedTexSubImage2D . gl-compressed-texture-sub-image-2d)
+           (%glCompressedTexSubImage3D . gl-compressed-texture-sub-image-3d))
+
+;;;
+;;; 3.8.4 Texture Parameters
+;;;
+
+(re-export  (%glTexParameteri . gl-texture-parameter)
+            (%glBindTexture . gl-bind-texture))
+
+;;;
+;;; Instancing extension
+;;;
+
+(define-gl-procedure (glDrawArraysInstanced (mode GLenum)
+                                            (first GLint)
+                                            (count GLsizei)
+                                            (primcount GLsizei)
+                                            -> GLboolean)
+  "Draw multiple instances of a set of arrays.")
+
+(define-gl-procedure (glVertexAttribDivisor (index GLuint)
+                                            (divisor GLuint)
+                                            -> void)
+  "Modify the rate at which generic vertex attributes advance during
+instanced rendering.")
+
+(export glDrawArraysInstanced
+        glVertexAttribDivisor)
+
+;;;
+;;; VBOs
+;;;
+
+(re-export (%glGenBuffers . gl-gen-buffers)
+           (%glDeleteBuffers . gl-delete-buffers)
+           (%glBufferData . gl-buffer-data)
+           (%glMapBuffer . gl-map-buffer)
+           (%glUnmapBuffer . gl-unmap-buffer))
+
+;;;
+;;; VAOs
+;;;
+
+(define-gl-procedure (glGenVertexArrays (n GLsizei)
+                                        (arrays GLuint-*)
+                                        -> void)
+  "Generate N vertex arrays.")
+
+(define-gl-procedure (glDeleteVertexArrays (n GLsizei)
+                                           (arrays GLuint-*)
+                                           -> void)
+  "Delete vertex array objects.")
+
+(define-gl-procedure (glBindVertexArray (array GLuint)
+                                        -> void)
+  "Bind vertex array object ARRAY.")
+
+(define-gl-procedure (glEnableVertexAttribArray (index GLuint)
+                                                -> void)
+  "Enable or disable a generic vertex attribute array.")
+
+(define-gl-procedure (glVertexAttribPointer (index GLuint)
+                                            (size GLint)
+                                            (type GLenum)
+                                            (normalized GLboolean)
+                                            (stride GLsizei)
+                                            (pointer GLvoid-*)
+                                            -> void)
+  "Define an array of generic vertex attribute data.")
+
+(define-gl-procedure (glDrawElements (mode GLenum)
+                                     (count GLsizei)
+                                     (type GLenum)
+                                     (indices GLvoid-*)
+                                     -> void)
+  "Render primitives from array data.")
+
+(export (glGenVertexArrays . gl-gen-vertex-arrays)
+        (glDeleteVertexArrays . gl-delete-vertex-arrays)
+        (glBindVertexArray . gl-bind-vertex-array)
+        (glEnableVertexAttribArray . gl-enable-vertex-attrib-array)
+        (glVertexAttribPointer . gl-vertex-attrib-pointer)
+        (glDrawElements . gl-draw-elements))
+
+(define-syntax-rule (with-gl-client-state state body ...)
+  (begin
+    (gl-enable-client-state state)
+    body ...
+    (gl-disable-client-state state)))
+
+(export with-gl-client-state)
+
+;;;
+;;; Framebuffers
+;;;
+
+(define-gl-procedure (glGenFramebuffers (n GLsizei)
+                                        (ids GLuint-*)
+                                        -> void)
+  "Generate framebuffer object names.")
+
+(define-gl-procedure (glDeleteFramebuffers (n GLsizei)
+                                           (framebuffers GLuint-*)
+                                           -> void)
+  "Delete framebuffer objects.")
+
+(define-gl-procedure (glBindFramebuffer (target GLenum)
+                                        (framebuffer GLuint)
+                                        -> void)
+  "Bind a framebuffer to a framebuffer target.")
+
+(define-gl-procedure (glFramebufferTexture2D (target GLenum)
+                                             (attachment GLenum)
+                                             (textarget GLenum)
+                                             (texture GLuint)
+                                             (level GLint)
+                                             -> void)
+  "Attach a level of a texture object as a logical buffer to the
+currently bound framebuffer object.")
+
+(define-gl-procedure (glCheckFramebufferStatus (target GLenum)
+                                               -> GLenum)
+  "Return the framebuffer completeness status of a framebuffer
+object.")
+
+(define-gl-procedure (glGenRenderbuffers (n GLsizei)
+                                         (ids GLuint-*)
+                                         -> void)
+  "Generate renderbuffer object names.")
+
+(define-gl-procedure (glDeleteRenderbuffers (n GLsizei)
+                                            (renderbuffers GLuint-*)
+                                            -> void)
+  "Delete renderbuffer objects.")
+
+(define-gl-procedure (glBindRenderbuffer (target GLenum)
+                                         (renderbuffer GLuint)
+                                         -> void)
+  "Bind a named renderbuffer object.")
+
+(define-gl-procedure (glRenderbufferStorage (target GLenum)
+                                            (internalformat GLenum)
+                                            (width GLsizei)
+                                            (height GLsizei)
+                                            -> void)
+  "Create and initialize a renderbuffer object's data store.")
+
+(define-gl-procedure (glFramebufferRenderbuffer (target GLenum)
+                                                (attachment GLenum)
+                                                (renderbuffertarget GLenum)
+                                                (renderbuffer GLuint)
+                                                -> void)
+  "Attach a renderbuffer object to a framebuffer object.")
+
+(export glGenFramebuffers
+        glDeleteFramebuffers
+        glBindFramebuffer
+        glFramebufferTexture2D
+        glCheckFramebufferStatus
+        glGenRenderbuffers
+        glDeleteRenderbuffers
+        glBindRenderbuffer
+        glRenderbufferStorage
+        glFramebufferRenderbuffer)
+
+\f
+;;;
+;;; Shaders
+;;;
+
+(define-gl-procedure (glUniform1ui (location GLint)
+                                   (v0 GLuint)
+                                   -> void)
+  "Specify the value of a uniform variable for the current program object")
+
+(export (glUniform1ui . gl-uniform1ui))
+
+(re-export (%glUseProgram . gl-use-program)
+           (%glDeleteProgram .  gl-delete-program)
+           (%glDetachShader .  gl-detach-shader)
+           (%glLinkProgram .  gl-link-program)
+           (%glBindAttribLocation .  gl-bind-attrib-location)
+           (%glAttachShader .  gl-attach-shader)
+           (%glGetAttribLocation .  gl-get-attrib-location)
+           (%glGetUniformLocation .  gl-get-uniform-location)
+           (%glCreateProgram .  gl-create-program)
+           (%glGetProgramInfoLog .  gl-get-program-info-log)
+           (%glGetProgramiv .  gl-get-programiv)
+           (%glDeleteProgram .  gl-delete-program)
+           (%glDeleteShader .  gl-delete-shader)
+           (%glGetShaderiv .  gl-get-shaderiv)
+           (%glGetShaderInfoLog .  gl-get-shader-info-log)
+           (%glCompileShader .  gl-compile-shader)
+           (%glShaderSource .  gl-shader-source)
+           (%glCreateShader .  gl-create-shader)
+           (%glGetActiveUniform . gl-get-active-uniform)
+           (%glGetActiveAttrib . gl-get-active-attrib)
+           (%glUniform1i .  gl-uniform1i)
+           (%glUniform2i .  gl-uniform2i)
+           (%glUniform3i .  gl-uniform3i)
+           (%glUniform4i .  gl-uniform4i)
+           (%glUniform1f . gl-uniform1f)
+           (%glUniform2f .  gl-uniform2f)
+           (%glUniform3f . gl-uniform3f)
+           (%glUniform4f .  gl-uniform4f)
+           (%glUniformMatrix4fv . gl-uniform-matrix4fv)
+           (%glUniform4f .  gl-uniform4f))
diff --git a/chickadee/render/gpu.scm b/chickadee/render/gpu.scm
new file mode 100644 (file)
index 0000000..dde8a69
--- /dev/null
@@ -0,0 +1,64 @@
+;;; Chickadee Game Toolkit
+;;; Copyright © 2016 David Thompson <davet@gnu.org>
+;;;
+;;; Chickadee is free software: you can redistribute it and/or modify
+;;; it under the terms of the GNU General Public License as published
+;;; by the Free Software Foundation, either version 3 of the License,
+;;; or (at your option) any later version.
+;;;
+;;; Chickadee 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 General Public License
+;;; along with this program.  If not, see
+;;; <http://www.gnu.org/licenses/>.
+
+(define-module (chickadee render gpu)
+  #:use-module (oop goops)
+  #:use-module (srfi srfi-9)
+  #:export (make-gpu-state
+            gpu-state-ref
+            gpu-state-set!
+
+            gpu-finalize
+            gpu-guard
+            gpu-reap!))
+
+\f
+;;;
+;;; GPU state
+;;;
+
+(define-record-type <gpu-state>
+  (make-gpu-state bind value)
+  gpu-state?
+  (bind gpu-state-bind)
+  (value gpu-state-ref %gpu-state-set!))
+
+(define (gpu-state-set! state new-value)
+  (unless (eq? new-value (gpu-state-ref state))
+    ((gpu-state-bind state) new-value)
+    (%gpu-state-set! state new-value)))
+
+;;;
+;;; GPU finalizers
+;;;
+
+(define-generic gpu-finalize)
+
+(define *gpu-guardian* (make-guardian))
+
+(define (gpu-guard obj)
+  "Protect OBJ for the garbage collector until OBJ has been deleted
+from the GPU's memory."
+  (*gpu-guardian* obj)
+  obj)
+
+(define (gpu-reap!)
+  "Delete all GPU objects that are no longer being referenced."
+  (let loop ((obj (*gpu-guardian*)))
+    (when obj
+      (gpu-finalize obj)
+      (loop (*gpu-guardian*)))))
diff --git a/chickadee/render/shader.scm b/chickadee/render/shader.scm
new file mode 100644 (file)
index 0000000..5e8afc9
--- /dev/null
@@ -0,0 +1,346 @@
+;;; Chickadee Game Toolkit
+;;; Copyright © 2016 David Thompson <davet@gnu.org>
+;;;
+;;; Chickadee is free software: you can redistribute it and/or modify
+;;; it under the terms of the GNU General Public License as published
+;;; by the Free Software Foundation, either version 3 of the License,
+;;; or (at your option) any later version.
+;;;
+;;; Chickadee 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 General Public License
+;;; along with this program.  If not, see
+;;; <http://www.gnu.org/licenses/>.
+
+(define-module (chickadee render shader)
+  #:use-module (ice-9 rdelim)
+  #:use-module (ice-9 match)
+  #:use-module (oop goops)
+  #:use-module (system foreign)
+  #:use-module (rnrs bytevectors)
+  #:use-module (rnrs io ports)
+  #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-4)
+  #:use-module (srfi srfi-9)
+  #:use-module (srfi srfi-9 gnu)
+  #:use-module (gl)
+  #:use-module (chickadee color)
+  #:use-module (chickadee math matrix)
+  #:use-module (chickadee math vector)
+  #:use-module (chickadee render gl)
+  #:use-module (chickadee render gpu)
+  #:use-module (chickadee render texture)
+  #:export (make-shader
+            shader?
+            null-shader
+            load-shader
+            strings->shader
+            shader-uniform
+            shader-uniforms
+            uniform?
+            uniform-name
+            uniform-value
+            uniform-default-value
+            set-uniform-value!
+            *shader-state*))
+
+(define-record-type <shader>
+  (%make-shader id attributes uniforms)
+  shader?
+  (id shader-id)
+  (attributes shader-attributes)
+  (uniforms shader-uniforms))
+
+(define-record-type <uniform>
+  (make-uniform name location type value setter)
+  uniform?
+  (name uniform-name)
+  (location uniform-location)
+  (type uniform-type)
+  (value uniform-value %set-uniform-value!)
+  (setter uniform-setter))
+
+(define-record-type <attribute>
+  (make-attribute name location type)
+  attribute?
+  (name attribute-name)
+  (location attribute-location)
+  (type attribute-type))
+
+(define null-shader (%make-shader 0 (make-hash-table) (make-hash-table)))
+
+(define <<shader>> (class-of null-shader))
+
+(define-method (gpu-finalize (shader <<shader>>))
+  (gl-delete-program (shader-id shader)))
+
+(define (apply-shader shader)
+  (gl-use-program (shader-id shader)))
+
+(define *shader-state* (make-gpu-state apply-shader null-shader))
+
+(define (shader-compiled? id)
+  (let ((status (make-u32vector 1)))
+    (gl-get-shaderiv id (version-2-0 compile-status)
+                     (bytevector->pointer status))
+    (= (u32vector-ref status 0) 1)))
+
+(define (shader-linked? id)
+  (let ((status (make-u32vector 1)))
+    (gl-get-programiv id (version-2-0 link-status)
+                      (bytevector->pointer status))
+    (= (u32vector-ref status 0) 1)))
+
+(define (info-log length-proc log-proc id)
+  (let ((log-length-bv (make-u32vector 1)))
+    (length-proc id (version-2-0 info-log-length)
+                 (bytevector->pointer log-length-bv))
+    (u32vector-ref log-length-bv 0)
+    ;; Add one byte to account for the null string terminator.
+    (let* ((log-length (u32vector-ref log-length-bv 0))
+           (log (make-u8vector (1+ log-length))))
+      (log-proc id log-length %null-pointer (bytevector->pointer log))
+      (utf8->string log))))
+
+(define (compilation-error id)
+  (info-log gl-get-shaderiv gl-get-shader-info-log id))
+
+(define (linking-error id)
+  (info-log gl-get-programiv gl-get-program-info-log id))
+
+(define (uniform-count id)
+  (let ((bv (make-u32vector 1)))
+    (gl-get-programiv id
+                      (arb-shader-objects active-uniforms)
+                      (bytevector->pointer bv))
+    (u32vector-ref bv 0)))
+
+(define (utf8->string* bv length)
+  (let ((bv* (make-bytevector length)))
+    (bytevector-copy! bv 0 bv* 0 length)
+    (utf8->string bv*)))
+
+(define (set-boolean-uniform! location bool)
+  (gl-uniform1i location (if bool 1 0)))
+
+(define (set-integer-uniform! location n)
+  (gl-uniform1i location n))
+
+(define (set-unsigned-integer-uniform! location n)
+  (gl-uniform1ui location n))
+
+(define (set-float-uniform! location n)
+  (gl-uniform1f location n))
+
+(define (set-float-vector2-uniform! location v)
+  (gl-uniform2f location (vx v) (vy v)))
+
+(define (set-float-vector3-uniform! location v)
+  (gl-uniform3f location (vx v) (vy v) (vz v)))
+
+(define (set-float-vector4-uniform! location v)
+  (if (color? v)
+      (gl-uniform4f location
+                    (color-r v)
+                    (color-g v)
+                    (color-b v)
+                    (color-a v))
+      (gl-uniform4f location (vx v) (vy v) (vz v) (vw v))))
+
+(define (set-integer-vector2-uniform! location v)
+  (gl-uniform2i location (vx v) (vy v)))
+
+(define (set-integer-vector3-uniform! location v)
+  (gl-uniform3i location (vx v) (vy v) (vz v)))
+
+(define (set-integer-vector4-uniform! location v)
+  (gl-uniform4i location (vx v) (vy v) (vz v) (vw v)))
+
+(define (set-float-matrix4-uniform! location m)
+  (gl-uniform-matrix4fv location 1 #f
+                        ((@@ (chickadee math matrix) matrix4-ptr) m)))
+
+(define (set-sampler-2d-uniform! location texture-unit)
+  (gl-uniform1i location texture-unit))
+
+(define (gl-type->symbol type)
+  (cond
+   ((= type (version-2-0 bool)) 'bool)
+   ((= type (data-type int)) 'int)
+   ((= type (data-type unsigned-int)) 'unsigned-int)
+   ((= type (data-type float)) 'float)
+   ((= type (version-2-0 float-vec2)) 'float-vec2)
+   ((= type (version-2-0 float-vec3)) 'float-vec3)
+   ((= type (version-2-0 float-vec4)) 'float-vec4)
+   ((= type (version-2-0 int-vec2)) 'int-vec2)
+   ((= type (version-2-0 int-vec3)) 'int-vec3)
+   ((= type (version-2-0 int-vec4)) 'int-vec4)
+   ((= type (version-2-0 float-mat4)) 'mat4)
+   ((= type (version-2-0 sampler-2d)) 'sampler-2d)
+   (else
+    (error "unsupported OpenGL type" type))))
+
+(define %default-mat4 (make-identity-matrix4))
+
+(define (default-uniform-value type)
+  (match type
+    ('bool #f)
+    ('int 0)
+    ('unsigned-int 0)
+    ('float 0.0)
+    ('float-vec2 (vector2 0.0 0.0))
+    ('float-vec3 (vector3 0.0 0.0 0.0))
+    ('float-vec4 (vector4 0.0 0.0 0.0 0.0))
+    ('int-vec2 (vector2 0 0))
+    ('int-vec3 (vector3 0 0 0))
+    ('int-vec4 (vector4 0 0 0 0))
+    ('sampler-2d 0)
+    ('mat4 %default-mat4)))
+
+(define (uniform-setter-for-type type)
+  ;; TODO: Handle more data types, notably matrices.
+  (match type
+    ('bool set-boolean-uniform!)
+    ('int set-integer-uniform!)
+    ('unsigned-int set-unsigned-integer-uniform!)
+    ('float set-float-uniform!)
+    ('float-vec2 set-float-vector2-uniform!)
+    ('float-vec3 set-float-vector3-uniform!)
+    ('float-vec4 set-float-vector4-uniform!)
+    ('int-vec2 set-integer-vector2-uniform!)
+    ('int-vec3 set-integer-vector3-uniform!)
+    ('int-vec4 set-integer-vector4-uniform!)
+    ('mat4 set-float-matrix4-uniform!)
+    ('sampler-2d set-sampler-2d-uniform!)))
+
+(define (extract-uniforms id)
+  (let ((total (uniform-count id))
+        (table (make-hash-table)))
+    (let loop ((i 0))
+      (unless (= i total)
+        (let ((length-bv (make-u32vector 1))
+              (size-bv (make-u32vector 1))
+              (type-bv (make-u32vector 1))
+              (name-bv (make-bytevector 255)))
+          (gl-get-active-uniform id i
+                                 (bytevector-length name-bv)
+                                 (bytevector->pointer length-bv)
+                                 (bytevector->pointer size-bv)
+                                 (bytevector->pointer type-bv)
+                                 (bytevector->pointer name-bv))
+          (let* ((length (u32vector-ref length-bv 0))
+                 (name (utf8->string* name-bv length))
+                 (location (gl-get-uniform-location id name))
+                 (size (u32vector-ref size-bv 0))
+                 (type (gl-type->symbol (u32vector-ref type-bv 0)))
+                 (default (default-uniform-value type))
+                 (setter (uniform-setter-for-type type)))
+            ;; TODO: Handle uniform arrays.
+            (unless (= size 1)
+              (error "unsupported uniform size" name size))
+
+            (unless (eq? type 'sampler-2d)
+              (hash-set! table
+                         name
+                         (make-uniform name location type default setter)))))
+        (loop (1+ i))))
+    table))
+
+(define (attribute-count id)
+  (let ((bv (make-u32vector 1)))
+    (gl-get-programiv id
+                      (arb-shader-objects active-attributes)
+                      (bytevector->pointer bv))
+    (u32vector-ref bv 0)))
+
+(define (extract-attributes id)
+  (let ((total (attribute-count id))
+        (table (make-hash-table)))
+    (let loop ((i 0))
+      (unless (= i total)
+        (let ((length-bv (make-u32vector 1))
+              (size-bv (make-u32vector 1))
+              (type-bv (make-u32vector 1))
+              (name-bv (make-bytevector 255)))
+          (gl-get-active-attrib id i
+                                (bytevector-length name-bv)
+                                (bytevector->pointer length-bv)
+                                (bytevector->pointer size-bv)
+                                (bytevector->pointer type-bv)
+                                (bytevector->pointer name-bv))
+          (let* ((length (u32vector-ref length-bv 0))
+                 (name (utf8->string* name-bv length))
+                 (size (u32vector-ref size-bv 0))
+                 (type (gl-type->symbol (u32vector-ref type-bv 0)))
+                 (location (gl-get-attrib-location id name)))
+            (unless (= size 1)
+              (error "unsupported attribute size" name size))
+
+            (hash-set! table name (make-attribute name location type))))
+        (loop (1+ i))))
+    table))
+
+(define (make-shader vertex-port fragment-port)
+  (define (make-shader-stage type port)
+    (let ((id (gl-create-shader type))
+          (source (get-bytevector-all port)))
+      (gl-shader-source id 1
+                        (bytevector->pointer
+                         (u64vector
+                          (pointer-address (bytevector->pointer source))))
+                        (bytevector->pointer
+                         (u32vector (bytevector-length source))))
+      (gl-compile-shader id)
+      (unless (shader-compiled? id)
+        (let ((error-log (compilation-error id)))
+          (gl-delete-shader id) ; clean up GPU resource.
+          (error "failed to compile shader" error-log)))
+      id))
+
+  (let ((vertex-id (make-shader-stage (version-2-0 vertex-shader)
+                                      vertex-port))
+        (fragment-id (make-shader-stage (version-2-0 fragment-shader)
+                                        fragment-port))
+        (id (gl-create-program)))
+    (gl-attach-shader id vertex-id)
+    (gl-attach-shader id fragment-id)
+    (gl-link-program id)
+    (unless (shader-linked? id)
+      (let ((error-log (linking-error id)))
+        (gl-delete-program id)
+        (error "failed to link shader" error-log)))
+    (gl-delete-shader vertex-id)
+    (gl-delete-shader fragment-id)
+    (gpu-guard (%make-shader id (extract-attributes id) (extract-uniforms id)))))
+
+(define (load-shader vertex-source-file fragment-source-file)
+  (call-with-input-file vertex-source-file
+    (lambda (vertex-port)
+      (call-with-input-file fragment-source-file
+        (lambda (fragment-port)
+          (make-shader vertex-port fragment-port))))))
+
+(define (strings->shader vertex-source fragment-source)
+  (call-with-input-string vertex-source
+    (lambda (vertex-port)
+      (call-with-input-string fragment-source
+        (lambda (fragment-port)
+          (make-shader vertex-port fragment-port))))))
+
+(define (shader-uniform shader name)
+  (let ((uniform (hash-ref (shader-uniforms shader) name)))
+    (or uniform (error "no such uniform" name))))
+
+(define (set-uniform-value! uniform x)
+  "Change the value of UNIFORM to X.  This procedure assumes that the
+shader where UNIFORM is defined is currently bound in the OpenGL
+context.  The behavior of this procedure under any other circumstance
+is undefined."
+  ((uniform-setter uniform) (uniform-location uniform) x)
+  (%set-uniform-value! uniform x))
+
+(define (uniform-default-value uniform)
+  (default-uniform-value (uniform-type uniform)))
diff --git a/chickadee/render/shapes.scm b/chickadee/render/shapes.scm
new file mode 100644 (file)
index 0000000..52e2613
--- /dev/null
@@ -0,0 +1,205 @@
+;;; Chickadee Game Toolkit
+;;; Copyright © 2016 David Thompson <davet@gnu.org>
+;;;
+;;; Chickadee is free software: you can redistribute it and/or modify
+;;; it under the terms of the GNU General Public License as published
+;;; by the Free Software Foundation, either version 3 of the License,
+;;; or (at your option) any later version.
+;;;
+;;; Chickadee 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 General Public License
+;;; along with this program.  If not, see
+;;; <http://www.gnu.org/licenses/>.
+
+;;; Commentary
+;;
+;; Polylines as described in
+;; http://jcgt.org/published/0002/02/08/paper.pdf
+;;
+;;; Code:
+
+(define-module (chickadee render shapes)
+  #:use-module (ice-9 match)
+  #:use-module (srfi srfi-4)
+  #:use-module (chickadee math matrix)
+  #:use-module (chickadee math vector)
+  #:use-module (chickadee render)
+  #:use-module (chickadee color)
+  #:use-module (chickadee render shader)
+  #:use-module (chickadee render vertex-buffer)
+  #:export (draw-line
+            draw-rectangle-outline))
+
+(define draw-line
+  (let* ((vertex-buffer
+          (delay (make-streaming-vertex-buffer 'vec2 4)))
+         (texcoord-buffer
+          (delay (make-streaming-vertex-buffer 'vec2 4)))
+         (index-buffer
+          (delay (make-vertex-buffer 'index 'static (u32vector 0 3 2 0 2 1))))
+         (vertex-array
+          (delay (make-vertex-array (force index-buffer)
+                                    (force vertex-buffer)
+                                    (force texcoord-buffer))))
+         (default-shader
+           (delay
+             (strings->shader
+              "
+#version 330
+
+in vec2 position;
+in vec2 tex;
+out vec2 frag_tex;
+uniform mat4 projection;
+
+void main(void) {
+    frag_tex = tex;
+    gl_Position = projection * vec4(position.xy, 0.0, 1.0);
+}
+"
+              "
+#version 330
+
+in vec2 frag_tex;
+uniform vec4 color;
+uniform float r;
+uniform float w;
+uniform float t;
+uniform float l;
+uniform int cap;
+float infinity = 1.0 / 0.0;
+
+void main (void) {
+  float hw = w / 2.0;
+  float u = frag_tex.x;
+  float v = frag_tex.y;
+  float dx;
+  float dy;
+  float d;
+
+  if (u < 0 || u > l) {
+    if (u < 0) {
+      dx = abs(u);
+    } else {
+      dx = u - l;
+    }
+    dy = abs(v);
+
+    switch (cap) {
+    // none
+    case 0:
+      d = infinity;
+      break;
+    // butt
+    case 1:
+      d = max(dx + w / 2 - 2 * r, dy);
+      break;
+    // square
+    case 2:
+      d = max(dx, dy);
+      break;
+    // round
+    case 3:
+      d = sqrt(dx * dx + dy * dy);
+      break;
+    // triangle out
+    case 4:
+      d = dx + dy;
+      break;
+    // triangle in
+    case 5:
+      d = max(dy, w / 2 - r + dx - dy);
+      break;
+    }
+  } else {
+    d = abs(v);
+  }
+
+  if (d <= hw) {
+    gl_FragColor = color;
+  } else {
+    gl_FragColor = vec4(color.rgb, color.a * (1.0 - ((d - hw) / r)));
+  }
+}
+"))))
+    (lambda* (x1 y1 x2 y2 #:key
+                 (thickness 1.0)
+                 (feather 1.0)
+                 (cap 'round)
+                 (color white)
+                 (shader (force default-shader)))
+      (let* ((dx (- x2 x1))
+             (dy (- y2 y1))
+             (length (sqrt (+ (expt dx 2) (expt dy 2))))
+             (padding (/ (ceiling (+ thickness (* feather 2.5))) 2.0))
+             (nx (/ dx length))
+             (ny (/ dy length))
+             (xpad (* nx padding))
+             (ypad (* ny padding))
+             ;; start left
+             (vx1 (+ (- x1 xpad) ypad))
+             (vy1 (+ (- y1 ypad) (- xpad)))
+             (s1 (- padding))
+             (t1 padding)
+             ;; start right
+             (vx2 (+ (- x1 xpad) (- ypad)))
+             (vy2 (+ (- y1 ypad) xpad))
+             (s2 (- padding))
+             (t2 (- padding))
+             ;; end left
+             (vx3 (+ x2 xpad (- ypad)))
+             (vy3 (+ y2 ypad xpad))
+             (s3 (+ length padding))
+             (t3 (- padding))
+             ;; end right
+             (vx4 (+ (+ x2 xpad) ypad))
+             (vy4 (+ (+ y2 ypad) (- xpad)))
+             (s4 (+ length padding))
+             (t4 padding))
+        (with-mapped-vertex-buffer (force vertex-buffer)
+          (let ((bv (vertex-buffer-data (force vertex-buffer))))
+            (f32vector-set! bv 0 vx1)
+            (f32vector-set! bv 1 vy1)
+            (f32vector-set! bv 2 vx2)
+            (f32vector-set! bv 3 vy2)
+            (f32vector-set! bv 4 vx3)
+            (f32vector-set! bv 5 vy3)
+            (f32vector-set! bv 6 vx4)
+            (f32vector-set! bv 7 vy4)))
+        (with-mapped-vertex-buffer (force texcoord-buffer)
+          (let ((bv (vertex-buffer-data (force texcoord-buffer))))
+            (f32vector-set! bv 0 s1)
+            (f32vector-set! bv 1 t1)
+            (f32vector-set! bv 2 s2)
+            (f32vector-set! bv 3 t2)
+            (f32vector-set! bv 4 s3)
+            (f32vector-set! bv 5 t3)
+            (f32vector-set! bv 6 s4)
+            (f32vector-set! bv 7 t4)))
+        (with-blend-mode 'alpha
+          (gpu-apply shader (force vertex-array)
+                     #:projection (current-projection)
+                     #:color color
+                     #:w thickness
+                     #:r feather
+                     #:l length
+                     #:cap (match cap
+                             ('none 0)
+                             ('butt 1)
+                             ('square 2)
+                             ('round 3)
+                             ('triangle-out 4)
+                             ('triangle-in 5))))))))
+
+;; TODO: Use an outline polygon instead of rendering a bunch of lines.
+(define* (draw-rectangle-outline left bottom right top #:key
+                                 (thickness 1.0)
+                                 (color white))
+  (draw-line left bottom right bottom #:thickness thickness #:color color)
+  (draw-line right bottom right top #:thickness thickness #:color color)
+  (draw-line right top left top #:thickness thickness #:color color)
+  (draw-line left top left bottom #:thickness thickness #:color color))
diff --git a/chickadee/render/sprite.scm b/chickadee/render/sprite.scm
new file mode 100644 (file)
index 0000000..b23130a
--- /dev/null
@@ -0,0 +1,282 @@
+;;; Chickadee Game Toolkit
+;;; Copyright © 2016 David Thompson <davet@gnu.org>
+;;;
+;;; Chickadee is free software: you can redistribute it and/or modify
+;;; it under the terms of the GNU General Public License as published
+;;; by the Free Software Foundation, either version 3 of the License,
+;;; or (at your option) any later version.
+;;;
+;;; Chickadee 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 General Public License
+;;; along with this program.  If not, see
+;;; <http://www.gnu.org/licenses/>.
+
+(define-module (chickadee render sprite)
+  #:use-module (srfi srfi-4)
+  #:use-module (srfi srfi-9)
+  #:use-module (srfi srfi-11)
+  #:use-module (chickadee math matrix)
+  #:use-module (chickadee math vector)
+  #:use-module (chickadee render)
+  #:use-module (chickadee render shader)
+  #:use-module (chickadee render texture)
+  #:use-module (chickadee render vertex-buffer)
+  #:export (draw-sprite
+            with-batched-sprites))
+
+(define default-shader
+  (delay
+    (strings->shader
+     "
+#version 330
+
+in vec2 position;
+in vec2 tex;
+out vec2 frag_tex;
+uniform mat4 mvp;
+
+void main(void) {
+    frag_tex = tex;
+    gl_Position = mvp * vec4(position.xy, 0.0, 1.0);
+}
+"
+     "
+#version 330
+
+in vec2 frag_tex;
+uniform sampler2D color_texture;
+
+void main (void) {
+    gl_FragColor = texture2D(color_texture, frag_tex);
+}
+")))
+
+(define draw-sprite-unbatched
+  (let* ((vertex-buffer
+          (delay (make-streaming-vertex-buffer 'vec2 4)))
+         (texcoord-buffer
+          (delay (make-streaming-vertex-buffer 'vec2 4)))
+         (index-buffer
+          (delay (make-vertex-buffer 'index 'static (u32vector 0 3 2 0 2 1))))
+         (vertex-array
+          (delay (make-vertex-array (force index-buffer)
+                                    (force vertex-buffer)
+                                    (force texcoord-buffer))))
+         (tmp-matrix (make-null-matrix4))
+         (mvp (make-null-matrix4)))
+    (lambda (texture position center width height
+                     scale rotation blend-mode shader
+                     s1 t1 s2 t2)
+      (with-mapped-vertex-buffer (force vertex-buffer)
+        (let* ((x1 (- (vx center)))
+               (y1 (- (vy center)))
+               (x2 (+ x1 width))
+               (y2 (+ y1 height))
+               (bv (vertex-buffer-data (force vertex-buffer))))
+          (f32vector-set! bv 0 x1)
+          (f32vector-set! bv 1 y1)
+          (f32vector-set! bv 2 x2)
+          (f32vector-set! bv 3 y1)
+          (f32vector-set! bv 4 x2)
+          (f32vector-set! bv 5 y2)
+          (f32vector-set! bv 6 x1)
+          (f32vector-set! bv 7 y2)))
+      (with-mapped-vertex-buffer (force texcoord-buffer)
+        (let ((bv (vertex-buffer-data (force texcoord-buffer))))
+          (f32vector-set! bv 0 s1)
+          (f32vector-set! bv 1 t1)
+          (f32vector-set! bv 2 s2)
+          (f32vector-set! bv 3 t1)
+          (f32vector-set! bv 4 s2)
+          (f32vector-set! bv 5 t2)
+          (f32vector-set! bv 6 s1)
+          (f32vector-set! bv 7 t2)))
+      (matrix4-identity! mvp)
+      (when rotation
+        (matrix4-rotate-z! tmp-matrix rotation)
+        (matrix4-mult! mvp mvp tmp-matrix))
+      (when scale
+        (matrix4-scale! tmp-matrix scale)
+        (matrix4-mult! mvp mvp tmp-matrix))
+      (matrix4-translate! tmp-matrix position)
+      (matrix4-mult! mvp mvp tmp-matrix)
+      (matrix4-mult! mvp mvp (current-projection))
+      (with-blend-mode blend-mode
+        (with-texture texture
+          (gpu-apply shader (force vertex-array) #:mvp mvp))))))
+
+\f
+;;;
+;;; Sprite Batch
+;;;
+
+(define-record-type <sprite-batch>
+  (%make-sprite-batch texture blend-mode shader size capacity index-buffer
+                      position-buffer texture-buffer vertex-array)
+  sprite-batch?
+  (texture sprite-batch-texture set-sprite-batch-texture!)
+  (blend-mode sprite-batch-blend-mode set-sprite-batch-blend-mode!)
+  (shader sprite-batch-shader set-sprite-batch-shader!)
+  (size sprite-batch-size set-sprite-batch-size!)
+  (capacity sprite-batch-capacity)
+  (index-buffer sprite-batch-index-buffer)
+  (position-buffer sprite-batch-position-buffer)
+  (texture-buffer sprite-batch-texture-buffer)
+  (vertex-array sprite-batch-vertex-array))
+
+(define (make-sprite-batch capacity)
+  "Make a sprite batch that can hold CAPACITY sprites."
+  (let* ((index (make-streaming-vertex-buffer 'index (* capacity 6)))
+         (pos (make-streaming-vertex-buffer 'vec2  (* capacity 4)))
+         (tex (make-streaming-vertex-buffer 'vec2  (* capacity 4)))
+         (va (make-vertex-array index pos tex)))
+    (%make-sprite-batch #f #f #f 0 capacity index pos tex va)))
+
+(define (sprite-batch-full? batch)
+  (= (sprite-batch-capacity batch) (sprite-batch-size batch)))
+
+(define (double-sprite-batch-size! batch)
+  #f)
+
+(define (sprite-batch-reset! batch)
+  "Reset BATCH to size 0."
+  (set-sprite-batch-texture! batch #f)
+  (set-sprite-batch-blend-mode! batch #f)
+  (set-sprite-batch-shader! batch #f)
+  (set-sprite-batch-size! batch 0))
+
+(define (sprite-batch-begin! batch)
+  (map-vertex-buffer! (sprite-batch-index-buffer batch))
+  (map-vertex-buffer! (sprite-batch-position-buffer batch))
+  (map-vertex-buffer! (sprite-batch-texture-buffer batch)))
+
+(define (sprite-batch-flush! batch)
+  "Render the contents of BATCH and clear the cache."
+  (unless (zero? (sprite-batch-size batch))
+    (with-blend-mode (sprite-batch-blend-mode batch)
+      (with-texture (sprite-batch-texture batch)
+        (unmap-vertex-buffer! (sprite-batch-index-buffer batch))
+        (unmap-vertex-buffer! (sprite-batch-position-buffer batch))
+        (unmap-vertex-buffer! (sprite-batch-texture-buffer batch))
+        (gpu-apply* (sprite-batch-shader batch)
+                    (sprite-batch-vertex-array batch)
+                    (* (sprite-batch-size batch) 6)
+                    #:mvp (current-projection))
+        (sprite-batch-reset! batch)))))
+
+(define sprite-batch-add!
+  (let ((tmp-matrix (make-null-matrix4))
+        (matrix (make-null-matrix4)))
+    (lambda (batch texture position center width height
+                   scale rotation blend-mode shader s1 t1 s2 t2)
+      ;; Expand the buffers when necessary.
+      (when (sprite-batch-full? batch)
+        (double-sprite-batch-size! batch))
+      ;; Flush the batch if any GL state needs changing.
+      (unless (and (eq? (sprite-batch-texture batch) texture)
+                   (eq? (sprite-batch-blend-mode batch) blend-mode)
+                   (eq? (sprite-batch-shader batch) shader))
+        (sprite-batch-flush! batch)
+        (sprite-batch-begin! batch)
+        (set-sprite-batch-texture! batch texture)
+        (set-sprite-batch-blend-mode! batch blend-mode)
+        (set-sprite-batch-shader! batch shader))
+      (let ((size (sprite-batch-size batch)))
+        (let* ((index-offset (* size 6))
+               (index-vertex-offset (* size 4))
+               (vertex-offset (* size 8)) ;; 4 vertices, 2 floats per vertex
+               (texture-offset (* size 8))
+               (indices (vertex-buffer-data (sprite-batch-index-buffer batch)))
+               (vertices (vertex-buffer-data (sprite-batch-position-buffer batch)))
+               (texcoords (vertex-buffer-data (sprite-batch-texture-buffer batch)))
+               (local-x1 (- (vx center)))
+               (local-y1 (- (vy center)))
+               (local-x2 (+ local-x1 width))
+               (local-y2 (+ local-y1 height)))
+          (matrix4-identity! matrix)
+          (when rotation
+            (matrix4-rotate-z! tmp-matrix rotation)
+            (matrix4-mult! matrix matrix tmp-matrix))
+          (when scale
+            (matrix4-scale! tmp-matrix scale)
+            (matrix4-mult! matrix matrix tmp-matrix))
+          (matrix4-translate! tmp-matrix position)
+          (matrix4-mult! matrix matrix tmp-matrix)
+          (let-values (((world-x1 world-y1)
+                        (transform matrix local-x1 local-y1))
+                       ((world-x2 world-y2)
+                        (transform matrix local-x2 local-y2)))
+            ;; Add indices.
+            (u32vector-set! indices index-offset index-vertex-offset)
+            (u32vector-set! indices (+ index-offset 1) (+ index-vertex-offset 3))
+            (u32vector-set! indices (+ index-offset 2) (+ index-vertex-offset 2))
+            (u32vector-set! indices (+ index-offset 3) index-vertex-offset)
+            (u32vector-set! indices (+ index-offset 4) (+ index-vertex-offset 2))
+            (u32vector-set! indices (+ index-offset 5) (+ index-vertex-offset 1))
+            ;; Add vertices.
+            ;; Bottom-left
+            (f32vector-set! vertices vertex-offset world-x1)
+            (f32vector-set! vertices (+ vertex-offset 1) world-y1)
+            ;; Bottom-right
+            (f32vector-set! vertices (+ vertex-offset 2) world-x2)
+            (f32vector-set! vertices (+ vertex-offset 3) world-y1)
+            ;; Top-right
+            (f32vector-set! vertices (+ vertex-offset 4) world-x2)
+            (f32vector-set! vertices (+ vertex-offset 5) world-y2)
+            ;; Top-left
+            (f32vector-set! vertices (+ vertex-offset 6) world-x1)
+            (f32vector-set! vertices (+ vertex-offset 7) world-y2)
+            ;; Add texture coordinates.
+            ;; Bottom-left
+            (f32vector-set! texcoords texture-offset s1)
+            (f32vector-set! texcoords (+ texture-offset 1) t1)
+            ;; Bottom-right
+            (f32vector-set! texcoords (+ texture-offset 2) s2)
+            (f32vector-set! texcoords (+ texture-offset 3) t1)
+            ;; Top-right
+            (f32vector-set! texcoords (+ texture-offset 4) s2)
+            (f32vector-set! texcoords (+ texture-offset 5) t2)
+            ;; Top-left
+            (f32vector-set! texcoords (+ texture-offset 6) s1)
+            (f32vector-set! texcoords (+ texture-offset 7) t2)
+            (set-sprite-batch-size! batch (1+ size))))))))
+
+(define *batch?* #f)
+(define %batch (delay (make-sprite-batch 256)))
+
+(define (draw-sprite-batched texture position center width height
+                             scale rotation blend-mode shader
+                             s1 t1 s2 t2)
+  (sprite-batch-add! (force %batch) texture position center width height
+                     scale rotation blend-mode shader
+                     s1 t1 s2 t2))
+
+(define-syntax-rule (with-batched-sprites body ...)
+  (dynamic-wind
+    (lambda ()
+      (set! *batch?* #t))
+    (lambda ()
+      (sprite-batch-reset! (force %batch))
+      body ...
+      (sprite-batch-flush! (force %batch)))
+    (lambda ()
+      (set! *batch?* #f))))
+
+(define* (draw-sprite texture position #:key
+                      (center (vector2 0 0))
+                      (width (texture-width texture))
+                      (height (texture-height texture))
+                      scale rotation (blend-mode 'alpha)
+                      (s1 0.0) (t1 0.0) (s2 1.0) (t2 1.0)
+                      (shader (force default-shader)))
+  (if *batch?*
+      (draw-sprite-batched texture position center width height
+                           scale rotation blend-mode shader
+                           s1 t1 s2 t2 )
+      (draw-sprite-unbatched texture position center width height
+                             scale rotation blend-mode shader
+                             s1 t1 s2 t2)))
diff --git a/chickadee/render/texture.scm b/chickadee/render/texture.scm
new file mode 100644 (file)
index 0000000..ef55dca
--- /dev/null
@@ -0,0 +1,191 @@
+;;; Chickadee Game Toolkit
+;;; Copyright © 2016 David Thompson <davet@gnu.org>
+;;;
+;;; Chickadee is free software: you can redistribute it and/or modify
+;;; it under the terms of the GNU General Public License as published
+;;; by the Free Software Foundation, either version 3 of the License,
+;;; or (at your option) any later version.
+;;;
+;;; Chickadee 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 General Public License
+;;; along with this program.  If not, see
+;;; <http://www.gnu.org/licenses/>.
+
+(define-module (chickadee render texture)
+  #:use-module (ice-9 format)
+  #:use-module (ice-9 match)
+  #:use-module (rnrs bytevectors)
+  #:use-module (srfi srfi-9)
+  #:use-module (srfi srfi-9 gnu)
+  #:use-module (gl)
+  #:use-module ((gl enums)
+                #:select (texture-min-filter texture-mag-filter)
+                #:prefix gl:)
+  #:use-module ((sdl2 image) #:prefix sdl-image:)
+  #:use-module (sdl2 surface)
+  #:use-module (oop goops)
+  #:use-module (chickadee render gl)
+  #:use-module (chickadee render gpu)
+  #:export (make-texture
+            load-image
+            texture?
+            texture-null?
+            texture-id
+            texture-parent
+            texture-width
+            texture-height
+            texture-min-filter
+            texture-mag-filter
+            texture-wrap-s
+            texture-wrap-t
+            null-texture
+            *texture-state*))
+
+;;;
+;;; Textures
+;;;
+
+;; The <texture> object is a simple wrapper around an OpenGL texture
+;; id.
+(define-record-type <texture>
+  (%make-texture id width height min-filter mag-filter wrap-s wrap-t)
+  texture?
+  (id texture-id)
+  (width texture-width)
+  (height texture-height)
+  (min-filter texture-min-filter)
+  (mag-filter texture-mag-filter)
+  (wrap-s texture-wrap-s)
+  (wrap-t texture-wrap-t))
+
+(set-record-type-printer! <texture>
+  (lambda (texture port)
+    (format port
+            "#<texture width: ~d height: ~d min-filter: ~a mag-filter: ~a wrap-s: ~a wrap-t: ~a>"
+            (texture-width texture)
+            (texture-height texture)
+            (texture-min-filter texture)
+            (texture-mag-filter texture)
+            (texture-wrap-s texture)
+            (texture-wrap-t texture))))
+
+(define null-texture (%make-texture 0 0 0 'linear 'linear 'repeat 'repeat))
+
+(define <<texture>> (class-of null-texture))
+
+(define (texture-null? texture)
+  "Return #t if TEXTURE is the null texture."
+  (eq? texture null-texture))
+
+(define (free-texture texture)
+  (gl-delete-texture (texture-id texture)))
+
+(define-method (gpu-finalize (texture <<texture>>))
+  (free-texture texture))
+
+(define (apply-texture texture)
+  (gl-enable (enable-cap texture-2d))
+  (gl-bind-texture (texture-target texture-2d)
+                   (texture-id texture)))
+
+(define *texture-state* (make-gpu-state apply-texture null-texture))
+
+(define* (make-texture pixels width height #:key
+                       (min-filter 'linear)
+                       (mag-filter 'linear)
+                       (wrap-s 'repeat)
+                       (wrap-t 'repeat)
+                       (format 'rgba))
+  "Translate the bytevector PIXELS into an OpenGL texture with
+dimensions WIDTHxHEIGHT where each pixel is in 32-bit RGBA format.
+The generated texture uses MIN-FILTER for downscaling and MAG-FILTER
+for upscaling.  WRAP-S and WRAP-T are symbols that control how texture
+access is handled for texture coordinates outside the [0, 1] range.
+Allowed symbols are: repeat (the default), clamp, clamp-to-border,
+clamp-to-edge.  FORMAT specifies the pixel format.  Currently only
+32-bit RGBA format is supported."
+  (define (gl-wrap mode)
+    (match mode
+      ('repeat (texture-wrap-mode repeat))
+      ('clamp (texture-wrap-mode clamp))
+      ('clamp-to-border (texture-wrap-mode clamp-to-border-sgis))
+      ('clamp-to-edge (texture-wrap-mode clamp-to-edge-sgis))))
+
+  (let ((texture (gpu-guard
+                  (%make-texture (gl-generate-texture) width height
+                                 min-filter mag-filter wrap-s wrap-t))))
+    (gpu-state-set! *texture-state* texture)
+    (gl-texture-parameter (texture-target texture-2d)
+                          (texture-parameter-name texture-min-filter)
+                          (match min-filter
+                            ('nearest (gl:texture-min-filter nearest))
+                            ('linear (gl:texture-min-filter linear))))
+    (gl-texture-parameter (texture-target texture-2d)
+                          (texture-parameter-name texture-mag-filter)
+                          (match mag-filter
+                            ('nearest (gl:texture-mag-filter nearest))
+                            ('linear (gl:texture-mag-filter linear))))
+    (gl-texture-parameter (texture-target texture-2d)
+                          (texture-parameter-name texture-wrap-s)
+                          (gl-wrap wrap-s))
+    (gl-texture-parameter (texture-target texture-2d)
+                          (texture-parameter-name texture-wrap-t)
+                          (gl-wrap wrap-t))
+    (gl-texture-image-2d (texture-target texture-2d)
+                         0 (pixel-format rgba) width height 0
+                         (match format
+                           ('rgba (pixel-format rgba)))
+                         (color-pointer-type unsigned-byte)
+                         pixels)
+    texture))
+
+(define (flip-pixels-vertically pixels width height)
+  "Create a new bytevector that reverses the rows in PIXELS, a WIDTH x
+HEIGHT, 32 bit color bytevector."
+  (let ((buffer (make-u8vector (bytevector-length pixels)))
+        (row-width (* width 4))) ; assuming 32 bit color
+    (let loop ((y 0))
+      (when (< y height)
+        (let* ((y* (- height y 1))
+               (source-start (* y row-width))
+               (target-start (* y* row-width)))
+          (bytevector-copy! pixels source-start buffer target-start row-width)
+          (loop (1+ y)))))
+    buffer))
+
+(define (surface->texture surface min-filter mag-filter wrap-s wrap-t)
+  "Convert SURFACE, an SDL2 surface object, into a texture that uses
+the given MIN-FILTER and MAG-FILTER."
+  ;; Convert to 32 bit RGBA color.
+  (call-with-surface (convert-surface-format surface 'abgr8888)
+    (lambda (surface)
+      (let* ((width (surface-width surface))
+             (height (surface-height surface))
+             ;; OpenGL textures use the bottom-left corner as the
+             ;; origin, whereas SDL uses the top-left, so the rows
+             ;; of pixels must be reversed before creating a
+             ;; texture from them.
+             (pixels (flip-pixels-vertically (surface-pixels surface)
+                                             width height)))
+        (make-texture pixels width height
+                      #:min-filter min-filter
+                      #:mag-filter mag-filter
+                      #:wrap-s wrap-s
+                      #:wrap-t wrap-t)))))
+
+(define* (load-image file #:optional #:key
+                     (min-filter 'nearest)
+                     (mag-filter 'nearest)
+                     (wrap-s 'repeat)
+                     (wrap-t 'repeat))
+  "Load a texture from an image in FILE.  MIN-FILTER and MAG-FILTER
+describe the method that should be used for minification and
+magnification.  Valid values are 'nearest and 'linear.  By default,
+'nearest is used."
+  (call-with-surface (sdl-image:load-image file)
+    (lambda (surface)
+      (surface->texture surface min-filter mag-filter wrap-s wrap-t))))
diff --git a/chickadee/render/vertex-buffer.scm b/chickadee/render/vertex-buffer.scm
new file mode 100644 (file)
index 0000000..5286a44
--- /dev/null
@@ -0,0 +1,261 @@
+;;; Chickadee Game Toolkit
+;;; Copyright © 2016 David Thompson <davet@gnu.org>
+;;;
+;;; Chickadee is free software: you can redistribute it and/or modify
+;;; it under the terms of the GNU General Public License as published
+;;; by the Free Software Foundation, either version 3 of the License,
+;;; or (at your option) any later version.
+;;;
+;;; Chickadee 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 General Public License
+;;; along with this program.  If not, see
+;;; <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+;;
+;; Vertex buffers and vertex arrays.
+;;
+;;; Code:
+
+(define-module (chickadee render vertex-buffer)
+  #:use-module (ice-9 format)
+  #:use-module (ice-9 match)
+  #:use-module (oop goops)
+  #:use-module (rnrs bytevectors)
+  #:use-module (srfi srfi-4)
+  #:use-module (srfi srfi-9)
+  #:use-module (srfi srfi-9 gnu)
+  #:use-module (gl)
+  #:use-module (system foreign)
+  #:use-module (chickadee render gl)
+  #:use-module (chickadee render gpu)
+  #:export (make-vertex-buffer
+            make-streaming-vertex-buffer
+            vertex-buffer?
+            index-buffer?
+            vertex-buffer-type
+            vertex-buffer-usage
+            vertex-buffer-data
+            null-vertex-buffer
+            map-vertex-buffer!
+            unmap-vertex-buffer!
+            with-mapped-vertex-buffer
+            *vertex-buffer-state*
+
+            make-vertex-array
+            vertex-array?
+            vertex-array-index-buffer
+            vertex-array-attribute-buffers
+            null-vertex-array
+            *vertex-array-state*
+
+            render-vertices))
+
+;;;
+;;; Vertex Buffers
+;;;
+
+(define-record-type <vertex-buffer>
+  (%make-vertex-buffer id type usage data)
+  vertex-buffer?
+  (id vertex-buffer-id)
+  (type vertex-buffer-type)
+  (usage vertex-buffer-usage)
+  (data vertex-buffer-data set-vertex-buffer-data!))
+
+(set-record-type-printer! <vertex-buffer>
+  (lambda (vb port)
+    (format port
+            "#<vertex-buffer type: ~a usage: ~a>"
+            (vertex-buffer-type vb)
+            (vertex-buffer-usage vb))))
+
+(define (index-buffer? vb)
+  "Return #t if VB is of type 'index'."
+  (eq? (vertex-buffer-type vb) 'index))
+
+(define null-vertex-buffer (%make-vertex-buffer 0 #f 'static #f))
+
+(define <<vertex-buffer>> (class-of null-vertex-buffer))
+
+(define (free-vertex-buffer vb)
+  (gl-delete-buffers 1 (u32vector (vertex-buffer-id vb))))
+
+(define-method (gpu-finalize (vb <<vertex-buffer>>))
+  (free-vertex-buffer vb))
+
+(define (vertex-buffer-length vb)
+  (bytevector-length (vertex-buffer-data vb)))
+
+(define (type-size type)
+  (match type
+    ((or 'float 'index) 1)
+    ('vec2 2)
+    ('vec3 3)
+    ('vec4 4)))
+
+(define (vertex-buffer-attribute-size vb)
+  (type-size (vertex-buffer-type vb)))
+
+(define (apply-vertex-buffer vb)
+  (gl-bind-buffer (vertex-buffer-target-gl vb)
+                  (vertex-buffer-id vb)))
+
+(define *vertex-buffer-state*
+  (make-gpu-state apply-vertex-buffer null-vertex-buffer))
+
+(define (vertex-buffer-target-gl vb)
+  (if (index-buffer? vb)
+      (arb-vertex-buffer-object element-array-buffer-arb)
+      (arb-vertex-buffer-object array-buffer-arb)))
+
+(define (vertex-buffer-usage-gl vb)
+  (match (vertex-buffer-usage vb)
+    ('static (arb-vertex-buffer-object static-draw-arb))
+    ('stream (arb-vertex-buffer-object stream-draw-arb))))
+
+(define (generate-vertex-buffer-gl)
+  (let ((bv (u32vector 1)))
+    (gl-gen-buffers 1 (bytevector->pointer bv))
+    (u32vector-ref bv 0)))
+
+(define (make-vertex-buffer type usage bv)
+  "Upload BV, a bytevector of TYPE elements, to the GPU as a vertex
+buffer.
+
+USAGE provides a hint to the GPU as to how the vertex buffer will be
+used:
+
+- static: The vertex buffer will not be updated after creation.
+- stream: The vertex buffer will be dynamically updated frequently."
+  ;; Weird bugs will occur when creating a new vertex buffer while a
+  ;; vertex array is bound.
+  (gpu-state-set! *vertex-array-state* null-vertex-array)
+  (let ((vb (gpu-guard
+             (%make-vertex-buffer (generate-vertex-buffer-gl)
+                                  type
+                                  usage
+                                  bv))))
+    (gpu-state-set! *vertex-buffer-state* vb)
+    (gl-buffer-data (vertex-buffer-target-gl vb)
+                    (bytevector-length bv)
+                    (bytevector->pointer bv)
+                    (vertex-buffer-usage-gl vb))
+    (gpu-state-set! *vertex-buffer-state* null-vertex-buffer)
+    vb))
+
+(define (make-streaming-vertex-buffer type length)
+  "Return a new vertex buffer of LENGTH elements suitable for
+streaming data to the GPU every frame.  TYPE is a symbol specifying
+the element type, either 'float', 'index', 'vec2', 'vec3', or 'vec4'."
+  (make-vertex-buffer type 'stream
+                      ;; TODO: Don't assume all numbers are 32-bit.
+                      (make-bytevector (* (type-size type) length 4))))
+
+(define (map-vertex-buffer! vb)
+  "Map the memory space for VB from the GPU to the CPU, allowing the
+vertex buffer to be updated with new vertex data.  The
+'unmap-vertex-buffer!' procedure must be called to submit the new
+vertex buffer data back to the GPU."
+  (let ((target (vertex-buffer-target-gl vb))
+        (length (vertex-buffer-length vb))
+        (usage (vertex-buffer-usage-gl vb)))
+    (gpu-state-set! *vertex-buffer-state* vb)
+    ;; Orphan the buffer to avoid implicit synchronization.
+    ;; See: https://www.opengl.org/wiki/Buffer_Object_Streaming#Buffer_re-specification
+    (gl-buffer-data target length %null-pointer usage)
+    (let ((ptr (gl-map-buffer target (version-1-5 read-write))))
+      (set-vertex-buffer-data! vb (pointer->bytevector ptr length)))))
+
+(define (unmap-vertex-buffer! vb)
+  "Return the mapped vertex buffer data for VB to the GPU."
+  (gpu-state-set! *vertex-buffer-state* vb)
+  (gl-unmap-buffer (vertex-buffer-target-gl vb)))
+
+(define-syntax-rule (with-mapped-vertex-buffer vb body ...)
+  (dynamic-wind
+    (lambda ()
+      (map-vertex-buffer! vb))
+    (lambda () body ...)
+    (lambda ()
+      (unmap-vertex-buffer! vb))))
+
+\f
+;;;
+;;; Vertex Arrays
+;;;
+
+(define-record-type <vertex-array>
+  (%make-vertex-array id index-buffer attribute-buffers)
+  vertex-array?
+  (id vertex-array-id)
+  (index-buffer vertex-array-index-buffer)
+  (attribute-buffers vertex-array-attribute-buffers))
+
+(set-record-type-printer! <vertex-array>
+  (lambda (va port)
+    (format port
+            "#<vertex-array index-buffer: ~a attribute-buffers: ~a>"
+            (vertex-array-index-buffer va)
+            (vertex-array-attribute-buffers va))))
+
+(define null-vertex-array (%make-vertex-array 0 #f '()))
+
+(define <<vertex-array>> (class-of null-vertex-array))
+
+(define (generate-vertex-array)
+  (let ((bv (u32vector 1)))
+    (gl-gen-vertex-arrays 1 (bytevector->pointer bv))
+    (u32vector-ref bv 0)))
+
+(define (free-vertex-array va)
+  (gl-delete-vertex-arrays 1 (u32vector (vertex-array-id va))))
+
+(define-method (gpu-finalize (va <<vertex-array>>))
+  (free-vertex-array va))
+
+(define (apply-vertex-array va)
+  (gl-bind-vertex-array (vertex-array-id va)))
+
+(define *vertex-array-state*
+  (make-gpu-state apply-vertex-array null-vertex-array))
+
+(define (make-vertex-array index-buffer . attribute-buffers)
+  (let ((va (gpu-guard
+             (%make-vertex-array (generate-vertex-array)
+                                 index-buffer
+                                 attribute-buffers))))
+    (gpu-state-set! *vertex-array-state* va)
+    ;; Configure all attribute buffers starting from attribute
+    ;; location 0.
+    (let loop ((attrs attribute-buffers)
+               (index 0))
+      (match attrs
+        (() #f)
+        ((attr . rest)
+         (gl-enable-vertex-attrib-array index)
+         (gpu-state-set! *vertex-buffer-state* attr)
+         (gl-vertex-attrib-pointer index
+                                   (vertex-buffer-attribute-size attr)
+                                   (data-type float)
+                                   #f
+                                   0
+                                   %null-pointer)
+         (loop rest (1+ index)))))
+    (gpu-state-set! *vertex-buffer-state* index-buffer)
+    (gpu-state-set! *vertex-array-state* null-vertex-array)
+    va))
+
+(define* (render-vertices #:optional count)
+  (gl-draw-elements (begin-mode triangles)
+                    (or count
+                        (u32vector-length
+                         (vertex-buffer-data
+                          (vertex-array-index-buffer
+                           (gpu-state-ref *vertex-array-state*)))))
+                    (data-type unsigned-int)
+                    %null-pointer))
diff --git a/chickadee/window.scm b/chickadee/window.scm
new file mode 100644 (file)
index 0000000..0ca94e4
--- /dev/null
@@ -0,0 +1,89 @@
+;;; Chickadee Game Toolkit
+;;; Copyright © 2016 David Thompson <davet@gnu.org>
+;;;
+;;; Chickadee is free software: you can redistribute it and/or modify
+;;; it under the terms of the GNU General Public License as published
+;;; by the Free Software Foundation, either version 3 of the License,
+;;; or (at your option) any later version.
+;;;
+;;; Chickadee 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 General Public License
+;;; along with this program.  If not, see
+;;; <http://www.gnu.org/licenses/>.
+
+(define-module (chickadee window)
+  #:use-module (ice-9 match)
+  #:use-module (srfi srfi-9)
+  #:use-module ((sdl2) #:prefix sdl2:)
+  #:use-module ((sdl2 events) #:prefix sdl2:)
+  #:use-module ((sdl2 video) #:prefix sdl2:)
+  #:export (open-window
+            close-window
+            window?
+            window-title
+            window-width
+            window-height
+            window-fullscreen?
+            with-window
+            swap-buffers))
+
+(define-record-type <window>
+  (make-window sdl-window gl-context)
+  window?
+  (sdl-window unwrap-window)
+  (gl-context window-gl-context))
+
+(define* (open-window #:key
+                      (title "Chickadee")
+                      (width 640)
+                      (height 480)
+                      fullscreen?)
+  (sdl2:set-gl-attribute! 'context-major-version 3)
+  (sdl2:set-gl-attribute! 'context-minor-version 3)
+  (sdl2:set-gl-attribute! 'double-buffer 1)
+  (sdl2:set-gl-attribute! 'depth-size 24)
+  (sdl2:set-gl-attribute! 'red-size 8)
+  (sdl2:set-gl-attribute! 'green-size 8)
+  (sdl2:set-gl-attribute! 'blue-size 8)
+  (sdl2:set-gl-attribute! 'alpha-size 8)
+  (sdl2:set-gl-attribute! 'stencil-size 8)
+  (sdl2:set-gl-attribute! 'retained-backing 0)
+  (sdl2:set-gl-attribute! 'framebuffer-srgb-capable 1)
+  (let* ((sdl-window (sdl2:make-window #:opengl? #t
+                                       #:title title
+                                       #:size (list width height)
+                                       #:fullscreen? fullscreen?))
+         (gl-context (sdl2:make-gl-context sdl-window))
+         (window (make-window sdl-window gl-context)))
+    (sdl2:set-gl-swap-interval! 'vsync)
+    window))
+
+(define (close-window! window)
+  "Close WINDOW."
+  (sdl2:delete-gl-context! (window-gl-context window))
+  (sdl2:close-window! (unwrap-window window)))
+
+(define (window-title window)
+  "Return the title of WINDOW."
+  (sdl2:window-title (unwrap-window window)))
+
+(define (set-window-title! window title)
+  "Set TITLE for WINDOW."
+  (sdl2:set-window-title! (unwrap-window window) title))
+
+(define (set-window-size! window width height)
+  (sdl2:set-window-size! (unwrap-window window) (list width height)))
+
+(define-syntax-rule (with-window window body ...)
+  (dynamic-wind
+    (const #t)
+    (lambda () body ...)
+    (lambda ()
+      (close-window! window))))
+
+(define (swap-buffers window)
+  (sdl2:swap-gl-window (unwrap-window window)))
diff --git a/configure.ac b/configure.ac
new file mode 100644 (file)
index 0000000..d3ced53
--- /dev/null
@@ -0,0 +1,26 @@
+dnl -*- Autoconf -*-
+
+AC_INIT(chickadee, 0.1.0)
+AC_CONFIG_SRCDIR(chickadee)
+AC_CONFIG_AUX_DIR([build-aux])
+AM_INIT_AUTOMAKE([color-tests -Wall -Wno-portability foreign])
+AM_SILENT_RULES([yes])
+
+AC_PATH_PROG([GUILE], [guile])
+AC_CONFIG_FILES([Makefile])
+AC_CONFIG_FILES([pre-inst-env], [chmod +x pre-inst-env])
+AC_CONFIG_FILES([chickadee/config.scm])
+
+# Prepare a version of $datadir that does not contain references to
+# shell variables.
+chickadee_prefix="`eval echo $prefix | sed -e"s|NONE|/usr/local|g"`"
+chickadee_datadir="`eval eval echo $datadir | sed -e "s|NONE|$chickadee_prefix|g"`"
+AC_SUBST([chickadee_datadir])
+
+GUILE_PKG([2.2 2.0])
+GUILE_PROGS
+
+GUILE_MODULE_REQUIRED([gl])
+GUILE_MODULE_REQUIRED([sdl2])
+
+AC_OUTPUT
diff --git a/doc/chickadee.texi b/doc/chickadee.texi
new file mode 100644 (file)
index 0000000..7e9362f
--- /dev/null
@@ -0,0 +1,104 @@
+\input texinfo   @c -*-texinfo-*-
+@c %**start of header
+@setfilename chickadee.info
+@settitle The Chickadee Game Toolkit
+@c %**end of header
+@copying
+Copyright @copyright{} 2016  David Thompson @email{davet@@gnu.org}
+
+@quotation
+Permission is granted to copy, distribute and/or modify this document
+under the terms of the GNU Free Documentation License, Version 1.3
+or any later version published by the Free Software Foundation;
+with no Invariant Sections, no Front-Cover Texts, and no Back-Cover Texts.
+A copy of the license is included in the section entitled ``GNU
+Free Documentation License''.
+
+A copy of the license is also available from the Free Software
+Foundation Web site at @url{http://www.gnu.org/licenses/fdl.html}.
+
+@end quotation
+
+The document was typeset with
+@uref{http://www.texinfo.org/, GNU Texinfo}.
+
+@end copying
+
+@titlepage
+@title Chickadee 0.1
+@subtitle Using the Chickadee game toolkit
+@author David Thompson
+@page
+@vskip 0pt plus 1filll
+@insertcopying
+@end titlepage
+
+@c Output the table of the contents at the beginning.
+@contents
+
+@ifnottex
+@node Top
+@top Chickadee
+
+@insertcopying
+@end ifnottex
+
+@c Generate the nodes for this menu with `C-c C-u C-m'.
+@menu
+* Installation::                Installing Chickadee.
+
+* Copying This Manual::         The GNU Free Documentation License and you!
+* Index::
+@end menu
+
+@c Update all node entries with `C-c C-u C-n'.
+@c Insert new nodes with `C-c C-c n'.
+
+@node Installation
+@chapter Installation
+
+Chickadee is available for download from its website at
+@url{dthompson.us/projects/chickadee.html}.  This section describes
+the software requirements of Chickadee, as well as how to install it.
+
+The build procedure for Chickadee is the same as for GNU software packages,
+and is not covered here.  Please see the files @file{README.org} and
+@file{INSTALL.org} for additional details.
+
+@menu
+* Requirements::                Software needed to build and run Chickadee.
+@end menu
+
+@node Requirements
+@section Requirements
+
+Chickadee depends on the following packages:
+
+@itemize
+@item @url{https://gnu.org/software/guile, GNU Guile}, version 2.0.11 or later;
+@item @url{https://gnu.org/software/guile-opengl, GNU guile-opengl}, version 0.1 or later.
+@item @url{https://dthompson.us/pages/software/guile-sdl2.html, guile-sdl2}, version 0.2.0 or later;
+@end itemize
+
+@node Copying This Manual
+@appendix Copying This Manual
+
+@menu
+* GNU Free Documentation License::  License for copying this manual.
+@end menu
+
+@c Get fdl.texi from http://www.gnu.org/licenses/fdl.html
+@node GNU Free Documentation License
+@section GNU Free Documentation License
+@include fdl.texi
+
+@node Index
+@unnumbered Index
+
+@syncodeindex tp fn
+@syncodeindex vr fn
+@printindex fn
+
+@bye
+
+@c chickadee.texi ends here
diff --git a/doc/fdl.texi b/doc/fdl.texi
new file mode 100644 (file)
index 0000000..9c3bbe5
--- /dev/null
@@ -0,0 +1,505 @@
+@c The GNU Free Documentation License.
+@center Version 1.3, 3 November 2008
+
+@c This file is intended to be included within another document,
+@c hence no sectioning command or @node.
+
+@display
+Copyright @copyright{} 2000, 2001, 2002, 2007, 2008 Free Software Foundation, Inc.
+@uref{http://fsf.org/}
+
+Everyone is permitted to copy and distribute verbatim copies
+of this license document, but changing it is not allowed.
+@end display
+
+@enumerate 0
+@item
+PREAMBLE
+
+The purpose of this License is to make a manual, textbook, or other
+functional and useful document @dfn{free} in the sense of freedom: to
+assure everyone the effective freedom to copy and redistribute it,
+with or without modifying it, either commercially or noncommercially.
+Secondarily, this License preserves for the author and publisher a way
+to get credit for their work, while not being considered responsible
+for modifications made by others.
+
+This License is a kind of ``copyleft'', which means that derivative
+works of the document must themselves be free in the same sense.  It
+complements the GNU General Public License, which is a copyleft
+license designed for free software.
+
+We have designed this License in order to use it for manuals for free
+software, because free software needs free documentation: a free
+program should come with manuals providing the same freedoms that the
+software does.  But this License is not limited to software manuals;
+it can be used for any textual work, regardless of subject matter or
+whether it is published as a printed book.  We recommend this License
+principally for works whose purpose is instruction or reference.
+
+@item
+APPLICABILITY AND DEFINITIONS
+
+This License applies to any manual or other work, in any medium, that
+contains a notice placed by the copyright holder saying it can be
+distributed under the terms of this License.  Such a notice grants a
+world-wide, royalty-free license, unlimited in duration, to use that
+work under the conditions stated herein.  The ``Document'', below,
+refers to any such manual or work.  Any member of the public is a
+licensee, and is addressed as ``you''.  You accept the license if you
+copy, modify or distribute the work in a way requiring permission
+under copyright law.
+
+A ``Modified Version'' of the Document means any work containing the
+Document or a portion of it, either copied verbatim, or with
+modifications and/or translated into another language.
+
+A ``Secondary Section'' is a named appendix or a front-matter section
+of the Document that deals exclusively with the relationship of the
+publishers or authors of the Document to the Document's overall
+subject (or to related matters) and contains nothing that could fall
+directly within that overall subject.  (Thus, if the Document is in
+part a textbook of mathematics, a Secondary Section may not explain
+any mathematics.)  The relationship could be a matter of historical
+connection with the subject or with related matters, or of legal,
+commercial, philosophical, ethical or political position regarding
+them.
+
+The ``Invariant Sections'' are certain Secondary Sections whose titles
+are designated, as being those of Invariant Sections, in the notice
+that says that the Document is released under this License.  If a
+section does not fit the above definition of Secondary then it is not
+allowed to be designated as Invariant.  The Document may contain zero
+Invariant Sections.  If the Document does not identify any Invariant
+Sections then there are none.
+
+The ``Cover Texts'' are certain short passages of text that are listed,
+as Front-Cover Texts or Back-Cover Texts, in the notice that says that
+the Document is released under this License.  A Front-Cover Text may
+be at most 5 words, and a Back-Cover Text may be at most 25 words.
+
+A ``Transparent'' copy of the Document means a machine-readable copy,
+represented in a format whose specification is available to the
+general public, that is suitable for revising the document
+straightforwardly with generic text editors or (for images composed of
+pixels) generic paint programs or (for drawings) some widely available
+drawing editor, and that is suitable for input to text formatters or
+for automatic translation to a variety of formats suitable for input
+to text formatters.  A copy made in an otherwise Transparent file
+format whose markup, or absence of markup, has been arranged to thwart
+or discourage subsequent modification by readers is not Transparent.
+An image format is not Transparent if used for any substantial amount
+of text.  A copy that is not ``Transparent'' is called ``Opaque''.
+
+Examples of suitable formats for Transparent copies include plain
+ASCII without markup, Texinfo input format, La@TeX{} input
+format, SGML or XML using a publicly available
+DTD, and standard-conforming simple HTML,
+PostScript or PDF designed for human modification.  Examples
+of transparent image formats include PNG, XCF and
+JPG@.  Opaque formats include proprietary formats that can be
+read and edited only by proprietary word processors, SGML or
+XML for which the DTD and/or processing tools are
+not generally available, and the machine-generated HTML,
+PostScript or PDF produced by some word processors for
+output purposes only.
+
+The ``Title Page'' means, for a printed book, the title page itself,
+plus such following pages as are needed to hold, legibly, the material
+this License requires to appear in the title page.  For works in
+formats which do not have any title page as such, ``Title Page'' means
+the text near the most prominent appearance of the work's title,
+preceding the beginning of the body of the text.
+
+The ``publisher'' means any person or entity that distributes copies
+of the Document to the public.
+
+A section ``Entitled XYZ'' means a named subunit of the Document whose
+title either is precisely XYZ or contains XYZ in parentheses following
+text that translates XYZ in another language.  (Here XYZ stands for a
+specific section name mentioned below, such as ``Acknowledgements'',
+``Dedications'', ``Endorsements'', or ``History''.)  To ``Preserve the Title''
+of such a section when you modify the Document means that it remains a
+section ``Entitled XYZ'' according to this definition.
+
+The Document may include Warranty Disclaimers next to the notice which
+states that this License applies to the Document.  These Warranty
+Disclaimers are considered to be included by reference in this
+License, but only as regards disclaiming warranties: any other
+implication that these Warranty Disclaimers may have is void and has
+no effect on the meaning of this License.
+
+@item
+VERBATIM COPYING
+
+You may copy and distribute the Document in any medium, either
+commercially or noncommercially, provided that this License, the
+copyright notices, and the license notice saying this License applies
+to the Document are reproduced in all copies, and that you add no other
+conditions whatsoever to those of this License.  You may not use
+technical measures to obstruct or control the reading or further
+copying of the copies you make or distribute.  However, you may accept
+compensation in exchange for copies.  If you distribute a large enough
+number of copies you must also follow the conditions in section 3.
+
+You may also lend copies, under the same conditions stated above, and
+you may publicly display copies.
+
+@item
+COPYING IN QUANTITY
+
+If you publish printed copies (or copies in media that commonly have
+printed covers) of the Document, numbering more than 100, and the
+Document's license notice requires Cover Texts, you must enclose the
+copies in covers that carry, clearly and legibly, all these Cover
+Texts: Front-Cover Texts on the front cover, and Back-Cover Texts on
+the back cover.  Both covers must also clearly and legibly identify
+you as the publisher of these copies.  The front cover must present
+the full title with all words of the title equally prominent and
+visible.  You may add other material on the covers in addition.
+Copying with changes limited to the covers, as long as they preserve
+the title of the Document and satisfy these conditions, can be treated
+as verbatim copying in other respects.
+
+If the required texts for either cover are too voluminous to fit
+legibly, you should put the first ones listed (as many as fit
+reasonably) on the actual cover, and continue the rest onto adjacent
+pages.
+
+If you publish or distribute Opaque copies of the Document numbering
+more than 100, you must either include a machine-readable Transparent
+copy along with each Opaque copy, or state in or with each Opaque copy
+a computer-network location from which the general network-using
+public has access to download using public-standard network protocols
+a complete Transparent copy of the Document, free of added material.
+If you use the latter option, you must take reasonably prudent steps,
+when you begin distribution of Opaque copies in quantity, to ensure
+that this Transparent copy will remain thus accessible at the stated
+location until at least one year after the last time you distribute an
+Opaque copy (directly or through your agents or retailers) of that
+edition to the public.
+
+It is requested, but not required, that you contact the authors of the
+Document well before redistributing any large number of copies, to give
+them a chance to provide you with an updated version of the Document.
+
+@item
+MODIFICATIONS
+
+You may copy and distribute a Modified Version of the Document under
+the conditions of sections 2 and 3 above, provided that you release
+the Modified Version under precisely this License, with the Modified
+Version filling the role of the Document, thus licensing distribution
+and modification of the Modified Version to whoever possesses a copy
+of it.  In addition, you must do these things in the Modified Version:
+
+@enumerate A
+@item
+Use in the Title Page (and on the covers, if any) a title distinct
+from that of the Document, and from those of previous versions
+(which should, if there were any, be listed in the History section
+of the Document).  You may use the same title as a previous version
+if the original publisher of that version gives permission.
+
+@item
+List on the Title Page, as authors, one or more persons or entities
+responsible for authorship of the modifications in the Modified
+Version, together with at least five of the principal authors of the
+Document (all of its principal authors, if it has fewer than five),
+unless they release you from this requirement.
+
+@item
+State on the Title page the name of the publisher of the
+Modified Version, as the publisher.
+
+@item
+Preserve all the copyright notices of the Document.
+
+@item
+Add an appropriate copyright notice for your modifications
+adjacent to the other copyright notices.
+
+@item
+Include, immediately after the copyright notices, a license notice
+giving the public permission to use the Modified Version under the
+terms of this License, in the form shown in the Addendum below.
+
+@item
+Preserve in that license notice the full lists of Invariant Sections
+and required Cover Texts given in the Document's license notice.
+
+@item
+Include an unaltered copy of this License.
+
+@item
+Preserve the section Entitled ``History'', Preserve its Title, and add
+to it an item stating at least the title, year, new authors, and
+publisher of the Modified Version as given on the Title Page.  If
+there is no section Entitled ``History'' in the Document, create one
+stating the title, year, authors, and publisher of the Document as
+given on its Title Page, then add an item describing the Modified
+Version as stated in the previous sentence.
+
+@item
+Preserve the network location, if any, given in the Document for
+public access to a Transparent copy of the Document, and likewise
+the network locations given in the Document for previous versions
+it was based on.  These may be placed in the ``History'' section.
+You may omit a network location for a work that was published at
+least four years before the Document itself, or if the original
+publisher of the version it refers to gives permission.
+
+@item
+For any section Entitled ``Acknowledgements'' or ``Dedications'', Preserve
+the Title of the section, and preserve in the section all the
+substance and tone of each of the contributor acknowledgements and/or
+dedications given therein.
+
+@item
+Preserve all the Invariant Sections of the Document,
+unaltered in their text and in their titles.  Section numbers
+or the equivalent are not considered part of the section titles.
+
+@item
+Delete any section Entitled ``Endorsements''.  Such a section
+may not be included in the Modified Version.
+
+@item
+Do not retitle any existing section to be Entitled ``Endorsements'' or
+to conflict in title with any Invariant Section.
+
+@item
+Preserve any Warranty Disclaimers.
+@end enumerate
+
+If the Modified Version includes new front-matter sections or
+appendices that qualify as Secondary Sections and contain no material
+copied from the Document, you may at your option designate some or all
+of these sections as invariant.  To do this, add their titles to the
+list of Invariant Sections in the Modified Version's license notice.
+These titles must be distinct from any other section titles.
+
+You may add a section Entitled ``Endorsements'', provided it contains
+nothing but endorsements of your Modified Version by various
+parties---for example, statements of peer review or that the text has
+been approved by an organization as the authoritative definition of a
+standard.
+
+You may add a passage of up to five words as a Front-Cover Text, and a
+passage of up to 25 words as a Back-Cover Text, to the end of the list
+of Cover Texts in the Modified Version.  Only one passage of
+Front-Cover Text and one of Back-Cover Text may be added by (or
+through arrangements made by) any one entity.  If the Document already
+includes a cover text for the same cover, previously added by you or
+by arrangement made by the same entity you are acting on behalf of,
+you may not add another; but you may replace the old one, on explicit
+permission from the previous publisher that added the old one.
+
+The author(s) and publisher(s) of the Document do not by this License
+give permission to use their names for publicity for or to assert or
+imply endorsement of any Modified Version.
+
+@item
+COMBINING DOCUMENTS
+
+You may combine the Document with other documents released under this
+License, under the terms defined in section 4 above for modified
+versions, provided that you include in the combination all of the
+Invariant Sections of all of the original documents, unmodified, and
+list them all as Invariant Sections of your combined work in its
+license notice, and that you preserve all their Warranty Disclaimers.
+
+The combined work need only contain one copy of this License, and
+multiple identical Invariant Sections may be replaced with a single
+copy.  If there are multiple Invariant Sections with the same name but
+different contents, make the title of each such section unique by
+adding at the end of it, in parentheses, the name of the original
+author or publisher of that section if known, or else a unique number.
+Make the same adjustment to the section titles in the list of
+Invariant Sections in the license notice of the combined work.
+
+In the combination, you must combine any sections Entitled ``History''
+in the various original documents, forming one section Entitled
+``History''; likewise combine any sections Entitled ``Acknowledgements'',
+and any sections Entitled ``Dedications''.  You must delete all
+sections Entitled ``Endorsements.''
+
+@item
+COLLECTIONS OF DOCUMENTS
+
+You may make a collection consisting of the Document and other documents
+released under this License, and replace the individual copies of this
+License in the various documents with a single copy that is included in
+the collection, provided that you follow the rules of this License for
+verbatim copying of each of the documents in all other respects.
+
+You may extract a single document from such a collection, and distribute
+it individually under this License, provided you insert a copy of this
+License into the extracted document, and follow this License in all
+other respects regarding verbatim copying of that document.
+
+@item
+AGGREGATION WITH INDEPENDENT WORKS
+
+A compilation of the Document or its derivatives with other separate
+and independent documents or works, in or on a volume of a storage or
+distribution medium, is called an ``aggregate'' if the copyright
+resulting from the compilation is not used to limit the legal rights
+of the compilation's users beyond what the individual works permit.
+When the Document is included in an aggregate, this License does not
+apply to the other works in the aggregate which are not themselves
+derivative works of the Document.
+
+If the Cover Text requirement of section 3 is applicable to these
+copies of the Document, then if the Document is less than one half of
+the entire aggregate, the Document's Cover Texts may be placed on
+covers that bracket the Document within the aggregate, or the
+electronic equivalent of covers if the Document is in electronic form.
+Otherwise they must appear on printed covers that bracket the whole
+aggregate.
+
+@item
+TRANSLATION
+
+Translation is considered a kind of modification, so you may
+distribute translations of the Document under the terms of section 4.
+Replacing Invariant Sections with translations requires special
+permission from their copyright holders, but you may include
+translations of some or all Invariant Sections in addition to the
+original versions of these Invariant Sections.  You may include a
+translation of this License, and all the license notices in the
+Document, and any Warranty Disclaimers, provided that you also include
+the original English version of this License and the original versions
+of those notices and disclaimers.  In case of a disagreement between
+the translation and the original version of this License or a notice
+or disclaimer, the original version will prevail.
+
+If a section in the Document is Entitled ``Acknowledgements'',
+``Dedications'', or ``History'', the requirement (section 4) to Preserve
+its Title (section 1) will typically require changing the actual
+title.
+
+@item
+TERMINATION
+
+You may not copy, modify, sublicense, or distribute the Document
+except as expressly provided under this License.  Any attempt
+otherwise to copy, modify, sublicense, or distribute it is void, and
+will automatically terminate your rights under this License.
+
+However, if you cease all violation of this License, then your license
+from a particular copyright holder is reinstated (a) provisionally,
+unless and until the copyright holder explicitly and finally
+terminates your license, and (b) permanently, if the copyright holder
+fails to notify you of the violation by some reasonable means prior to
+60 days after the cessation.
+
+Moreover, your license from a particular copyright holder is
+reinstated permanently if the copyright holder notifies you of the
+violation by some reasonable means, this is the first time you have
+received notice of violation of this License (for any work) from that
+copyright holder, and you cure the violation prior to 30 days after
+your receipt of the notice.
+
+Termination of your rights under this section does not terminate the
+licenses of parties who have received copies or rights from you under
+this License.  If your rights have been terminated and not permanently
+reinstated, receipt of a copy of some or all of the same material does
+not give you any rights to use it.
+
+@item
+FUTURE REVISIONS OF THIS LICENSE
+
+The Free Software Foundation may publish new, revised versions
+of the GNU Free Documentation 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.  See
+@uref{http://www.gnu.org/copyleft/}.
+
+Each version of the License is given a distinguishing version number.
+If the Document specifies that a particular numbered version of this
+License ``or any later version'' applies to it, you have the option of
+following the terms and conditions either of that specified version or
+of any later version that has been published (not as a draft) by the
+Free Software Foundation.  If the Document does not specify a version
+number of this License, you may choose any version ever published (not
+as a draft) by the Free Software Foundation.  If the Document
+specifies that a proxy can decide which future versions of this
+License can be used, that proxy's public statement of acceptance of a
+version permanently authorizes you to choose that version for the
+Document.
+
+@item
+RELICENSING
+
+``Massive Multiauthor Collaboration Site'' (or ``MMC Site'') means any
+World Wide Web server that publishes copyrightable works and also
+provides prominent facilities for anybody to edit those works.  A
+public wiki that anybody can edit is an example of such a server.  A
+``Massive Multiauthor Collaboration'' (or ``MMC'') contained in the
+site means any set of copyrightable works thus published on the MMC
+site.
+
+``CC-BY-SA'' means the Creative Commons Attribution-Share Alike 3.0
+license published by Creative Commons Corporation, a not-for-profit
+corporation with a principal place of business in San Francisco,
+California, as well as future copyleft versions of that license
+published by that same organization.
+
+``Incorporate'' means to publish or republish a Document, in whole or
+in part, as part of another Document.
+
+An MMC is ``eligible for relicensing'' if it is licensed under this
+License, and if all works that were first published under this License
+somewhere other than this MMC, and subsequently incorporated in whole
+or in part into the MMC, (1) had no cover texts or invariant sections,
+and (2) were thus incorporated prior to November 1, 2008.
+
+The operator of an MMC Site may republish an MMC contained in the site
+under CC-BY-SA on the same site at any time before August 1, 2009,
+provided the MMC is eligible for relicensing.
+
+@end enumerate
+
+@page
+@heading ADDENDUM: How to use this License for your documents
+
+To use this License in a document you have written, include a copy of
+the License in the document and put the following copyright and
+license notices just after the title page:
+
+@smallexample
+@group
+  Copyright (C)  @var{year}  @var{your name}.
+  Permission is granted to copy, distribute and/or modify this document
+  under the terms of the GNU Free Documentation License, Version 1.3
+  or any later version published by the Free Software Foundation;
+  with no Invariant Sections, no Front-Cover Texts, and no Back-Cover
+  Texts.  A copy of the license is included in the section entitled ``GNU
+  Free Documentation License''.
+@end group
+@end smallexample
+
+If you have Invariant Sections, Front-Cover Texts and Back-Cover Texts,
+replace the ``with@dots{}Texts.''@: line with this:
+
+@smallexample
+@group
+    with the Invariant Sections being @var{list their titles}, with
+    the Front-Cover Texts being @var{list}, and with the Back-Cover Texts
+    being @var{list}.
+@end group
+@end smallexample
+
+If you have Invariant Sections without Cover Texts, or some other
+combination of the three, merge those two alternatives to suit the
+situation.
+
+If your document contains nontrivial examples of program code, we
+recommend releasing these examples in parallel under your choice of
+free software license, such as the GNU General Public License,
+to permit their use in free software.
+
+@c Local Variables:
+@c ispell-local-pdict: "ispell-dict"
+@c End:
diff --git a/guix.scm b/guix.scm
new file mode 100644 (file)
index 0000000..5653a36
--- /dev/null
+++ b/guix.scm
@@ -0,0 +1,139 @@
+;;; Chickadee Game Toolkit
+;;; Copyright © 2016 David Thompson <davet@gnu.org>
+;;;
+;;; Chickadee is free software: you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation, either version 3 of the License, or
+;;; (at your option) any later version.
+;;;
+;;; Chickadee 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 General Public License
+;;; along with this program.  If not, see
+;;; <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+;;
+;; Development environment for GNU Guix.
+;;
+;; To setup the development environment, run the following:
+;;
+;;    guix environment -l guix.scm
+;;    ./bootstrap && ./configure;
+;;
+;; To build the development snapshot, run:
+;;
+;;    guix build -f guix.scm
+;;
+;; To install the development snapshot, run:
+;;
+;;    guix install -f guix.scm
+;;
+;;; Code:
+
+(use-modules (ice-9 match)
+             (srfi srfi-1)
+             (guix packages)
+             (guix licenses)
+             (guix git-download)
+             (guix build-system gnu)
+             (gnu packages)
+             (gnu packages autotools)
+             (gnu packages pkg-config)
+             (gnu packages texinfo)
+             (gnu packages guile)
+             (gnu packages gl)
+             (gnu packages sdl)
+             (gnu packages maths)
+             (gnu packages image))
+
+(define (package-with-guile p guile)
+  (package
+    (inherit p)
+    (inputs
+     (map (match-lambda
+            (("guile" _)
+             `("guile" ,guile))
+            (input input))
+          (package-inputs p)))))
+
+(define (package-with-guile-next p)
+  (package-with-guile p guile-next))
+
+(define guile-sdl2
+  (let ((commit "9ec24e3f997e40ebde5e8b0057e0324e21fd93a4"))
+    (package
+      (name "guile-sdl2")
+      (version (string-append "0.1.2-1." (string-take commit 7)))
+      (source (origin
+                (method git-fetch)
+                (uri (git-reference
+                      (url "git://dthompson.us/guile-sdl2.git")
+                      (commit commit)))
+                (file-name (string-append name "-" version "-checkout"))
+                (sha256
+                 (base32
+                  "1aczhrg5s83242hlj6i258axf8cr8a2pvp1kdfk55cr4gf1ajf5x"))))
+      (build-system gnu-build-system)
+      (arguments
+       '(#:configure-flags
+         (list (string-append "--with-libsdl2-prefix="
+                              (assoc-ref %build-inputs "sdl2"))
+               (string-append "--with-libsdl2-image-prefix="
+                              (assoc-ref %build-inputs "sdl2-image"))
+               (string-append "--with-libsdl2-ttf-prefix="
+                              (assoc-ref %build-inputs "sdl2-ttf"))
+               (string-append "--with-libsdl2-mixer-prefix="
+                              (assoc-ref %build-inputs "sdl2-mixer")))
+         #:make-flags '("GUILE_AUTO_COMPILE=0")
+         #:phases
+         (modify-phases %standard-phases
+           (add-after 'unpack 'bootstrap
+             (lambda _ (zero? (system* "sh" "bootstrap"))))
+           (add-after 'configure 'patch-makefile
+             (lambda _
+               ;; Install compiled Guile files in the expected place.
+               (substitute* '("Makefile")
+                 (("^godir = .*$")
+                  "godir = $(moddir)\n")))))))
+      (native-inputs
+       `(("autoconf" ,autoconf)
+         ("automake" ,automake)
+         ("pkg-config" ,pkg-config)
+         ("texinfo" ,texinfo)))
+      (inputs
+       `(("guile" ,guile-next)
+         ("sdl2" ,sdl2)
+         ("sdl2-image" ,sdl2-image)
+         ("sdl2-mixer" ,sdl2-mixer)
+         ("sdl2-ttf" ,sdl2-ttf)))
+      (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+))))
+
+(package
+  (name "chickadee")
+  (version "0.1")
+  (source #f)
+  (build-system gnu-build-system)
+  (native-inputs
+   `(("autoconf" ,autoconf)
+     ("automake" ,automake)
+     ("pkg-config" ,pkg-config)
+     ("texinfo" ,texinfo)))
+  (inputs
+   `(("guile" ,guile-next)))
+  (propagated-inputs
+   `(("guile-opengl" ,(package-with-guile-next guile-opengl))
+     ("guile-sdl2" ,(package-with-guile-next guile-sdl2))))
+  (synopsis "Game development toolkit for Guile Scheme")
+  (description "Chickadee is a game development toolkit for Guile
+Scheme.  It contains all of the basic components needed to develop
+2D/3D video games.")
+  (home-page "https://dthompson.us/projects/chickadee.html")
+  (license gpl3+))
diff --git a/pre-inst-env.in b/pre-inst-env.in
new file mode 100644 (file)
index 0000000..d06155f
--- /dev/null
@@ -0,0 +1,32 @@
+#!/bin/sh
+
+# Chickadee Game Toolkit
+# Copyright © 2016 David Thompson <davet@gnu.org>
+#
+# Chickadee is free software: you can redistribute it and/or modify it
+# under the terms of the GNU General Public License as published by
+# the Free Software Foundation, either version 3 of the License, or
+# (at your option) any later version.
+#
+# Chickadee 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 General Public License
+# along with Chickadee.  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
+
+CHICKADEE_DATADIR="$abs_top_builddir/assets"
+export CHICKADEE_DATADIR
+
+exec "$@"