summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--.dir-locals.el13
-rw-r--r--.gitignore13
-rw-r--r--Makefile.am64
-rw-r--r--README47
-rwxr-xr-xbootstrap3
-rw-r--r--chickadee.scm185
-rw-r--r--chickadee/color.scm182
-rw-r--r--chickadee/config.scm.in36
-rw-r--r--chickadee/input/controller.scm87
-rw-r--r--chickadee/math.scm26
-rw-r--r--chickadee/math/matrix.scm315
-rw-r--r--chickadee/math/vector.scm201
-rw-r--r--chickadee/render.scm135
-rw-r--r--chickadee/render/blend.scm73
-rw-r--r--chickadee/render/gl.scm275
-rw-r--r--chickadee/render/gpu.scm64
-rw-r--r--chickadee/render/shader.scm346
-rw-r--r--chickadee/render/shapes.scm205
-rw-r--r--chickadee/render/sprite.scm282
-rw-r--r--chickadee/render/texture.scm191
-rw-r--r--chickadee/render/vertex-buffer.scm261
-rw-r--r--chickadee/window.scm89
-rw-r--r--configure.ac26
-rw-r--r--doc/chickadee.texi104
-rw-r--r--doc/fdl.texi505
-rw-r--r--guix.scm139
-rw-r--r--pre-inst-env.in32
27 files changed, 3899 insertions, 0 deletions
diff --git a/.dir-locals.el b/.dir-locals.el
new file mode 100644
index 0000000..86a4575
--- /dev/null
+++ b/.dir-locals.el
@@ -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
index 0000000..245393f
--- /dev/null
+++ b/.gitignore
@@ -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
index 0000000..780a085
--- /dev/null
+++ b/Makefile.am
@@ -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
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
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
index 0000000..e3d128a
--- /dev/null
+++ b/chickadee.scm
@@ -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
index 0000000..e40deb4
--- /dev/null
+++ b/chickadee/color.scm
@@ -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
index 0000000..86aaeb5
--- /dev/null
+++ b/chickadee/config.scm.in
@@ -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
index 0000000..e78623e
--- /dev/null
+++ b/chickadee/input/controller.scm
@@ -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
index 0000000..753f70d
--- /dev/null
+++ b/chickadee/math.scm
@@ -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
index 0000000..be307ab
--- /dev/null
+++ b/chickadee/math/matrix.scm
@@ -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
index 0000000..66a21fd
--- /dev/null
+++ b/chickadee/math/vector.scm
@@ -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
index 0000000..d55c76e
--- /dev/null
+++ b/chickadee/render.scm
@@ -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
index 0000000..2e8ebb0
--- /dev/null
+++ b/chickadee/render/blend.scm
@@ -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
index 0000000..bc93d13
--- /dev/null
+++ b/chickadee/render/gl.scm
@@ -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)
+
+
+;;;
+;;; 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
index 0000000..dde8a69
--- /dev/null
+++ b/chickadee/render/gpu.scm
@@ -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!))
+
+
+;;;
+;;; 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
index 0000000..5e8afc9
--- /dev/null
+++ b/chickadee/render/shader.scm
@@ -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
index 0000000..52e2613
--- /dev/null
+++ b/chickadee/render/shapes.scm
@@ -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
index 0000000..b23130a
--- /dev/null
+++ b/chickadee/render/sprite.scm
@@ -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))))))
+
+
+;;;
+;;; 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
index 0000000..ef55dca
--- /dev/null
+++ b/chickadee/render/texture.scm
@@ -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
index 0000000..5286a44
--- /dev/null
+++ b/chickadee/render/vertex-buffer.scm
@@ -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))))
+
+
+;;;
+;;; 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
index 0000000..0ca94e4
--- /dev/null
+++ b/chickadee/window.scm
@@ -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
index 0000000..d3ced53
--- /dev/null
+++ b/configure.ac
@@ -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
index 0000000..7e9362f
--- /dev/null
+++ b/doc/chickadee.texi
@@ -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
index 0000000..9c3bbe5
--- /dev/null
+++ b/doc/fdl.texi
@@ -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
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
index 0000000..d06155f
--- /dev/null
+++ b/pre-inst-env.in
@@ -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 "$@"
generated by cgit v1.2.3 (git 2.25.4) at 2024-12-22 20:56:25 +0000