First commit!

16 files changed, 2768 insertions, 0 deletions

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)))