Rename guile-2d to Sly!

Massive find/replace job.
author: David Thompson <dthompson2@worcester.edu> 2014-06-28 18:46:16 -0400
committer: David Thompson <dthompson2@worcester.edu> 2014-06-28 18:46:16 -0400
commit: f47eb69a354188154731846dde8b384c2c2f39f6 (patch)
tree: 6aa1ccb9212836b7c941e771475eb995fa6df9f9 /2d
parent: df0f2a5f3f09394f1953abbc7e33e9a98204680e (diff)
28 files changed, 0 insertions, 3802 deletions
diff --git a/2d/agenda.scm b/2d/agenda.scm
deleted file mode 100644
index ab36f23..0000000
--- a/2d/agenda.scm
+++ /dev/null
@@ -1,206 +0,0 @@
-;;; guile-2d
-;;; Copyright (C) 2013, 2014 David Thompson <dthompson2@worcester.edu>
-;;;
-;;; This program 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.
-;;;
-;;; This program 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:
-;;
-;; Deferred procedure scheduling.
-;;
-;;; Code:
-
-(define-module (2d agenda)
-  #:use-module (ice-9 q)
-  #:use-module (srfi srfi-1)
-  #:use-module (srfi srfi-9)
-  #:use-module (srfi srfi-26)
-  #:use-module (2d coroutine)
-  #:export (make-agenda
-            agenda?
-            agenda-time
-            current-agenda
-            with-agenda
-            tick-agenda!
-            clear-agenda!
-            schedule
-            schedule-interval
-            schedule-each
-            wait))
-
-;; This code is a modified version of the agenda implementation in
-;; SICP. Thank you, SICP!
-
-;;;
-;;; Time segment
-;;;
-
-(define-record-type <time-segment>
-  (%make-time-segment time queue)
-  time-segment?
-  (time segment-time)
-  (queue segment-queue))
-
-(define (make-time-segment time . callbacks)
-  "Create a new time segment at TIME and enqueues everything in the
-list CALLBACKS."
-  (let ((segment (%make-time-segment time (make-q))))
-    ;; Enqueue all callbacks
-    (for-each (cut segment-enq segment <>) callbacks)
-    segment))
-
-(define (segment-enq segment callback)
-  "Add the CALLBACK procedure to SEGMENT's queue."
-  (enq! (segment-queue segment) callback))
-
-;;;
-;;; Agenda
-;;;
-
-(define-record-type <agenda>
-  (%make-agenda time segments)
-  agenda?
-  (time %agenda-time set-agenda-time!)
-  (segments agenda-segments set-agenda-segments!))
-
-(define (make-agenda)
-  "Create a new, empty agenda."
-  (%make-agenda 0 '()))
-
-(define (agenda-empty? agenda)
-  "Return #t if AGENDA has no scheduled procedures."
-  (null? (agenda-segments agenda)))
-
-(define (first-segment agenda)
-  "Return the first time segment in AGENDA."
-  (car (agenda-segments agenda)))
-
-(define (rest-segments agenda)
-  "Return everything but the first segment in AGENDA."
-  (cdr (agenda-segments agenda)))
-
-(define (agenda-add-segment agenda time callback)
-  "Add a new time segment to the beginning of AGENDA at the given TIME
-and enqueue CALLBACK."
-  (set-agenda-segments! agenda
-                        (cons (make-time-segment time callback)
-                              (agenda-segments agenda))))
-
-(define (insert-segment segments time callback)
-  "Insert a new time segment after the first segment in SEGMENTS."
-  (set-cdr! segments
-            (cons (make-time-segment time callback)
-                  (cdr segments))))
-
-(define (first-agenda-item agenda)
-  "Return the first time segment queue in AGENDA."
-  (if (agenda-empty? agenda)
-      (error "Agenda is empty")
-      (segment-queue (first-segment agenda))))
-
-(define (agenda-time-delay agenda dt)
-  "Return the sum of the time delta, DT, and the current time of AGENDA."
-  (+ (%agenda-time agenda) (inexact->exact (round dt))))
-
-(define (flush-queue! q)
-  "Dequeue and execute every member of Q."
-  (unless (q-empty? q)
-    ((deq! q)) ;; Execute scheduled procedure
-    (flush-queue! q)))
-
-(define (%tick-agenda! agenda)
-  "Move AGENDA forward in time and run scheduled procedures."
-  (set-agenda-time! agenda (1+ (%agenda-time agenda)))
-  (let next-segment ()
-    (unless (agenda-empty? agenda)
-      (let ((segment (first-segment agenda)))
-        ;; Process time segment if it is scheduled before or at the
-        ;; current agenda time.
-        (when (>= (%agenda-time agenda) (segment-time segment))
-          (flush-queue! (segment-queue segment))
-          (set-agenda-segments! agenda (rest-segments agenda))
-          (next-segment))))))
-
-(define (%clear-agenda! agenda)
-  "Remove all scheduled procedures from AGENDA."
-  (set-agenda-segments! agenda '()))
-
-(define (%schedule agenda thunk delay)
-  "Schedule THUNK to be run after DELAY ticks of AGENDA."
-  (let ((time (agenda-time-delay agenda delay)))
-    (define (belongs-before? segments)
-      (or (null? segments)
-          (< time (segment-time (car segments)))))
-
-    (define (add-to-segments segments)
-      ;; Add to existing time segment if the times match
-      (if (= (segment-time (car segments)) time)
-          (segment-enq (car segments) thunk)
-          ;; Continue searching
-          (if (belongs-before? (cdr segments))
-              ;; Create new time segment and insert it where it belongs
-              (insert-segment segments time thunk)
-              ;; Continue searching
-              (add-to-segments (cdr segments)))))
-
-    (if (belongs-before? (agenda-segments agenda))
-        (agenda-add-segment agenda time thunk)
-        (add-to-segments (agenda-segments agenda)))))
-
-(define current-agenda
-  (make-parameter (make-agenda)
-                  (lambda (val)
-                    (if (agenda? val)
-                        val
-                        (error "Must be an agenda")))))
-
-(define-syntax-rule (with-agenda agenda body ...)
-  (parameterize ((current-agenda agenda))
-    body ...))
-
-(define (agenda-time)
-  "Return the time of the current agenda."
-  (%agenda-time (current-agenda)))
-
-(define (tick-agenda!)
-  "Increment time for the current agenda and run scheduled
-procedures."
-  (%tick-agenda! (current-agenda)))
-
-(define (clear-agenda!)
-  "Remove all scheduled procedures from the current agenda."
-  (%clear-agenda! (current-agenda)))
-
-(define* (schedule thunk #:optional (delay 1))
-  "Schedule THUNK to be applied after DELAY ticks of the current
-agenda, or 1 tick if DELAY is not specified."
-  (%schedule (current-agenda) thunk delay))
-
-(define (schedule-interval thunk interval)
-  "Schedule THUNK to be applied every INTERVAL ticks of the current
-agenda."
-  (coroutine
-   (while #t
-     (wait interval)
-     (thunk))))
-
-(define (schedule-each thunk)
-  "Schedule THUNK to be applied upon every tick of the current
-agenda."
-  (schedule-interval thunk 1))
-
-(define (wait delay)
-  "Abort coroutine and schedule the continuation to be run after DELAY
-ticks of the current agenda."
-  (yield (cut schedule <> delay)))
diff --git a/2d/animation.scm b/2d/animation.scm
deleted file mode 100644
index 4998036..0000000
--- a/2d/animation.scm
+++ /dev/null
@@ -1,119 +0,0 @@
-;;; guile-2d
-;;; Copyright (C) 2013, 2014 David Thompson <dthompson2@worcester.edu>
-;;;
-;;; This program 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.
-;;;
-;;; This program 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:
-;;
-;; Animations represent a sequence of textures and/or texture regions.
-;;
-;;; Code:
-
-(define-module (2d animation)
-  #:use-module (srfi srfi-9)
-  #:use-module (2d texture))
-
-;;;
-;;; Animations
-;;;
-
-;; The <animation> type represents a vector of textures or texture
-;; regions that are to be played in sequence and possibly looped.
-(define-record-type <animation>
-  (make-animation frames frame-duration loop)
-  animation?
-  (frames animation-frames)
-  (frame-duration animation-frame-duration)
-  (loop animation-loop?))
-
-(define (animation-frame animation index)
-  "Return the texture for the given frame INDEX of ANIMATION."
-  (vector-ref (animation-frames animation) index))
-
-(define (animation-length animation)
-  "Return the number of frames in ANIMATION."
-  (vector-length (animation-frames animation)))
-
-(define (animation-duration animation)
-  "Return the total duration of ANIMATION in ticks."
-  (* (animation-length animation)
-     (animation-frame-duration animation)))
-
-(export make-animation
-        animation?
-        animation-frames
-        animation-frame-duration
-        animation-loop?
-        animation-frame
-        animation-length
-        animation-duration)
-
-;; The <animator> type encapsulates the state for playing an
-;; animation.
-(define-record-type <animator>
-  (%make-animator animation frame time playing)
-  animator?
-  (animation animator-animation)
-  (frame animator-frame set-animator-frame!)
-  (time animator-time set-animator-time!)
-  (playing animator-playing? set-animator-playing!))
-
-(define (make-animator animation)
-  "Create a new animator for ANIMATION."
-  (%make-animator animation 0 0 #t))
-
-(define (animator-frame-complete? animator)
-  "Return #t when ANIMATOR is done displaying the current frame."
-  (>= (animator-time animator)
-      (animation-frame-duration (animator-animation animator))))
-
-(define (animator-next-frame animator)
-  "Return the next frame index for ANIMATOR."
-  (modulo (1+ (animator-frame animator))
-          (animation-length (animator-animation animator))))
-
-(define (animator-texture animator)
-  "Return a texture for the ANIMATOR's current frame."
-  (animation-frame (animator-animation animator)
-                   (animator-frame animator)))
-
-(define (animator-next! animator)
-  "Advance ANIMATOR to the next frame of its animation."
-  (let ((next-frame (animator-next-frame animator))
-        (animation (animator-animation animator)))
-    (set-animator-time! animator 0)
-    (set-animator-frame! animator next-frame)
-    (set-animator-playing! animator (or (not (zero? next-frame))
-                                        (animation-loop? animation)))))
-
-(define (animator-update! animator)
-  "Increment the frame time for the ANIMATOR and advance to the next
-frame when necessary."
-  (when (animator-playing? animator)
-    (set-animator-time! animator (1+ (animator-time animator)))
-    (when (animator-frame-complete? animator)
-      (animator-next! animator))))
-
-(export make-animator
-        animator?
-        animator-animation
-        animator-frame
-        animator-time
-        animator-frame-complete?
-        animator-playing?
-        animator-next-frame
-        animator-texture
-        animator-next!
-        animator-update!)
diff --git a/2d/audio.scm b/2d/audio.scm
deleted file mode 100644
index 3accb8b..0000000
--- a/2d/audio.scm
+++ /dev/null
@@ -1,128 +0,0 @@
-;;; guile-2d
-;;; Copyright (C) 2013, 2014 David Thompson <dthompson2@worcester.edu>
-;;;
-;;; This program 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.
-;;;
-;;; This program 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:
-;;
-;; Wrappers over SDL mixer.
-;;
-;;; Code:
-
-(define-module (2d audio)
-  #:use-module (srfi srfi-9)
-  #:use-module (srfi srfi-2)
-  #:use-module ((sdl mixer) #:prefix SDL:)
-  #:export (enable-audio
-            load-sample
-            sample?
-            sample-audio
-            sample-volume
-            set-sample-volume
-            play-sample
-            load-music
-            music?
-            music-audio
-            music-volume
-            play-music
-            set-music-volume
-            pause-music
-            resume-music
-            rewind-music
-            stop-music
-            music-paused?
-            music-playing?))
-
-(define (enable-audio)
-  (SDL:open-audio))
-
-;; Used to wrap SDL audio functions whose return values should be
-;; ignored.
-(define-syntax-rule (ignore-value body ...)
-  (begin
-    body ...
-    *unspecified*))
-
-;; Wrapper over SDL audio objects.
-(define-record-type <sample>
-  (make-sample audio)
-  sample?
-  (audio sample-audio))
-
-(define (load-sample filename)
-  "Load audio sample from FILENAME or return #f if the file cannot be
-loaded"
-  (let ((audio (SDL:load-wave filename)))
-    (if audio (make-sample audio) #f)))
-
-(define (sample-volume)
-  "Return the volume that all samples are played at."
-  (SDL:volume))
-
-(define (set-sample-volume volume)
-  "Set the volume that all samples are played at to VOLUME."
-  (ignore-value (SDL:volume volume)))
-
-(define (play-sample sample)
-  "Play the given audio SAMPLE."
-  (ignore-value (SDL:play-channel (sample-audio sample))))
-
-;; Wrapper over SDL music objects.
-(define-record-type <music>
-  (make-music audio)
-  music?
-  (audio music-audio))
-
-(define (load-music filename)
-  "Load music from FILENAME or return #f if the file cannot be
-loaded."
-  (let ((audio (SDL:load-music filename)))
-    (if audio (make-music audio) #f)))
-
-(define (music-volume)
-  "Return the volume that music is played at."
-  (SDL:music-volume))
-
-(define (set-music-volume volume)
-  "Set the volume that music is played at to VOLUME."
-  (ignore-value (SDL:volume volume)))
-
-(define (play-music music)
-  "Play the given MUSIC."
-  (ignore-value (SDL:play-music (music-audio music))))
-
-(define (pause-music)
-  "Pause the current music track."
-  (ignore-value (SDL:pause-music)))
-
-(define (resume-music)
-  "Resume the current music track."
-  (ignore-value (SDL:resume-music)))
-
-(define (rewind-music)
-  "Restart the current music track."
-  (ignore-value (SDL:rewind-music)))
-
-(define (stop-music)
-  "Stop playing the current music track."
-  (ignore-value (SDL:halt-music)))
-
-(define (music-playing?)
-  "Return #t if music is currently playing, otherwise return #f."
-  (SDL:playing-music?))
-
-(define (music-paused?)
-  "Return #t if music is currently paused, otherwise return #f."
-  (SDL:paused-music?))
diff --git a/2d/color.scm b/2d/color.scm
deleted file mode 100644
index d3aba00..0000000
--- a/2d/color.scm
+++ /dev/null
@@ -1,203 +0,0 @@
-;;; guile-2d
-;;; Copyright (C) 2013, 2014 David Thompson <dthompson2@worcester.edu>
-;;;
-;;; This program 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.
-;;;
-;;; This program 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:
-;;
-;; Color.
-;;
-;;; Code:
-
-(define-module (2d color)
-  #:use-module (gl)
-  #:use-module (srfi srfi-9)
-  #:use-module (srfi srfi-1)
-  #:use-module (2d math)
-  #:export (<color>
-            make-color
-            color?
-            color-r
-            color-g
-            color-b
-            color-a
-            rgba
-            rgb
-            color*
-            color+
-            color-
-            color-inverse
-            white
-            black
-            red
-            green
-            blue
-            yellow
-            magenta
-            cyan
-            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))
-
-(define (color* a b)
-  "Multiply the RGBA channels of colors A and B."
-  (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+ a b)
-  "Add the RGBA channels of colors A and B."
-  (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- a b)
-  "Subtract the RGBA channels of colors A and B."
-  (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-inverse color)
-  "Create a new color that is the inverse of COLOR.  The alpha channel
-is left unchanged."
-  (make-color (- 1 (color-r color))
-              (- 1 (color-g color))
-              (- 1 (color-b color))
-              (color-a 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))
-
-;; 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/2d/config.scm.in b/2d/config.scm.in
deleted file mode 100644
index e62a2b1..0000000
--- a/2d/config.scm.in
+++ /dev/null
@@ -1,28 +0,0 @@
-;;; guile-2d
-;;; Copyright (C) 2014 David Thompson <dthompson2@worcester.edu>
-;;;
-;;; Guile-2d is free software: you can redistribute it and/or modify it
-;;; under the terms of the GNU Lesser General Public License as
-;;; published by the Free Software Foundation, either version 3 of the
-;;; License, or (at your option) any later version.
-;;;
-;;; Guile-2d 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 (2d config)
-  #:export (%pkgdatadir))
-
-(define %pkgdatadir
-  (or (getenv "GUILE_2D_PKGDATADIR") "@pkgdatadir@"))
diff --git a/2d/coroutine.scm b/2d/coroutine.scm
deleted file mode 100644
index b8e1df9..0000000
--- a/2d/coroutine.scm
+++ /dev/null
@@ -1,82 +0,0 @@
-;;; guile-2d
-;;; Copyright (C) 2013, 2014 David Thompson <dthompson2@worcester.edu>
-;;;
-;;; This program 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.
-;;;
-;;; This program 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:
-;;
-;; Cooperative multi-tasking.
-;;
-;;; Code:
-
-(define-module (2d coroutine)
-  #:export (call-with-coroutine
-            coroutine
-            colambda
-            codefine
-            codefine*)
-  #:replace (yield))
-
-(define (call-with-coroutine thunk)
-  "Apply THUNK with a coroutine prompt."
-  (define (handler cont callback . args)
-    (define (resume . args)
-      ;; Call continuation that resumes the procedure.
-      (call-with-prompt 'coroutine-prompt
-			(lambda () (apply cont args))
-			handler))
-    (when (procedure? callback)
-      (apply callback resume args)))
-
-  ;; Call procedure.
-  (call-with-prompt 'coroutine-prompt thunk handler))
-
-;; emacs: (put 'coroutine 'scheme-indent-function 0)
-(define-syntax-rule (coroutine body ...)
-  "Evaluate BODY as a coroutine."
-  (call-with-coroutine (lambda () body ...)))
-
-;; emacs: (put 'colambda 'scheme-indent-function 1)
-(define-syntax-rule (colambda args body ...)
-  "Syntacic sugar for a lambda that is run as a coroutine."
-  (lambda args
-    (call-with-coroutine
-     (lambda () body ...))))
-
-;; emacs: (put 'codefine 'scheme-indent-function 1)
-(define-syntax-rule (codefine (name ...) . body)
-  "Syntactic sugar for defining a procedure that is run as a
-coroutine."
-  (define (name ...)
-    ;; Create an inner procedure with the same signature so that a
-    ;; recursive procedure call does not create a new prompt.
-    (define (name ...) . body)
-    (call-with-coroutine
-      (lambda () (name ...)))))
-
-;; emacs: (put 'codefine* 'scheme-indent-function 1)
-(define-syntax-rule (codefine* (name . formals) . body)
-  "Syntactic sugar for defining a procedure that is run as a
-coroutine."
-  (define (name . args)
-    ;; Create an inner procedure with the same signature so that a
-    ;; recursive procedure call does not create a new prompt.
-    (define* (name . formals) . body)
-    (call-with-coroutine
-     (lambda () (apply name args)))))
-
-(define (yield callback)
-  "Yield continuation to a CALLBACK procedure."
-  (abort-to-prompt 'coroutine-prompt callback))
diff --git a/2d/event.scm b/2d/event.scm
deleted file mode 100644
index 7badf72..0000000
--- a/2d/event.scm
+++ /dev/null
@@ -1,45 +0,0 @@
-;;; guile-2d
-;;; Copyright (C) 2013, 2014 David Thompson <dthompson2@worcester.edu>
-;;;
-;;; This program 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.
-;;;
-;;; This program 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:
-;;
-;; SDL event handlers.
-;;
-;;; Code:
-
-(define-module (2d event)
-  #:use-module ((sdl sdl) #:prefix SDL:)
-  #:export (process-events
-            register-event-handler))
-
-(define process-events
-  (let ((e (SDL:make-event)))
-    (lambda ()
-      "Process all events in the input event queue."
-      (while (SDL:poll-event e)
-        (handle-event e)))))
-
-(define event-handlers (make-hash-table))
-
-(define (register-event-handler event-type proc)
-  (hashq-set! event-handlers event-type proc))
-
-(define (handle-event e)
-  "Run the relevant hook for the event E."
-  (let ((handle (hashq-get-handle event-handlers (SDL:event:type e))))
-    (when handle
-      ((cdr handle) e))))
diff --git a/2d/font.scm b/2d/font.scm
deleted file mode 100644
index 909f351..0000000
--- a/2d/font.scm
+++ /dev/null
@@ -1,156 +0,0 @@
-;;; guile-2d
-;;; Copyright (C) 2013, 2014 David Thompson <dthompson2@worcester.edu>
-;;;
-;;; This program 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.
-;;;
-;;; This program 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:
-;;
-;; Font rendering.
-;;
-;;; Code:
-
-(define-module (2d font)
-  #:use-module (srfi srfi-2)
-  #:use-module (srfi srfi-9)
-  #:use-module (system foreign)
-  #:use-module ((sdl sdl) #:prefix SDL:)
-  #:use-module ((sdl ttf) #:prefix SDL:)
-  #:use-module (gl)
-  #:use-module (gl contrib packed-struct)
-  #:use-module (2d color)
-  #:use-module (2d config)
-  #:use-module (2d shader)
-  #:use-module (2d signal)
-  #:use-module (2d texture)
-  #:use-module (2d vector)
-  #:use-module (2d window)
-  #:use-module (2d wrappers gl)
-  #:export (enable-fonts
-            load-font
-            load-default-font
-            font?
-            font-point-size
-            make-label
-            label?
-            label-font
-            label-text
-            label-position
-            label-color
-            draw-label))
-
-;;;
-;;; Font
-;;;
-
-(define font-shader #f)
-
-(define (enable-fonts)
-  (SDL:ttf-init)
-  (set! font-shader
-        (load-shader-program
-         (string-append %pkgdatadir
-                        "/shaders/font-vertex.glsl")
-         (string-append %pkgdatadir
-                        "/shaders/font-fragment.glsl"))))
-
-(define-record-type <font>
-  (make-font ttf point-size)
-  font?
-  (ttf font-ttf)
-  (point-size font-point-size))
-
-(define (load-font filename point-size)
-  "Load the TTF font in FILENAME with the given POINT-SIZE."
-  (if (file-exists? filename)
-      (make-font (SDL:load-font filename point-size) point-size)
-      (error "File not found!" filename)))
-
-(define* (load-default-font #:optional (point-size 12))
-  "Load the guile-2d default TTF font.  POINT-SIZE is an optional
-argument with a default value of 12."
-  (load-font (string-append %pkgdatadir "/fonts/DejaVuSans.ttf") point-size))
-
-(define (render-text font text)
-  "Return a new texture with TEXT rendered using FONT."
-  ;; An empty string will result in a surface value of #f, in which we
-  ;; want to abort the texture creation process.
-  (and-let* ((surface (SDL:render-utf8 (font-ttf font) text
-                                       (SDL:make-color 255 255 255) #t))
-             (pixels (SDL:surface-pixels surface))
-             (texture-id (gl-generate-texture)))
-    (with-gl-bind-texture (texture-target texture-2d) texture-id
-      (gl-texture-parameter (texture-target texture-2d)
-                            (texture-parameter-name texture-min-filter)
-                            (texture-min-filter nearest))
-      (gl-texture-parameter (texture-target texture-2d)
-                            (texture-parameter-name texture-mag-filter)
-                            (texture-mag-filter nearest))
-      (gl-texture-image-2d (texture-target texture-2d)
-                           0
-                           (pixel-format rgba)
-                           (SDL:surface:w surface)
-                           (SDL:surface:h surface)
-                           0
-                           (version-1-2 bgra)
-                           (color-pointer-type unsigned-byte)
-                           pixels))
-    (make-texture texture-id #f
-                  (SDL:surface:w surface)
-                  (SDL:surface:h surface)
-                  0 0 1 1)))
-
-(define-record-type <label>
-  (%make-label font text position anchor color texture vertices)
-  label?
-  (font label-font)
-  (text label-text)
-  (position label-position)
-  (anchor label-anchor)
-  (color label-color)
-  (texture label-texture)
-  (vertices label-vertices))
-
-(define (make-label-vertices texture)
-  "Return a packed array of vertices for TEXTURE."
-  (let ((vertices (make-packed-array texture-vertex 4)))
-    (pack-texture-vertices vertices 0
-                           (texture-width texture)
-                           (texture-height texture)
-                           (texture-s1 texture)
-                           (texture-t1 texture)
-                           (texture-s2 texture)
-                           (texture-t2 texture))
-    vertices))
-
-(define* (make-label font text position #:optional #:key
-                     (color white) (anchor 'top-left))
-  "Return a new label containing the string TEXT rendered with FONT at
-the given position.  Optional arguments are COLOR with a default of
-white and ANCHOR with a default of 'top-left."
-  (let* ((texture (render-text font text))
-         (vertices (and texture (make-label-vertices texture)))
-         (anchor (if texture (anchor-texture texture anchor) #(0 0))))
-    (%make-label font text position anchor color texture vertices)))
-
-(define (draw-label label)
-  "Draw LABEL on the screen."
-  (when (label-texture label)
-    (with-shader-program font-shader
-      (uniforms ((projection (signal-ref window-projection))
-                 (position (label-position label))
-                 (anchor (label-anchor label))
-                 (color (label-color label)))
-        (draw-texture-vertices (label-texture label) (label-vertices label) 1))))
-  *unspecified*)
diff --git a/2d/fps.scm b/2d/fps.scm
deleted file mode 100644
index 12e652e..0000000
--- a/2d/fps.scm
+++ /dev/null
@@ -1,47 +0,0 @@
-;;; guile-2d
-;;; Copyright (C) 2013, 2014 David Thompson <dthompson2@worcester.edu>
-;;;
-;;; This program 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.
-;;;
-;;; This program 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:
-;;
-;; Frames per second counter.
-;;
-;;; Code:
-
-(define-module (2d fps)
-  #:use-module (2d game)
-  #:use-module (2d signal)
-  #:export (fps))
-
-;; Current frames per second
-(define-signal fps (make-signal 0))
-
-(define accumulate-fps!
-  (let* ((elapsed-time 0)
-         (fps-counter 0))
-    (lambda (dt alpha)
-      (let ((new-time (+ elapsed-time dt))
-            (new-fps (1+ fps-counter)))
-        (if (>= new-time 1000)
-            (begin
-              (signal-set! fps new-fps)
-              (set! fps-counter 0)
-              (set! elapsed-time 0))
-            (begin
-              (set! fps-counter new-fps)
-              (set! elapsed-time new-time)))))))
-
-(add-hook! draw-hook accumulate-fps!)
diff --git a/2d/game.scm b/2d/game.scm
deleted file mode 100644
index d6a0345..0000000
--- a/2d/game.scm
+++ /dev/null
@@ -1,109 +0,0 @@
-;;; guile-2d
-;;; Copyright (C) 2013, 2014 David Thompson <dthompson2@worcester.edu>
-;;;
-;;; This program 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.
-;;;
-;;; This program 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:
-;;
-;; The game loop.
-;;
-;;; Code:
-
-(define-module (2d game)
-  #:use-module (srfi srfi-9)
-  #:use-module ((sdl sdl) #:prefix SDL:)
-  #:use-module (gl)
-  #:use-module (2d agenda)
-  #:use-module (2d event)
-  #:use-module (2d math)
-  #:use-module (2d signal)
-  #:use-module (2d window)
-  #:export (tick-interval
-            max-ticks-per-frame
-            draw-hook
-            start-game-loop
-            stop-game-loop))
-
-;;;
-;;; Game Loop
-;;;
-
-;; Update 60 times per second by default.
-(define tick-interval (floor (/ 1000 60)))
-;; The maximum number of times the game loop will update game state in
-;; a single frame.  When this upper bound is reached due to poor
-;; performance, the game will start to slow down instead of becoming
-;; completely unresponsive and possibly crashing.
-(define max-ticks-per-frame 4)
-(define draw-hook (make-hook 2))
-
-(define (draw dt alpha)
-  "Render a frame."
-  (let ((width (signal-ref window-width))
-        (height (signal-ref window-height)))
-    (gl-viewport 0 0 width height))
-  (gl-clear (clear-buffer-mask color-buffer depth-buffer))
-  (run-hook draw-hook dt alpha)
-  (SDL:gl-swap-buffers))
-
-(define (update lag)
-  "Call the update callback. The update callback will be called as
-many times as tick-interval can divide LAG. The return value
-is the unused accumulator time."
-  (define (iter lag ticks)
-    (cond ((>= ticks max-ticks-per-frame)
-           lag)
-          ((>= lag tick-interval)
-           (tick-agenda!)
-           (iter (- lag tick-interval) (1+ ticks)))
-          (else
-           lag)))
-  (iter lag 0))
-
-(define (alpha lag)
-  "Calculate interpolation factor in the range [0, 1] for the
-leftover frame time LAG."
-  (clamp 0 1 (/ lag tick-interval)))
-
-(define (frame-sleep time)
-  "Sleep for the remainder of the frame that started at TIME."
-  (let ((t (- (+ time tick-interval)
-              (SDL:get-ticks))))
-    (usleep (max 0 (* t 1000)))))
-
-(define (game-loop previous-time lag)
-  "Update game state, and render.  PREVIOUS-TIME is the time in
-milliseconds of the last iteration of the game loop."
-  (let* ((current-time (SDL:get-ticks))
-         (dt (- current-time previous-time)))
-    (process-events)
-    (let ((lag (update (+ lag dt))))
-      (draw dt (alpha lag))
-      (frame-sleep current-time)
-      (game-loop current-time lag))))
-
-(define (start-game-loop)
-  "Start the game loop."
-  (call-with-prompt
-   'game-loop-prompt
-   (lambda ()
-     (game-loop (SDL:get-ticks) 0))
-   (lambda (cont callback)
-     (when (procedure? callback)
-       (callback cont)))))
-
-(define (stop-game-loop)
-  "Abort the game loop."
-  (abort-to-prompt 'game-loop-prompt #f))
diff --git a/2d/helpers.scm b/2d/helpers.scm
deleted file mode 100644
index 4082377..0000000
--- a/2d/helpers.scm
+++ /dev/null
@@ -1,68 +0,0 @@
-;;; guile-2d
-;;; Copyright (C) 2013, 2014 David Thompson <dthompson2@worcester.edu>
-;;; Copyright (C) 2014 Ludovic Courtès <ludo@gnu.org>
-;;;
-;;; This program 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.
-;;;
-;;; This program 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:
-;;
-;; Miscellaneous helper procedures.
-;;
-;;; Code:
-
-(define-module (2d helpers)
-  #:use-module (srfi srfi-1)
-  #:use-module (rnrs arithmetic bitwise)
-  #:use-module (2d agenda)
-  #:use-module (2d game)
-  #:export (any-equal?
-            logand?
-            define-guardian
-            memoize))
-
-(define (any-equal? elem . args)
-  "Return #t if ELEM equals any of the elements in the list ARGS."
-  (any (lambda (e) (equal? elem e)) args))
-
-(define (logand? . args)
-  "Return #t if the result of a bitwise AND of the integers in list
-ARGS is non-zero."
-  (not (zero? (apply logand args))))
-
-(define-syntax-rule (define-guardian name reaper)
-  "Define a new guardian called NAME and call REAPER when an object
-within the guardian is GC'd.  Reaping is ensured to happen from the
-same thread that is running the game loop."
-  (begin
-    (define name (make-guardian))
-    (schedule-each
-     (lambda ()
-       (let reap ((obj (name)))
-         (when obj
-           (reaper obj)
-           (reap (name))))))))
-
-(define (memoize proc)
-  "Return a memoizing version of PROC."
-  (let ((cache (make-hash-table)))
-    (lambda args
-      (let ((results (hash-ref cache args)))
-        (if results
-            (apply values results)
-            (let ((results (call-with-values (lambda ()
-                                               (apply proc args))
-                             list)))
-              (hash-set! cache args results)
-              (apply values results)))))))
diff --git a/2d/keyboard.scm b/2d/keyboard.scm
deleted file mode 100644
index 97bc20a..0000000
--- a/2d/keyboard.scm
+++ /dev/null
@@ -1,88 +0,0 @@
-;;; guile-2d
-;;; Copyright (C) 2013, 2014 David Thompson <dthompson2@worcester.edu>
-;;;
-;;; This program 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.
-;;;
-;;; This program 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:
-;;
-;; Keyboard signals.
-;;
-;;; Code:
-
-(define-module (2d keyboard)
-  #:use-module ((sdl sdl) #:prefix SDL:)
-  #:use-module (2d event)
-  #:use-module (2d signal)
-  #:use-module (2d vector)
-  #:export (key-press-hook
-            key-release-hook
-            key-last-down
-            key-last-up
-            key-down?
-            key-directions
-            key-arrows
-            key-wasd))
-
-(define key-press-hook (make-hook 2))
-
-(register-event-handler
- 'key-down
- (lambda (e)
-   (run-hook key-press-hook
-             (SDL:event:key:keysym:sym e)
-             (SDL:event:key:keysym:unicode e))))
-
-(define-signal key-last-down
-  (hook->signal key-press-hook 'none
-                (lambda (key unicode)
-                  key)))
-
-(define key-release-hook (make-hook 2))
-
-(register-event-handler
- 'key-up
- (lambda (e)
-   (run-hook key-release-hook
-             (SDL:event:key:keysym:sym e)
-             (SDL:event:key:keysym:unicode e))))
-
-(define-signal key-last-up
-  (hook->signal key-release-hook 'none
-                (lambda (key unicode)
-                  key)))
-
-(define (key-down? key)
-  "Create a signal for the state of KEY. The signal value is #t when
-KEY is pressed or #f otherwise."
-  (define (same-key? other-key)
-    (eq? key other-key))
-  (define (key-filter value signal)
-    (signal-constant value (signal-filter same-key? #f signal)))
-  (signal-merge (key-filter #f key-last-up)
-                (key-filter #t key-last-down)))
-
-(define (key-directions up down left right)
-  (signal-map (lambda (up? down? left? right?)
-                (vector (+ (if left? -1 0)
-                           (if right? 1 0))
-                        (+ (if up? -1 0)
-                           (if down? 1 0))))
-              (key-down? up)
-              (key-down? down)
-              (key-down? left)
-              (key-down? right)))
-
-(define-signal key-arrows (key-directions 'up 'down 'left 'right))
-(define-signal key-wasd (key-directions 'w 's 'a 'd))
diff --git a/2d/live-reload.scm b/2d/live-reload.scm
deleted file mode 100644
index 265fa1f..0000000
--- a/2d/live-reload.scm
+++ /dev/null
@@ -1,54 +0,0 @@
-;;; guile-2d
-;;; Copyright (C) 2014 David Thompson <dthompson2@worcester.edu>
-;;;
-;;; This program 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.
-;;;
-;;; This program 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:
-;;
-;; Live asset reloading.
-;;
-;;; Code:
-
-(define-module (2d live-reload)
-  #:use-module (srfi srfi-1)
-  #:use-module (2d agenda)
-  #:use-module (2d coroutine)
-  #:use-module (2d signal)
-  #:export (live-reload-interval
-            live-reload))
-
-(define live-reload-interval 120)
-
-(define (live-reload proc)
-  "Return a new procedure that re-applies PROC whenever the associated
-file is modified.  The new procedure returns a signal that contains
-the return value of PROC.  The first argument to PROC must be a
-filename string."
-  (lambda (filename . args)
-    (define (load-asset)
-      (apply proc filename args))
-
-    (define (current-mtime)
-      (stat:mtime (stat filename)))
-
-    (let ((asset (make-signal (load-asset))))
-     (coroutine
-      (let loop ((last-mtime (current-mtime)))
-        (wait live-reload-interval)
-        (let ((mtime (current-mtime)))
-          (when (> mtime last-mtime)
-            (signal-set! asset (load-asset)))
-          (loop mtime))))
-     asset)))
diff --git a/2d/math.scm b/2d/math.scm
deleted file mode 100644
index ba8d88e..0000000
--- a/2d/math.scm
+++ /dev/null
@@ -1,90 +0,0 @@
-;;; guile-2d
-;;; Copyright (C) 2013, 2014 David Thompson <dthompson2@worcester.edu>
-;;;
-;;; This program 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.
-;;;
-;;; This program 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:
-;;
-;; Miscellaneous math procedures. Currently just trigonometry.
-;;
-;;; Code:
-
-(define-module (2d math)
-  #:export (pi
-            degrees->radians
-            radians->degrees
-            sin-degrees
-            cos-degrees
-            tan-degrees
-            atan-degrees
-            clamp))
-
-;; Dave was editing this module on Pi Approximation Day.
-;;
-;;       3.141592653589793238462643383279
-;;     5028841971693993751058209749445923
-;;    07816406286208998628034825342117067
-;;    9821    48086         5132
-;;   823      06647        09384
-;;  46        09550        58223
-;;  17        25359        4081
-;;            2848         1117
-;;            4502         8410
-;;            2701         9385
-;;           21105        55964
-;;           46229        48954
-;;           9303         81964
-;;           4288         10975
-;;          66593         34461
-;;         284756         48233
-;;         78678          31652        71
-;;        2019091         456485       66
-;;       9234603           48610454326648
-;;      2133936            0726024914127
-;;      3724587             00660631558
-;;      817488               152092096
-;;
-(define pi 3.141592654)
-
-(define (degrees->radians angle)
-  "Convert ANGLE in degrees to radians."
-  (* angle (/ pi 180)))
-
-(define (radians->degrees angle)
-  "Convert ANGLE in radians to degrees."
-  (* angle (/ 180 pi)))
-
-(define (sin-degrees angle)
-  "Compute the sin of ANGLE expressed in degrees."
-  (sin (degrees->radians angle)))
-
-(define (cos-degrees angle)
-  "Compute the cosine of ANGLE expressed in degrees."
-  (cos (degrees->radians angle)))
-
-(define (tan-degrees angle)
-  "Compute the tangent of ANGLE expressed in degrees."
-  (tan (degrees->radians angle)))
-
-(define (atan-degrees y x)
-  "Compute the arctangent in degrees of the coordinates Y and X."
-  (radians->degrees (atan y x)))
-
-(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/2d/mouse.scm b/2d/mouse.scm
deleted file mode 100644
index 388b139..0000000
--- a/2d/mouse.scm
+++ /dev/null
@@ -1,99 +0,0 @@
-;;; guile-2d
-;;; Copyright (C) 2013, 2014 David Thompson <dthompson2@worcester.edu>
-;;;
-;;; This program 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.
-;;;
-;;; This program 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:
-;;
-;; Keyboard signals.
-;;
-;;; Code:
-
-(define-module (2d mouse)
-  #:use-module ((sdl sdl) #:prefix SDL:)
-  #:use-module (2d event)
-  #:use-module (2d signal)
-  #:use-module (2d vector)
-  #:export (mouse-move-hook
-            mouse-press-hook
-            mouse-click-hook
-            mouse-x
-            mouse-y
-            mouse-position
-            mouse-last-down
-            mouse-last-up
-            mouse-down?))
-
-(define mouse-move-hook (make-hook 2))
-
-(register-event-handler
- 'mouse-motion
- (lambda (e)
-   (run-hook mouse-move-hook
-             (SDL:event:motion:x e)
-             (SDL:event:motion:y e))))
-
-(define-signal mouse-position
-  (hook->signal mouse-move-hook
-                #(0 0)
-                (lambda (x y)
-                  (vector x y))))
-
-(define-signal mouse-x (signal-map vx mouse-position))
-(define-signal mouse-y (signal-map vy mouse-position))
-
-(define mouse-press-hook (make-hook 3))
-
-(register-event-handler
- 'mouse-button-down
- (lambda (e)
-   (run-hook mouse-press-hook
-             (SDL:event:button:button e)
-             (SDL:event:button:x e)
-             (SDL:event:button:y e))))
-
-(define-signal mouse-last-down
-  (hook->signal mouse-press-hook
-                'none
-                (lambda (button x y)
-                  button)))
-
-(define mouse-click-hook (make-hook 3))
-
-(register-event-handler
- 'mouse-button-up
- (lambda (e)
-   (run-hook mouse-click-hook
-             (SDL:event:button:button e)
-             (SDL:event:button:x e)
-             (SDL:event:button:y e))))
-
-(define-signal mouse-last-up
-  (hook->signal mouse-click-hook
-                'none
-                (lambda (button x y)
-                  button)))
-
-(define (mouse-down? button)
-  "Create a signal for the state of BUTTON. Value is #t when mouse
-button is pressed or #f otherwise."
-  (define (same-button? other-button)
-    (eq? button other-button))
-
-  (define (button-filter value signal)
-    (signal-constant value (signal-filter #f same-button? signal)))
-
-  (signal-merge (button-filter #f mouse-last-up)
-                (button-filter #t mouse-last-down)))
diff --git a/2d/rect.scm b/2d/rect.scm
deleted file mode 100644
index 3a74ae2..0000000
--- a/2d/rect.scm
+++ /dev/null
@@ -1,212 +0,0 @@
-;;; guile-2d
-;;; Copyright (C) 2013, 2014 David Thompson <dthompson2@worcester.edu>
-;;;
-;;; This program 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.
-;;;
-;;; This program 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:
-;;
-;; Rects are axis-aligned bounding boxes that can be used for
-;; performing simple collision detection.
-;;
-;;; Code:
-
-(define-module (2d rect)
-  #:use-module (srfi srfi-9)
-  #:use-module (2d vector)
-  #:export (<rect>
-            make-rect
-            null-rect
-            rect?
-            rect-x
-            rect-y
-            rect-left
-            rect-right
-            rect-top
-            rect-bottom
-            rect-position
-            rect-top-left
-            rect-top-right
-            rect-bottom-left
-            rect-bottom-right
-            rect-center-x
-            rect-center-y
-            rect-center
-            rect-half-width
-            rect-half-height
-            rect-width
-            rect-height
-            rect-size
-            rect-move
-            rect-inflate
-            rect-union
-            rect-clip
-            rect-within?
-            rect-intersects?
-            rect-contains?))
-
-;;;
-;;; Rectangles
-;;;
-
-;; The rect API is very similar to the Pygame rect API, but rects are
-;; immutable.
-
-(define-record-type <rect>
-  (%make-rect x y width height)
-  rect?
-  (x rect-x)
-  (y rect-y)
-  (width rect-width)
-  (height rect-height))
-
-(define make-rect
-  (case-lambda
-    ((x y width height)
-     (%make-rect x y width height))
-    ((position size)
-     (%make-rect (vx position) (vy position)
-                 (vx size) (vy size)))))
-
-(define null-rect (make-rect 0 0 0 0))
-
-(define (rect-right rect)
-  (+ (rect-x rect) (rect-width rect)))
-
-(define rect-left rect-x)
-
-(define rect-top rect-y)
-
-(define (rect-bottom rect)
-  (+ (rect-y rect) (rect-height rect)))
-
-(define (rect-position rect)
-  "Return the top-left corner of RECT as a vector."
-  (vector (rect-x rect)
-          (rect-y rect)))
-
-(define rect-top-left rect-position)
-
-(define (rect-top-right rect)
-  (vector (rect-right rect)
-          (rect-top   rect)))
-
-(define (rect-bottom-left rect)
-  (vector (rect-left   rect)
-          (rect-bottom rect)))
-
-(define (rect-bottom-right rect)
-  (vector (rect-right  rect)
-          (rect-bottom rect)))
-
-(define (rect-center-x rect)
-  (+ (rect-x rect) (rect-half-width rect)))
-
-(define (rect-center-y rect)
-  (+ (rect-y rect) (rect-half-height rect)))
-
-(define (rect-center rect)
-  (vector (rect-center-x rect)
-          (rect-center-y rect)))
-
-(define (rect-half-width rect)
-  (/ (rect-width rect) 2))
-
-(define (rect-half-height rect)
-  (/ (rect-height rect) 2))
-
-(define (rect-size rect)
-  "Return the size of RECT as a vector."
-  (vector (rect-width rect)
-          (rect-height rect)))
-
-(define (%rect-move rect x y)
-  "Move RECT by the offset X, Y."
-  (make-rect (+ (rect-x rect) x)
-             (+ (rect-y rect) y)
-             (rect-width rect)
-             (rect-height rect)))
-
-(define rect-move
-  (case-lambda
-    "Create a new rectangle by moving RECT by the given
-offset. rect-move accepts a vector or x and y coordinates as separate
-arguments."
-    ((rect v)
-     (%rect-move rect (vx v) (vy v)))
-    ((rect x y)
-     (%rect-move rect x y))))
-
-(define (%rect-inflate rect width height)
-  "Grows the rect by the given amount. The rect stays centered around
-its current center."
-  (make-rect (+ (rect-x rect) (/ width 2))
-             (+ (rect-y rect) (/ height 2))
-             (+ (rect-width rect) width)
-             (+ (rect-height rect) height)))
-
-(define rect-inflate
-  (case-lambda
-    "Create a new rectangle by growing RECT by the given amount
-without changing the center point. rect-inflate accepts a vector or x
-and y coordinates as separate arguments."
-    ((rect v)
-     (%rect-inflate rect (vx v) (vy v)))
-    ((rect x y)
-     (%rect-inflate rect x y))))
-
-(define (rect-union rect1 rect2)
-  "Return a rect that covers the area of RECT1 and RECT2."
-  (let ((x1 (min (rect-left   rect1) (rect-left   rect2)))
-        (x2 (max (rect-right  rect1) (rect-right  rect2)))
-        (y1 (min (rect-top    rect1) (rect-top    rect2)))
-        (y2 (max (rect-bottom rect1) (rect-bottom rect2))))
-    (make-rect x1 y1 (- x2 x1) (- y2 y1))))
-
-(define (rect-clip rect1 rect2)
-  "Return the overlapping region of RECT1 and RECT2. If the rects do
-not overlap, a rect of size 0 is returned."
-  (let ((x1 (max (rect-left   rect1) (rect-left   rect2)))
-        (x2 (min (rect-right  rect1) (rect-right  rect2)))
-        (y1 (max (rect-top    rect1) (rect-top    rect2)))
-        (y2 (min (rect-bottom rect1) (rect-bottom rect2))))
-    (make-rect x1 y1 (max (- x2 x1) 0) (max (- y2 y1) 0))))
-
-(define (rect-within? rect1 rect2)
-  "Return #t if RECT2 is completely within RECT1."
-  (and (>= (rect-left   rect2) (rect-left   rect1))
-       (<= (rect-right  rect2) (rect-right  rect1))
-       (>= (rect-top    rect2) (rect-top    rect1))
-       (<= (rect-bottom rect2) (rect-bottom rect1))))
-
-(define (rect-intersects? rect1 rect2)
-  "Return #t if RECT2 overlaps RECT1."
-  (and (< (rect-left   rect1) (rect-right  rect2))
-       (> (rect-right  rect1) (rect-left   rect2))
-       (< (rect-top    rect1) (rect-bottom rect2))
-       (> (rect-bottom rect1) (rect-top    rect2))))
-
-(define (%rect-contains? rect x y)
-  (and (>= x (rect-left   rect))
-       (<= x (rect-right  rect))
-       (>= y (rect-top    rect))
-       (<= y (rect-bottom rect))))
-
-(define rect-contains?
-  (case-lambda
-    "Return #t if the given point is within RECT."
-    ((rect v)
-     (%rect-contains? rect (vx v) (vy v)))
-    ((rect x y)
-     (%rect-contains? rect x y))))
diff --git a/2d/repl.scm b/2d/repl.scm
deleted file mode 100644
index f48b6d2..0000000
--- a/2d/repl.scm
+++ /dev/null
@@ -1,37 +0,0 @@
-;;; guile-2d
-;;; Copyright (C) 2014 David Thompson <dthompson2@worcester.edu>
-;;;
-;;; This program 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.
-;;;
-;;; This program 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:
-;;
-;; Cooperative REPL server extension.
-;;
-;;; Code:
-
-(define-module (2d repl)
-  #:use-module (system repl coop-server)
-  #:use-module (system repl server)
-  #:use-module (2d agenda)
-  #:export (start-2d-repl))
-
-(define* (start-2d-repl #:optional (port (make-tcp-server-socket #:port 37146)))
-  "Start a cooperative REPL server that listens on the given PORT.  By
-default, this port is 37146.  Additionally, a process is scheduled to
-poll the REPL server upon every tick of the game loop."
-  (let ((server (spawn-coop-repl-server port)))
-    (schedule-each
-     (lambda ()
-       (poll-coop-repl-server server)))))
diff --git a/2d/shader.scm b/2d/shader.scm
deleted file mode 100644
index 56a4e03..0000000
--- a/2d/shader.scm
+++ /dev/null
@@ -1,331 +0,0 @@
-;;; guile-2d
-;;; Copyright (C) 2014 David Thompson <dthompson2@worcester.edu>
-;;;
-;;; This program 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.
-;;;
-;;; This program 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 (2d shader)
-  #:use-module (system foreign)
-  #:use-module (rnrs bytevectors)
-  #:use-module (srfi srfi-1)
-  #:use-module (srfi srfi-4)
-  #:use-module (srfi srfi-9)
-  #:use-module (ice-9 rdelim)
-  #:use-module (gl)
-  #:use-module (gl low-level)
-  #:use-module (2d helpers)
-  #:use-module (2d transform)
-  #:use-module (2d vector)
-  #:use-module (2d color)
-  #:use-module (2d wrappers gl)
-  #:export (make-shader
-            make-vertex-shader
-            make-fragment-shader
-            load-shader
-            load-vertex-shader
-            load-fragment-shader
-            shader?
-            vertex-shader?
-            fragment-shader?
-            shader-compiled?
-            shader-type
-            shader-id
-            make-shader-program
-            load-shader-program
-            shader-program-id
-            shader-program?
-            shader-program-linked?
-            with-shader-program
-            %uniform-setters
-            register-uniform-setter!
-            uniforms))
-
-(define-syntax-rule (define-logger name length-proc log-proc)
-  (define (name obj)
-    (let ((log-length (u32vector 0)))
-      (length-proc obj (version-2-0 info-log-length)
-                   (bytevector->pointer log-length))
-      (let ((log (make-u8vector (1+ (u32vector-ref log-length 0)))))
-        (log-proc obj (u32vector-ref log-length 0) %null-pointer
-                  (bytevector->pointer log))
-        (format #t "~a\n" (utf8->string log))))))
-
-(define-syntax-rule (define-status name status-proc status-name)
-  (define (name obj)
-    (let ((status (u32vector 0)))
-      (status-proc obj (version-2-0 status-name)
-                   (bytevector->pointer status))
-      (= (u32vector-ref status 0) 1))))
-
-;;;
-;;; Shaders
-;;;
-
-(define-record-type <shader>
-  (%make-shader type id)
-  shader?
-  (type shader-type)
-  (id shader-id))
-
-(define (vertex-shader? shader)
-  "Return #t if SHADER is a vertex shader, #f otherwise."
-  (eq? (shader-type shader) 'vertex))
-
-(define (fragment-shader? shader)
-  "Return #t if SHADER is a fragment shader, #f otherwise."
-  (eq? (shader-type shader) 'fragment))
-
-(define-guardian shader-guardian
-  (lambda (shader)
-    (false-if-exception
-     (glDeleteShader (shader-id shader)))))
-
-;; Reap GL shaders when their wrapper objects are GC'd.
-(define-guardian shader-guardian
-  (lambda (shader)
-    (false-if-exception (glDeleteShader (shader-id shader)))))
-
-(define-status %shader-compiled? glGetShaderiv compile-status)
-
-(define (shader-compiled? shader)
-  (%shader-compiled? (shader-id shader)))
-
-(define-logger %display-compilation-error glGetShaderiv glGetShaderInfoLog)
-
-(define (display-compilation-error shader)
-  (%display-compilation-error (shader-id shader)))
-
-(define (compile-shader shader)
-  "Attempt to compiler SHADER.  Compilation errors are written to
-stdout."
-  (glCompileShader (shader-id shader))
-  (unless (shader-compiled? shader)
-    (display "Failed to compile shader:\n")
-    (display-compilation-error shader)))
-
-(define (set-shader-source shader source)
-  "Use the GLSL source code in the string SOURCE for SHADER."
-  (let ((length (u32vector (string-length source)))
-        (str (u64vector (pointer-address (string->pointer source)))))
-    (glShaderSource (shader-id shader) 1 (bytevector->pointer str)
-                    (bytevector->pointer length))))
-
-(define (gl-shader-type type)
-  "Convert the symbol TYPE to the appropriate OpenGL shader constant."
-  (cond ((eq? type 'vertex)
-         (version-2-0 vertex-shader))
-        ((eq? type 'fragment)
-         (version-2-0 fragment-shader))
-        (else
-         (error "Invalid shader type: " type))))
-
-(define (make-shader type source)
-  "Create a new GLSL shader of the given TYPE (vertex or fragment) and
-compile the GLSL program contained in the string SOURCE."
-  (let* ((id (glCreateShader (gl-shader-type type)))
-         (shader (%make-shader type id)))
-    (shader-guardian shader)
-    (set-shader-source shader source)
-    (compile-shader shader)
-    shader))
-
-(define (make-vertex-shader source)
-  "Create a new GLSL vertex shader and compile the GLSL program
-contained in the string SOURCE."
-  (make-shader 'vertex source))
-
-(define (make-fragment-shader source)
-  "Create a new GLSL fragment shader and compile the GLSL program
-contained in the string SOURCE."
-  (make-shader 'fragment source))
-
-(define (load-shader type filename)
-  "Create a new GLSL shader of the given TYPE (vertex or fragment) and
-compile the GLSL program stored in the file FILENAME."
-  (if (file-exists? filename)
-      (make-shader type (call-with-input-file filename read-string))
-      (error "File not found!" filename)))
-
-(define (load-vertex-shader filename)
-  "Create a new GLSL vertex shader and compile the GLSL program stored
-in the file FILENAME."
-  (load-shader 'vertex filename))
-
-(define (load-fragment-shader filename)
-  "Create a new GLSL vertex shader and compile the GLSL program stored
-in the file FILENAME."
-  (load-shader 'fragment filename))
-
-;;;
-;;; Programs
-;;;
-
-(define-record-type <shader-program>
-  (%make-shader-program id)
-  shader-program?
-  (id shader-program-id))
-
-(define-guardian shader-program-guardian
-  (lambda (shader-program)
-    (false-if-exception
-     (glDeleteProgram (shader-program-id shader-program)))))
-
-(define-status %shader-program-linked? glGetProgramiv link-status)
-
-(define (shader-program-linked? shader-program)
-  "Return #t if SHADER-PROGRAM has been successfully linked with
-shaders or #f otherwise."
-  (%shader-program-linked? (shader-program-id shader-program)))
-
-(define-logger %display-linking-error glGetProgramiv glGetProgramInfoLog)
-
-(define (display-linking-error shader-program)
-  (%display-linking-error (shader-program-id shader-program)))
-
-(define (make-shader-program vertex-shader fragment-shader)
-  "Create a new shader program that has been linked with the given
-VERTEX-SHADER and FRAGMENT-SHADER."
-  (unless (and (vertex-shader? vertex-shader)
-               (fragment-shader? fragment-shader))
-    (error "Expected a vertex shader and fragment shader"
-           vertex-shader fragment-shader))
-  (let* ((id (glCreateProgram))
-         (shader-program (%make-shader-program id))
-         (shaders (list vertex-shader fragment-shader)))
-    (shader-program-guardian shader-program)
-    (for-each (lambda (shader)
-                (glAttachShader id (shader-id shader)))
-              shaders)
-    (glLinkProgram id)
-    (unless (shader-program-linked? shader-program)
-      (display "Failed to link shader program:\n")
-      (display-linking-error shader-program))
-    ;; Once the program has been linked, the shaders can be detached.
-    (for-each (lambda (shader)
-                (glDetachShader id (shader-id shader)))
-              shaders)
-    shader-program))
-
-(define (load-shader-program vertex-shader-file-name fragment-shader-file-name)
-  (make-shader-program (load-vertex-shader vertex-shader-file-name)
-                       (load-fragment-shader fragment-shader-file-name)))
-
-(define current-shader-program (make-parameter #f))
-
-(define-syntax-rule (with-shader-program shader-program body ...)
-  "Evaluate BODY with SHADER-PROGRAM bound."
-  (parameterize ((current-shader-program shader-program))
-    (begin
-      (glUseProgram (shader-program-id shader-program))
-      (let ((return-value (begin body ...)))
-        (glUseProgram 0)
-        return-value))))
-
-(define-record-type <uniform-setter>
-  (make-uniform-setter predicate proc)
-  uniform-setter?
-  (predicate uniform-setter-predicate)
-  (proc uniform-setter-proc))
-
-(define %uniform-setters '())
-
-(define (register-uniform-setter! predicate setter)
-  "Add a new type of uniform setter for shader programs where
-PREDICATE tests the type of a given value and SETTER performs the
-necessary OpenGL calls to set the uniform value in the proper
-location."
-  (set! %uniform-setters
-        (cons (make-uniform-setter predicate setter)
-              %uniform-setters)))
-
-;; Built-in uniform setters for booleans, numbers, vectors, and
-;; colors.
-(register-uniform-setter! boolean?
-                          (lambda (location b)
-                            (glUniform1i location (if b 1 0))))
-
-(register-uniform-setter! number?
-                          (lambda (location n)
-                            (glUniform1f location n)))
-
-(register-uniform-setter! vector2?
-                          (lambda (location v)
-                            (glUniform2f location (vx v) (vy v))))
-
-(register-uniform-setter! vector3?
-                          (lambda (location v)
-                            (glUniform3f location (vx v) (vy v) (vz v))))
-
-(register-uniform-setter! vector4?
-                          (lambda (location v)
-                            (glUniform4f location (vx v) (vy v) (vz v) (vw v))))
-
-(register-uniform-setter! transform?
-                          (lambda (location t)
-                            (let ((pointer
-                                   (bytevector->pointer
-                                    (array-contents (transform-matrix t)))))
-                              (glUniformMatrix4fv location 1 #f
-                                                  pointer))))
-
-(register-uniform-setter! color?
-                          (lambda (location c)
-                            (glUniform4f location
-                                         (color-r c)
-                                         (color-g c)
-                                         (color-b c)
-                                         (color-a c))))
-
-(define uniform-location
-  (memoize
-   (lambda (shader-program name)
-     "Retrieve the location for the uniform NAME within SHADER-PROGRAM."
-     (glGetUniformLocation (shader-program-id shader-program)
-                           (symbol->string name)))))
-
-(define attribute-location
-  (memoize
-   (lambda (shader-program name)
-     "Retrieve the location for the uniform NAME within SHADER-PROGRAM."
-     (glGetAttribLocation (shader-program-id shader-program)
-                           (symbol->string name)))))
-
-(define (uniform-set! shader-program name value)
-  "Use the appropriate setter procedure to translate VALUE into OpenGL
-compatible data and assign it to the location of the uniform NAME
-within SHADER-PROGRAM."
-  (let ((setter (find (lambda (setter)
-                        ((uniform-setter-predicate setter) value))
-                      %uniform-setters))
-        (location (uniform-location shader-program name)))
-    (if setter
-        ((uniform-setter-proc setter) location value)
-        (error "Not a valid uniform data type" value))))
-
-;; Bind values to uniform variables within the current shader program
-;; via a let-style syntax.  The types of the given values must be
-;; accounted for in the %uniform-setters list.  This macro simply sets
-;; uniform values and does not restore the previous values after
-;; evaluating the body of the form.
-;;
-;; emacs: (put 'uniforms 'scheme-indent-function 1)
-(define-syntax uniforms
-  (syntax-rules ()
-    ((_ () body ...)
-     (begin body ...))
-    ((_ ((name value) ...) body ...)
-     (begin
-       (uniform-set! (current-shader-program) 'name value)
-       ...
-       body ...))))
diff --git a/2d/signal.scm b/2d/signal.scm
deleted file mode 100644
index efbb103..0000000
--- a/2d/signal.scm
+++ /dev/null
@@ -1,292 +0,0 @@
-;;; guile-2d
-;;; Copyright (C) 2013, 2014 David Thompson <dthompson2@worcester.edu>
-;;;
-;;; This program 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.
-;;;
-;;; This program 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:
-;;
-;; Simple functional reactive programming API.
-;;
-;;; Code:
-
-(define-module (2d signal)
-  #:use-module (srfi srfi-1)
-  #:use-module (srfi srfi-9)
-  #:use-module (srfi srfi-26)
-  #:use-module (2d agenda)
-  #:export (signal?
-            make-signal
-            define-signal
-            hook->signal
-            signal-ref
-            signal-ref-maybe
-            signal-set!
-            signal-proc
-            signal-merge
-            signal-zip
-            signal-map
-            signal-fold
-            signal-filter
-            signal-reject
-            signal-constant
-            signal-count
-            signal-tap
-            signal-sample
-            signal-delay
-            signal-throttle))
-
-;;;
-;;; Signals
-;;;
-
-;; Signals are time-varying values. For example, a signal could
-;; represent the mouse position at the current point in time. The
-;; signals API provides an abstraction over regular event-based
-;; programming. State mutation is hidden away and a functional,
-;; declarative interface is exposed.
-(define-record-type <signal>
-  (%%make-signal value proc inputs outputs)
-  %signal?
-  (value %signal-ref %%signal-set!)
-  (proc signal-proc)
-  (inputs signal-inputs)
-  (outputs signal-outputs))
-
-(define-record-type <signal-box>
-  (make-signal-box signal)
-  signal-box?
-  (signal signal-unbox signal-box-set!))
-
-;; Alternate spelling of signal-box? for the public API.
-(define signal? signal-box?)
-
-(define (%make-signal init proc inputs)
-  "Create a new signal with initial value INIT."
-  (let ((signal (%%make-signal init proc inputs (make-weak-key-hash-table))))
-    (for-each (cut signal-connect! signal <>) inputs)
-    signal))
-
-(define (make-signal init)
-  "Return a signal box with initial value INIT."
-  (make-signal-box (%make-signal init #f '())))
-
-(define (make-boxed-signal init proc inputs)
-  "Return a signal box containing a signal with value INIT, updating
-procedure PROC, and a list of INPUTS."
-  (make-signal-box (%make-signal init proc inputs)))
-
-(define (signal-connect! signal-out signal-box-in)
-  "Attach SIGNAL-OUT to SIGNAL-BOX-IN.  When the signal within
-SIGNAL-BOX-IN changes, the value will be propagated to SIGNAL-OUT."
-  (hashq-set! (signal-outputs (signal-unbox signal-box-in)) signal-out #f))
-
-(define (signal-ref signal-box)
-  "Return the current value of the signal contained within
-SIGNAL-BOX."
-  (%signal-ref (signal-unbox signal-box)))
-
-(define (signal-ref-maybe object)
-  "Retrieves the signal value from OBJECT if it is a signal and or
-simply returns OBJECT otherwise."
-  (if (signal-box? object)
-      (signal-ref object)
-      object))
-
-(define (signal-propagate! signal)
-  "Notify all output signals about the current value of SIGNAL."
-  (hash-for-each (lambda (output unused)
-                   ((signal-proc output) output (%signal-ref signal)))
-                 (signal-outputs signal)))
-
-(define (%signal-set! signal value)
-  "Change the current value of SIGNAL to VALUE and propagate VALUE to
-all output signals."
-  (%%signal-set! signal value)
-  (signal-propagate! signal)
-  *unspecified*)
-
-(define (signal-set! signal-box value)
-  "Change the current value contained within SIGNAL-BOX to VALUE."
-  (%signal-set! (signal-unbox signal-box) value))
-
-(define (splice-signals! to from)
-  "Replace the contents of the signal TO with the contents of the
-signal FROM and transfer all output signals."
-  (let ((outputs (signal-outputs (signal-unbox to))))
-    (hash-for-each (lambda (signal unused)
-                     (signal-connect! signal from))
-                   outputs)
-    (signal-box-set! to (signal-unbox from))))
-
-(define (make-signal-maybe value)
-  "Coerce VALUE into a signal.  Return VALUE unmodified if it is
-already a signal."
-  (if (signal? value)
-      value
-      (make-signal value)))
-
-(define-syntax define-signal
-  (lambda (x)
-    "Create a top-level signal variable.  If the named variable
-already exists and has a signal value then its outputs will be spliced
-into the new signal.  If the given value is not a signal then it will
-be coerced into one."
-    (syntax-case x ()
-      ((_ name (signal ...))
-       (defined? (syntax->datum #'name))
-       #'(let ((s (make-signal-maybe (signal ...))))
-           (if (signal? name)
-               (begin
-                 (splice-signals! name s)
-                 (signal-propagate! (signal-unbox name)))
-               (set! name s))))
-      ((_ name value)
-       (defined? (syntax->datum #'name))
-       #'(let ((s (make-signal-maybe value)))
-           (if (signal? name)
-               (begin
-                 (splice-signals! name s)
-                 (signal-propagate! (signal-unbox name)))
-               (set! name s))))
-      ((_ name (signal ...))
-       #'(define name (make-signal-maybe (signal ...))))
-      ((_ name value)
-       #'(define name (make-signal-maybe value))))))
-
-;;;
-;;; Higher Order Signals
-;;;
-
-(define (hook->signal hook init proc)
-  "Return a new signal whose initial value is INIT and has future
-values calculated by applying PROC to the arguments sent when HOOK is
-run."
-  (let ((signal (make-signal init)))
-    (add-hook! hook
-               (lambda args
-                 (signal-set! signal (apply proc args))))
-    signal))
-
-(define (signal-merge signal1 signal2 . rest)
-  "Create a new signal whose value is the that of the most recently
-changed signal in SIGNALs.  The initial value is that of the first
-signal in SIGNALS."
-  (let ((inputs (append (list signal1 signal2) rest)))
-    (make-boxed-signal (signal-ref (car inputs))
-                       (lambda (self value)
-                         (%signal-set! self value))
-                       inputs)))
-
-(define (signal-zip . signals)
-  "Create a new signal whose value is a list of the values stored in
-the given signals."
-  (define (current-value)
-    (map signal-ref signals))
-  (make-boxed-signal (current-value)
-                     (lambda (self value)
-                       (%signal-set! self (current-value)))
-                     signals))
-
-(define (signal-map proc signal . rest)
-  "Create a new signal that applies PROC to the values stored in one
-or more SIGNALS."
-  (let ((inputs (cons signal rest)))
-    (define (current-value)
-      (apply proc (map signal-ref inputs)))
-    (make-boxed-signal (current-value)
-                       (lambda (self value)
-                         (%signal-set! self (current-value)))
-                       inputs)))
-
-(define (signal-fold proc init signal . rest)
-  "Create a new signal that applies PROC to the values stored in
-SIGNAL. PROC is applied with the current value of SIGNAL and the
-previously computed value, or INIT for the first call."
-  (let ((inputs (cons signal rest)))
-    (make-boxed-signal init
-                       (let ((previous init))
-                         (lambda (self value)
-                           (let ((x (apply proc
-                                           (append (map signal-ref inputs)
-                                                   (list previous)))))
-                             (set! previous x)
-                             (%signal-set! self x))))
-                       inputs)))
-
-(define (signal-filter predicate default signal)
-  "Create a new signal that keeps an incoming value from SIGNAL when
-it satifies the procedure PREDICATE.  The value of the signal is
-DEFAULT when the predicate is never satisfied."
-  (make-boxed-signal (if (predicate (signal-ref signal))
-                         (signal-ref signal)
-                         default)
-                     (lambda (self value)
-                       (when (predicate value)
-                         (%signal-set! self value)))
-                     (list signal)))
-
-(define (signal-reject predicate default signal)
-  "Create a new signal that does not keep an incoming value from
-SIGNAL when it satisfies the procedure PREDICATE.  The value of the
-signal is DEFAULT when the predicate is never satisfied."
-  (signal-filter (lambda (x) (not (predicate x))) default signal))
-
-(define (signal-constant constant signal)
-  "Create a new signal whose value is always CONSTANT regardless of
-what the value received from SIGNAL."
-  (signal-map (lambda (value) constant) signal))
-
-(define (signal-count signal)
-  "Create a new signal that increments a counter every time a new
-value from SIGNAL is received."
-  (signal-fold + 0 (signal-constant 1 signal)))
-
-(define (signal-tap proc signal)
-  "Create a new signal that applies PROC when a new values is received
-from SIGNAL.  The value of the new signal will always be the value of
-SIGNAL.  This signal is a convenient way to sneak a procedure that has
-a side-effect into a signal chain."
-  (signal-map (lambda (x) (proc x) x) signal))
-
-(define (signal-sample delay signal)
-  "Create a new signal that emits the value contained within SIGNAL
-every DELAY ticks of the current agenda."
-  (let ((sampler (%make-signal (signal-ref signal) #f '())))
-    (define (tick)
-      (%signal-set! sampler (signal-ref signal)))
-    (schedule-interval tick delay)
-    (make-signal-box sampler)))
-
-(define (signal-delay delay signal)
-  "Create a new signal that delays propagation of SIGNAL by DELAY
-ticks of the current agenda."
-  (make-boxed-signal (signal-ref signal)
-                     (lambda (self value)
-                       (schedule
-                        (lambda ()
-                          (%signal-set! self value))
-                        delay))
-                     (list signal)))
-
-(define (signal-throttle delay signal)
-  "Return a new signal that propagates SIGNAL at most once every DELAY
-ticks of the current agenda."
-  (make-boxed-signal (signal-ref signal)
-                     (let ((last-time (agenda-time)))
-                       (lambda (self value)
-                         (when (>= (- (agenda-time) last-time) delay)
-                           (%signal-set! self value)
-                           (set! last-time (agenda-time)))))
-                     (list signal)))
diff --git a/2d/sprite.scm b/2d/sprite.scm
deleted file mode 100644
index a672d58..0000000
--- a/2d/sprite.scm
+++ /dev/null
@@ -1,188 +0,0 @@
-;;; guile-2d
-;;; Copyright (C) 2013, 2014 David Thompson <dthompson2@worcester.edu>
-;;;
-;;; This program 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.
-;;;
-;;; This program 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:
-;;
-;; Sprites are typically the most important part of a 2D game. This
-;; module provides sprites as an abstraction around OpenGL textures.
-;;
-;;; Code:
-
-(define-module (2d sprite)
-  #:use-module (srfi srfi-1)
-  #:use-module (srfi srfi-9)
-  #:use-module (srfi srfi-9 gnu)
-  #:use-module (gl)
-  #:use-module (gl contrib packed-struct)
-  #:use-module ((sdl sdl) #:prefix SDL:)
-  #:use-module (2d agenda)
-  #:use-module (2d animation)
-  #:use-module (2d color)
-  #:use-module (2d config)
-  #:use-module (2d helpers)
-  #:use-module (2d math)
-  #:use-module (2d shader)
-  #:use-module (2d signal)
-  #:use-module (2d texture)
-  #:use-module (2d vector)
-  #:use-module (2d window)
-  #:use-module (2d wrappers gl)
-  #:export (enable-sprites
-            make-sprite
-            sprite?
-            animated-sprite?
-            sprite-drawable
-            sprite-position
-            sprite-scale
-            sprite-rotation
-            sprite-color
-            sprite-anchor
-            set-sprite-drawable
-            set-sprite-position
-            set-sprite-scale
-            set-sprite-rotation
-            set-sprite-color
-            set-sprite-anchor
-            load-sprite
-            draw-sprite))
-
-;;;
-;;; Sprites
-;;;
-
-(define sprite-shader #f)
-
-(define (enable-sprites)
-  (set! sprite-shader
-        (load-shader-program
-         (string-append %pkgdatadir
-                        "/shaders/sprite-vertex.glsl")
-         (string-append %pkgdatadir
-                        "/shaders/sprite-fragment.glsl"))))
-
-;; The <sprite> type represents a drawable object (texture,
-;; texture-region, animation, etc.) with a given position, scale,
-;; rotation, and color.
-(define-immutable-record-type <sprite>
-  (%make-sprite drawable position scale rotation color anchor vertices animator)
-  sprite?
-  (drawable sprite-drawable set-sprite-drawable)
-  (position sprite-position set-sprite-position)
-  (scale sprite-scale set-sprite-scale)
-  (rotation sprite-rotation set-sprite-rotation)
-  (color sprite-color set-sprite-color)
-  (anchor sprite-anchor set-sprite-anchor)
-  (vertices sprite-vertices)
-  (animator sprite-animator))
-
-(define (update-sprite-vertices! sprite)
-  (let ((texture (sprite-texture sprite)))
-    (pack-texture-vertices (sprite-vertices sprite)
-                           0
-                           (texture-width texture)
-                           (texture-height texture)
-                           (texture-s1 texture)
-                           (texture-t1 texture)
-                           (texture-s2 texture)
-                           (texture-t2 texture))))
-
-(define* (make-sprite drawable #:optional #:key
-                      (position #(0 0)) (scale #(1 1))
-                      (rotation 0) (color white) (anchor 'center))
-  "Create a new sprite object. DRAWABLE is either a texture or
-animation object.  All keyword arguments are optional. POSITION is a
-vector with a default of (0, 0).  SCALE is a vector that describes how
-much DRAWABLE should be strected on the x and y axes, with a default
-of 1x scale.  ROTATION is an angle in degrees with a default of 0.
-COLOR is a color object with a default of white.  ANCHOR is either a
-vector that represents the center point of the sprite, or 'center
-which will place the anchor at the center of DRAWABLE.  Sprites are
-centered by default."
-  (let* ((vertices (make-packed-array texture-vertex 4))
-         (animator (if (animation? drawable)
-                       (make-animator drawable)
-                       #f))
-         (anchor (anchor-texture (drawable-texture drawable animator) anchor))
-         (sprite (%make-sprite drawable position scale rotation color
-                               anchor vertices animator)))
-    (update-sprite-vertices! sprite)
-    sprite))
-
-(define* (load-sprite filename #:optional #:key
-                      (position #(0 0)) (scale #(1 1))
-                      (rotation 0) (color white) (anchor 'center))
-  "Load a sprite from the file at FILENAME. See make-sprite for
-optional keyword arguments."
-  (make-sprite (load-texture filename)
-               #:position position
-               #:scale scale
-               #:rotation rotation
-               #:color color
-               #:anchor anchor))
-
-(define (animated-sprite? sprite)
-  "Return #t if SPRITE has an animation as its drawable object."
-  (animation? (sprite-drawable sprite)))
-
-(define (drawable-texture drawable animator)
-  (cond ((texture? drawable)
-         drawable)
-        ((animation? drawable)
-         (animator-texture animator))))
-
-(define (sprite-texture sprite)
-  "Return the texture for the SPRITE's drawable object."
-  (let ((drawable (sprite-drawable sprite)))
-    (drawable-texture (sprite-drawable sprite)
-                      (sprite-animator sprite))))
-
-(define (update-sprite-animator! sprite)
-  (animator-update! (sprite-animator sprite))
-  (update-sprite-vertices! sprite))
-
-(define (draw-sprite sprite)
-  "Render SPRITE to the screen. A sprite batch will be used if one is
-currently bound."
-  (register-animated-sprite-maybe sprite)
-  (with-shader-program sprite-shader
-    (uniforms ((position (sprite-position sprite))
-               (anchor (sprite-anchor sprite))
-               (scale (sprite-scale sprite))
-               (rotation (sprite-rotation sprite))
-               (color (sprite-color sprite))
-               (projection (signal-ref window-projection)))
-      (draw-texture-vertices (sprite-texture sprite)
-                             (sprite-vertices sprite)
-                             1))))
-
-;; A hash table for all of the animated sprites that have been drawn
-;; since the last game update.  It is cleared after every agenda tick.
-(define animated-sprites (make-hash-table))
-
-(define (register-animated-sprite-maybe sprite)
-  (when (animated-sprite? sprite)
-    (hash-set! animated-sprites sprite sprite)))
-
-(define (update-animated-sprites!)
-  "Update all animators for sprites that have been drawn this frame."
-  (hash-for-each (lambda (key val)
-                   (update-sprite-animator! val))
-                 animated-sprites)
-  (hash-clear! animated-sprites))
-
-;; Update animated sprites upon every update.
-(schedule-each update-animated-sprites!)
diff --git a/2d/texture.scm b/2d/texture.scm
deleted file mode 100644
index bd7bea6..0000000
--- a/2d/texture.scm
+++ /dev/null
@@ -1,224 +0,0 @@
-;;; guile-2d
-;;; Copyright (C) 2013, 2014 David Thompson <dthompson2@worcester.edu>
-;;;
-;;; This program 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.
-;;;
-;;; This program 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:
-;;
-;; Textures and texture regions are high level wrappers over OpenGL
-;; textures.
-;;
-;;; Code:
-
-(define-module (2d texture)
-  #:use-module (srfi srfi-9)
-  #:use-module (gl)
-  #:use-module (gl contrib packed-struct)
-  #:use-module (2d color)
-  #:use-module (2d helpers)
-  #:use-module (2d vector)
-  #:use-module (2d wrappers gl)
-  #:use-module (2d wrappers freeimage)
-  #:export (make-texture
-            make-texture-region
-            load-texture
-            texture?
-            texture-region?
-            texture-id
-            texture-width
-            texture-height
-            texture-s1
-            texture-t1
-            texture-s2
-            texture-t2
-            anchor-texture
-            texture-vertex
-            pack-texture-vertices
-            draw-texture-vertices))
-
-;;;
-;;; Textures
-;;;
-
-;; The <texture> object is a simple wrapper around an OpenGL texture
-;; id.
-(define-record-type <texture>
-  (%make-texture id parent width height s1 t1 s2 t2)
-  texture?
-  (id texture-id)
-  (parent texture-parent)
-  (width texture-width)
-  (height texture-height)
-  (s1 texture-s1)
-  (t1 texture-t1)
-  (s2 texture-s2)
-  (t2 texture-t2))
-
-(define (texture-region? texture)
-  "Return #t if TEXTURE has a parent texture."
-  (texture? (texture-parent texture)))
-
-(define (make-texture id parent width height s1 t1 s2 t2)
-  "Create a new texture object. ID is the OpenGL texture id. PARENT is
-a texture object (if this texture only represents a region of another
-texture) or #f. WIDTH and HEIGHT are the texture dimensions in
-pixels. S1, T1, S2, and T2 are the OpenGL texture coordinates
-representing the area of the texture that will be rendered."
-  (let ((texture (%make-texture id parent width height s1 t1 s2 t2)))
-    (texture-guardian texture)
-    texture))
-
-(define (make-texture-region texture x y width height)
-  "Creates new texture region object. TEXTURE is the region's parent
-texture. X, Y, WIDTH, and HEIGHT represent the region of the texture
-that will be rendered, in pixels."
-  (let* ((w (texture-width texture))
-         (h (texture-height texture)))
-    (make-texture (texture-id texture)
-                  texture
-                  width
-                  height
-                  (/ x w)
-                  (/ y h)
-                  (/ (+ x width) w)
-                  (/ (+ y height) h))))
-
-;; Use a guardian and an after GC hook that ensures that OpenGL
-;; textures are deleted when texture objects are GC'd.
-(define-guardian texture-guardian
-  (lambda (texture)
-    ;; Do not reap texture regions
-    (unless (texture-region? texture)
-      ;; When attempting to reap structures upon guile exit, the
-      ;; dynamic pointer to gl-delete-textures becomes invalid. So, we
-      ;; ignore the error and move on.
-      (false-if-exception (gl-delete-texture (texture-id texture))))))
-
-(define (bitmap->texture bitmap)
-  "Translates a freeimage bitmap into an OpenGL texture."
-  (let ((texture-id (gl-generate-texture))
-        (pixels (freeimage-get-bits bitmap)))
-    (with-gl-bind-texture (texture-target texture-2d) texture-id
-      ;; Use "nearest" scaling method so that pixel art doesn't become
-      ;; blurry when scaled.
-      (gl-texture-parameter (texture-target texture-2d)
-                            (texture-parameter-name texture-min-filter)
-                            (texture-min-filter nearest))
-      (gl-texture-parameter (texture-target texture-2d)
-                            (texture-parameter-name texture-mag-filter)
-                            (texture-mag-filter nearest))
-      (gl-texture-image-2d (texture-target texture-2d)
-                           0
-                           (pixel-format rgba)
-                           (freeimage-get-width bitmap)
-                           (freeimage-get-height bitmap)
-                           0
-                           (version-1-2 bgra)
-                           (color-pointer-type unsigned-byte)
-                           pixels))
-    (make-texture texture-id
-                  #f
-                  (freeimage-get-width bitmap)
-                  (freeimage-get-height bitmap)
-                  0 0 1 1)))
-
-(define (load-bitmap filename)
-  ;; Throw an error if image file does not exist or else we will
-  ;; segfault later.
-  (unless (file-exists? filename)
-    (throw 'image-not-found filename))
-  ;; Load image and convert it to 32 bit color.
-  (let* ((image-type (freeimage-get-file-type filename))
-         (bitmap (freeimage-load image-type filename))
-         (32bit-bitmap (freeimage-convert-to-32-bits bitmap)))
-    (freeimage-unload bitmap)
-    ;; Need to flip because y-axis is reversed.
-    (freeimage-flip-vertical 32bit-bitmap)
-    32bit-bitmap))
-
-(define (load-texture filename)
-  "Load a texture from an image file at FILENAME."
-  (let* ((bitmap (load-bitmap filename))
-         (texture (bitmap->texture bitmap)))
-    (freeimage-unload bitmap)
-    texture))
-
-(define (anchor-texture texture anchor)
-  "Return a vector of the coordinates for the center point of a
-texture."
-  (let ((w (texture-width texture))
-        (h (texture-height texture)))
-    (cond
-     ((vector2? anchor)
-      anchor)
-     ((eq? anchor 'center)
-      (vector (/ w 2)
-              (/ h 2)))
-     ((eq? anchor 'top-left)
-      #(0 0))
-     ((eq? anchor 'top-right)
-      (vector w 0))
-     ((eq? anchor 'bottom-left)
-      (vector 0 h))
-     ((eq? anchor 'bottom-right)
-      (vector w h))
-     ((eq? anchor 'top-center)
-      (vector (/ w 2) 0))
-     ((eq? anchor 'bottom-center)
-      (vector (/ w 2) h))
-     (else
-      (error "Invalid anchor type!" anchor)))))
-
-;;;
-;;; Texture Vertices
-;;;
-
-(define-packed-struct texture-vertex
-  ;; Position
-  (x float)
-  (y float)
-  ;; Texture Coordinates
-  (s float)
-  (t float))
-
-(define texture-vertex-size (packed-struct-size texture-vertex))
-(define x-offset (packed-struct-offset texture-vertex x))
-(define s-offset (packed-struct-offset texture-vertex s))
-
-(define (pack-texture-vertices vertices offset width height s1 t1 s2 t2)
-  ;; Vertices go counter clockwise, starting from the top-left
-  ;; corner.
-  (pack vertices offset texture-vertex 0 0 s1 t1)
-  (pack vertices (+ offset 1) texture-vertex 0 height s1 t2)
-  (pack vertices (+ offset 2) texture-vertex width height s2 t2)
-  (pack vertices (+ offset 3) texture-vertex width 0 s2 t1))
-
-(define (draw-texture-vertices texture vertices size)
-  (let ((pointer-type (tex-coord-pointer-type float)))
-    (gl-enable-client-state (enable-cap vertex-array))
-    (gl-enable-client-state (enable-cap texture-coord-array))
-    (with-gl-bind-texture (texture-target texture-2d) (texture-id texture)
-      (set-gl-vertex-array pointer-type
-                           vertices
-                           2
-                           #:stride texture-vertex-size
-                           #:offset x-offset)
-      (set-gl-texture-coordinates-array pointer-type
-                                        vertices
-                                        #:stride texture-vertex-size
-                                        #:offset s-offset)
-      (gl-draw-arrays (begin-mode quads) 0 (* size 4)))
-    (gl-disable-client-state (enable-cap texture-coord-array))
-    (gl-disable-client-state (enable-cap vertex-array))))
diff --git a/2d/tileset.scm b/2d/tileset.scm
deleted file mode 100644
index 669372b..0000000
--- a/2d/tileset.scm
+++ /dev/null
@@ -1,89 +0,0 @@
-;;; guile-2d
-;;; Copyright (C) 2013, 2014 David Thompson <dthompson2@worcester.edu>
-;;;
-;;; This program 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.
-;;;
-;;; This program 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:
-;;
-;; Tilesets encapsulate a group of uniformly sized texture regions
-;; that come from a single texture.
-;;
-;;; Code:
-
-(define-module (2d tileset)
-  #:use-module (srfi srfi-9)
-  #:use-module (srfi srfi-42)
-  #:use-module (2d texture)
-  #:export (<tileset>
-            make-tileset
-            load-tileset
-            tileset?
-            tileset-tiles
-            tileset-width
-            tileset-height
-            tileset-margin
-            tileset-spacing
-            tileset-ref))
-
-(define-record-type <tileset>
-  (%make-tileset tiles width height margin spacing)
-  tileset?
-  (tiles tileset-tiles)
-  (width tileset-width)
-  (height tileset-height)
-  (margin tileset-margin)
-  (spacing tileset-spacing))
-
-(define (split-texture texture width height margin spacing)
-  "Split TEXTURE into a vector of texture regions of WIDTH x HEIGHT
-size. SPACING refers to the number of pixels separating each
-tile. MARGIN refers to the number of pixels on the top and left of
-TEXTURE before the first tile begins."
-  (define (build-tile tx ty)
-    (let* ((x (+ (* tx (+ width spacing)) margin))
-           (y (+ (* ty (+ height spacing)) margin)))
-      (make-texture-region texture x y width height)))
-
-  (let* ((tw (texture-width texture))
-         (th (texture-height texture))
-         (rows (/ (- tw margin) (+ width spacing)))
-         (columns (/ (- tw margin) (+ height spacing))))
-    (vector-ec (: y rows) (: x columns) (build-tile x y))))
-
-(define* (make-tileset texture width height
-                       #:optional #:key (margin 0) (spacing 0))
-  "Return a new tileset that is built by splitting TEXTURE into
-tiles."
-  (let ((tiles (split-texture texture
-                              width
-                              height
-                              margin
-                              spacing)))
-    (%make-tileset tiles width height margin spacing)))
-
-(define* (load-tileset filename width height
-                       #:optional #:key (margin 0) (spacing 0))
-  "Return a new tileset that is built by loading the texture at
-FILENAME and splitting the texture into tiles."
-  (let* ((tiles (split-texture (load-texture filename)
-                               width
-                               height
-                               margin
-                               spacing)))
-    (%make-tileset tiles width height margin spacing)))
-
-(define (tileset-ref tileset i)
-  "Return the tile texture of TILESET at index I."
-  (vector-ref (tileset-tiles tileset) i))
diff --git a/2d/transform.scm b/2d/transform.scm
deleted file mode 100644
index 21be955..0000000
--- a/2d/transform.scm
+++ /dev/null
@@ -1,233 +0,0 @@
-;;; guile-2d
-;;; Copyright (C) 2014 David Thompson <dthompson2@worcester.edu>
-;;;
-;;; This program 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.
-;;;
-;;; This program 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:
-;;
-;; 4x4 column-major transformation matrix.
-;;
-;;; Code:
-
-(define-module (2d transform)
-  #:use-module (srfi srfi-1)
-  #:use-module (srfi srfi-9)
-  #:use-module (srfi srfi-42)
-  #:use-module (2d math)
-  #:use-module (2d vector)
-  #:export (make-transform null-transform identity-transform
-            transform? transform-matrix
-            transpose transform-vector2
-            transform+ transform*
-            scale translate rotate-x rotate-y rotate-z
-            orthographic-projection perspective-projection))
-
-(define-record-type <transform>
-  (%make-transform matrix)
-  transform?
-  (matrix transform-matrix))
-
-(define (make-4x4-matrix)
-  (make-typed-array 'f32 0 4 4))
-
-(define (make-transform aa ab ac ad
-                        ba bb bc bd
-                        ca cb cc cd
-                        da db dc dd)
-  "Return a new transform initialized with the given 16 values in
-column-major format."
-  (let ((matrix (make-4x4-matrix)))
-    (array-set! matrix aa 0 0)
-    (array-set! matrix ab 0 1)
-    (array-set! matrix ac 0 2)
-    (array-set! matrix ad 0 3)
-    (array-set! matrix ba 1 0)
-    (array-set! matrix bb 1 1)
-    (array-set! matrix bc 1 2)
-    (array-set! matrix bd 1 3)
-    (array-set! matrix ca 2 0)
-    (array-set! matrix cb 2 1)
-    (array-set! matrix cc 2 2)
-    (array-set! matrix cd 2 3)
-    (array-set! matrix da 3 0)
-    (array-set! matrix db 3 1)
-    (array-set! matrix dc 3 2)
-    (array-set! matrix dd 3 3)
-    (%make-transform matrix)))
-
-(define null-transform
-  (%make-transform (make-4x4-matrix)))
-
-(define identity-transform
-  (make-transform 1 0 0 0
-                  0 1 0 0
-                  0 0 1 0
-                  0 0 0 1))
-
-(define (transpose transform)
-  "Return a transform that is the transpose of TRANSFORM."
-  (let ((m1 (transform-matrix transform))
-        (m2 (make-4x4-matrix)))
-    (do-ec (: r 4) (: c 4)
-           (array-set! m2 (array-ref m1 r c)
-                       c r))
-    (%make-transform m2)))
-
-(define (transform-vector2 transform v)
-  "Apply TRANSFORM to the 2D vector V."
-  (let ((m (transform-matrix transform))
-        (x (vx v))
-        (y (vy v)))
-    (vector (+ (* x (array-ref m 0 0))
-               (* y (array-ref m 0 1))
-               (array-ref m 0 3))
-            (+ (* x (array-ref m 1 0))
-               (* y (array-ref m 1 1))
-               (array-ref m 1 3)))))
-
-(define (transform+ . transforms)
-  "Return the sum of all given transformation matrices.  Return
-null-transform if called without any arguments."
-  (define (add a b)
-    (let ((m1 (transform-matrix a))
-          (m2 (transform-matrix b))
-          (m3 (make-4x4-matrix)))
-      (do-ec (: r 4) (: c 4)
-             (let ((x (+ (array-ref m1 r c)
-                         (array-ref m2 r c))))
-               (array-set! m3 x r c)))
-      (%make-transform m3)))
-  (reduce add null-transform transforms))
-
-(define (transform* . transforms)
-  "Return the product of all given transformation matrices.  Return
-identity-transform if called without any arguments."
-  (define (mul a b)
-    (let ((m1 (transform-matrix a))
-          (m2 (transform-matrix b))
-          (m3 (make-4x4-matrix)))
-      (do-ec (: r 4) (: c 4)
-             (let ((x (sum-ec (: k 4)
-                              (* (array-ref m1 r k)
-                                 (array-ref m2 k c)))))
-               (array-set! m3 x r c)))
-      (%make-transform m3)))
-  (reduce mul identity-transform transforms))
-
-(define (translate v)
-  "Return a new transform that translates by the 2D or 3D vector V."
-  (cond
-   ((vector2? v)
-    (let ((x (vx v))
-          (y (vy v)))
-      (make-transform 1 0 0 0
-                      0 1 0 0
-                      0 0 1 0
-                      x y 0 1)))
-   ((vector3? v)
-    (let ((x (vx v))
-          (y (vy v))
-          (z (vz v)))
-      (make-transform 1 0 0 0
-                      0 1 0 0
-                      0 0 1 0
-                      x y z 1)))
-   (else
-    (error "Invalid scaling vector: " v))))
-
-(define (scale v)
-  "Return a new transform that scales by the 2D vector, 3D vector, or
-scalar V."
-  (cond
-   ((number? v)
-    (make-transform v 0 0 0
-                    0 v 0 0
-                    0 0 v 0
-                    0 0 0 1))
-   ((vector2? v)
-    (let ((x (vx v))
-          (y (vy v)))
-      (make-transform x 0 0 0
-                      0 y 0 0
-                      0 0 1 0
-                      0 0 0 1)))
-   ((vector3? v)
-    (let ((x (vx v))
-          (y (vy v))
-          (z (vz v)))
-      (make-transform x 0 0 0
-                      0 y 0 0
-                      0 0 z 0
-                      0 0 0 1)))
-   (else
-    (error "Invalid scaling vector: " v))))
-
-(define (rotate-x angle)
-  "Return a new transform that rotates the X axis by ANGLE radians."
-  (make-transform 1 0           0               0
-                  0 (cos angle) (- (sin angle)) 0
-                  0 (sin angle) (cos angle)     0
-                  0 0           0               1))
-
-(define (rotate-y angle)
-  "Return a new transform that rotates the Y axis by ANGLE radians."
-  (make-transform (cos angle)     0 (sin angle) 0
-                  0               1 0           0
-                  (- (sin angle)) 0 (cos angle) 0
-                  0               0 0           1))
-(define (rotate-z angle)
-  "Return a new transform that rotates the Z axis by ANGLE radians."
-  (make-transform (cos angle) (- (sin angle)) 0 0
-                  (sin angle) (cos angle)     0 0
-                  0           0               1 0
-                  0           0               0 1))
-
-(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-transform (/ 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 (perspective-projection field-of-vision aspect-ratio near far)
-  "Return a new transform that represents a perspective projection
-with a FIELD-OF-VISION in degrees, the desired ASPECT-RATIO, and the
-depth clipping plane NEAR and FAR."
-  (let ((size (* near (tan (/ (degrees->radians field-of-vision) 2)))))
-    (let ((left (- size))
-          (right size)
-          (top (/ size aspect-ratio))
-          (bottom (/ (- size) aspect-ratio)))
-      (make-transform (/ (* 2 near) (- right left)) ;; First row
-                      0
-                      (/ (+ right left) (- right left))
-                      0
-                      ;; Second row
-                      0
-                      (/ (* 2 near) (- top bottom))
-                      (/ (+ top bottom) (- top bottom))
-                      0
-                      ;; Third row
-                      0 0
-                      (- (/ (+ far near) (- far near)))
-                      (- (/ (* 2 far near) (- far near)))
-                      ;; Fourth row
-                      0 0 -1 0))))
diff --git a/2d/vector.scm b/2d/vector.scm
deleted file mode 100644
index 302f62b..0000000
--- a/2d/vector.scm
+++ /dev/null
@@ -1,157 +0,0 @@
-;;; guile-2d
-;;; Copyright (C) 2014 David Thompson <davet@gnu.org>
-;;;
-;;; This program 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.
-;;;
-;;; This program 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:
-;;
-;; Vector math.
-;;
-;;; Code:
-
-(define-module (2d vector)
-  #:use-module (ice-9 match)
-  #:use-module (srfi srfi-1)
-  #:use-module (srfi srfi-9)
-  #:use-module (srfi srfi-43)
-  #:export (vector2? vector3? vector4?
-                     vector-length= v=
-                     vx vy vz vw
-                     polar-vector
-                     v+ v- v* vdot vcross
-                     magnitude normalize))
-
-(define (vector-dimensionality? v d)
-  (and (vector? v) (= (vector-length v) d)))
-
-(define (vector2? v)
-  "Return #t if V is a 2D vector, #f otherwise."
-  (vector-dimensionality? v 2))
-
-(define (vector3? v)
-  "Return #t if V is a 3D vector, #f otherwise."
-  (vector-dimensionality? v 3))
-
-(define (vector4? v)
-  "Return #t if V is a 4D vector, #f otherwise."
-  (vector-dimensionality? v 4))
-
-(define (vector-length= v1 v2)
-  "Return #t if V1 and V2 are of the same dimensionality, #f
-otherwise."
-  (= (vector-length v1)
-     (vector-length v2)))
-
-(define (v= . vectors)
-  "Return #t if all arguments are equivalent vectors, #f otherwise."
-  (apply vector= = vectors))
-
-(define (vx v)
-  "Return the first component of the vector V."
-  (vector-ref v 0))
-
-(define (vy v)
-  "Return the second component of the vector V."
-  (vector-ref v 1))
-
-(define (vz v)
-  "Return the third component of the vector V."
-  (vector-ref v 2))
-
-(define (vw v)
-  "Return the fourth component of the vector V."
-  (vector-ref v 3))
-
-(define (polar-vector r theta)
-  "Create a 2D cartesian vector from the polar coordinates (R,
-THETA)."
-  (vector (* r (cos theta))
-          (* r (sin theta))))
-
-(define (dimension-error v1 v2)
-  (error "Vector dimensionality mismatch: " v1 v2))
-
-(define* (vreduce op vectors #:optional (reduce reduce))
-  (reduce (lambda args
-            (match args
-              (((? number? k) (? number? l))
-               (op k l))
-              (((? number? k) (? vector? v))
-               (vector-map (lambda (i n) (op k n)) v))
-              (((? vector? v) (? number? k))
-               (vector-map (lambda (i n) (op n k)) v))
-              (((? vector? v1) (? vector? v2))
-               (if (vector-length= v1 v2)
-                   (vector-map (lambda (i a b)
-                                 (op a b))
-                               v1 v2)
-                   (dimension-error v1 v2)))))
-          0 vectors))
-
-(define (v+ . vectors)
-  "Return the sum of all vectors.  All vectors must be of the same
-dimensionality.  Scalar values can be used to add to all components of
-the resulting vector."
-  (vreduce + vectors))
-
-(define v-
-  (case-lambda
-    "Return the difference of all vectors.  All vectors must be of the
-same dimensionality.  Scalar values can be used to subtract from all
-components of the resulting vector."
-    ((v) (v- 0 v))
-    ((v . rest)
-     (vreduce - (cons v rest) reduce-right))))
-
-(define (v* . vectors)
-  "Return the product of all VECTORS.  All vectors must be of the same
-dimensionality.  Scalar values can be used to multiply all components
-of the resulting vector."
-  (vreduce * vectors))
-
-(define (vdot v1 v2)
-  "Return the dot product of the vectors V1 and V2.  V1 and V2 must be
-of the same dimensionality."
-  (if (vector-length= v1 v2)
-      (vector-fold (lambda (i memo a b)
-                     (+ memo (* a b)))
-                   0 v1 v2)
-      (dimension-error v1 v2)))
-
-(define (vcross v1 v2)
-  "Return the cross product of the vectors V1 and V2.  V1 and V2 must
-both be 3D vectors."
-  (match (list v1 v2)
-    ((#(x1 y1 z1) #(x2 y2 z2))
-     (vector (- (* y1 z2) (* z1 y2))
-             (- (* z1 x2) (* x1 z2))
-             (- (* x1 y2) (* y1 x2))))
-    (_ (error "Expected 3D vectors: " v1 v2))))
-
-(define (magnitude v)
-  "Return the magnitude of the vector V."
-  (sqrt
-   (vector-fold (lambda (i memo n)
-                  (+ memo (expt n 2)))
-                0 v)))
-
-(define (normalize v)
-  "Normalize the vector V."
-  (let ((m (magnitude v)))
-    (if (zero? m)
-        0
-        (vector-map (lambda (i n)
-                      (/ n m))
-                    v))))
diff --git a/2d/window.scm b/2d/window.scm
deleted file mode 100644
index 126d1a2..0000000
--- a/2d/window.scm
+++ /dev/null
@@ -1,118 +0,0 @@
-;;; guile-2d
-;;; Copyright (C) 2013, 2014 David Thompson <dthompson2@worcester.edu>
-;;;
-;;; This program 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.
-;;;
-;;; This program 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:
-;;
-;; Window management.
-;;
-;;; Code:
-
-(define-module (2d window)
-  #:use-module (srfi srfi-9)
-  #:use-module (gl)
-  #:use-module ((sdl sdl) #:prefix SDL:)
-  #:use-module ((sdl mixer) #:prefix SDL:)
-  #:use-module (2d event)
-  #:use-module (2d signal)
-  #:use-module (2d transform)
-  #:use-module (2d vector)
-  #:export (make-window
-            window?
-            window-title
-            window-resolution
-            window-fullscreen?
-            window-width
-            window-height
-            window-size
-            window-projection
-            open-window
-            close-window
-            with-window
-            window-resize-hook
-            window-close-hook))
-
-(define-record-type <window>
-  (%make-window title resolution fullscreen?)
-  window?
-  (title window-title)
-  (resolution window-resolution)
-  (fullscreen? window-fullscreen?))
-
-(define* (make-window #:optional #:key
-                      (title "Guile-2D Window")
-                      (resolution #(640 480))
-                      (fullscreen? #f))
-  (%make-window title resolution fullscreen?))
-
-(define window-resize-hook (make-hook 2))
-
-(register-event-handler
- 'video-resize
- (lambda (e)
-   (run-hook window-resize-hook
-             (SDL:event:resize:w e)
-             (SDL:event:resize:h e))))
-
-(define-signal window-size
-  (hook->signal window-resize-hook
-                #(0 0)
-                (lambda (width height)
-                  (vector width height))))
-(define-signal window-width (signal-map vx window-size))
-(define-signal window-height (signal-map vy window-size))
-
-(define-signal window-projection
-  (signal-map (lambda (size)
-                (if (or (zero? (vx size)) (zero? (vy size)))
-                    identity-transform
-                    (orthographic-projection 0 (vx size) 0 (vy size) -1 1)))
-              window-size))
-
-(define window-close-hook (make-hook))
-
-(register-event-handler
- 'quit
- (lambda (e)
-   (run-hook window-close-hook)))
-
-(define* (open-window #:optional (window (make-window #:title "")))
-  "Open the game window using the settings in WINDOW."
-  (let ((flags (if (window-fullscreen? window) '(opengl fullscreen) 'opengl))
-        (width (vx (window-resolution window)))
-        (height (vy (window-resolution window))))
-    (signal-set! window-size (vector width height))
-    ;; Initialize everything
-    (SDL:enable-unicode #t)
-    (SDL:init 'everything)
-    ;; Open SDL window in OpenGL mode.
-    (SDL:set-video-mode width height 24 flags)
-    (SDL:set-caption (window-title window))
-    ;; Enable texturing and alpha blending
-    (gl-enable (enable-cap texture-2d))
-    (gl-enable (enable-cap blend))
-    (set-gl-blend-function (blending-factor-src src-alpha)
-                           (blending-factor-dest one-minus-src-alpha))))
-
-(define (close-window)
-  "Close the currently open window and audio."
-  (SDL:quit))
-
-(define-syntax-rule (with-window window body ...)
-  (dynamic-wind
-    (lambda () (open-window window))
-    (lambda () body ...)
-    (lambda () (close-window))))
diff --git a/2d/wrappers/freeimage.scm b/2d/wrappers/freeimage.scm
deleted file mode 100644
index 544bf51..0000000
--- a/2d/wrappers/freeimage.scm
+++ /dev/null
@@ -1,263 +0,0 @@
-;;; guile-2d
-;;; Copyright (C) 2013, 2014 David Thompson <dthompson2@worcester.edu>
-;;;
-;;; This program 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.
-;;;
-;;; This program 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:
-;;
-;; Quick and dirty wrapper for some freeimage functions.
-;;
-;;; Code:
-
-(define-module (2d wrappers freeimage)
-  #:use-module (system foreign)
-  #:use-module (2d wrappers util)
-  #:use-module (ice-9 format))
-
-(define libfreeimage (dynamic-link "libfreeimage"))
-
-(define-syntax-rule (define-foreign name ret string-name args)
-  (define name
-    (pointer->procedure ret (dynamic-func string-name libfreeimage) args)))
-
-(define (number->boolean n)
-  (not (zero? n)))
-
-;;;
-;;; FreeImage file formats
-;;;
-
-(define-enumeration freeimage-format
-  (unknown -1)
-  (bmp      0)
-  (ico      1)
-  (jpeg     2)
-  (jng      3)
-  (koala    4)
-  (lbm      5)
-  (iff      5)
-  (mng      6)
-  (pbm      7)
-  (pbmraw   8)
-  (pcd      9)
-  (pcx      10)
-  (pgm      11)
-  (pgmraw   12)
-  (png      13)
-  (ppm      14)
-  (ppmraw   15)
-  (ras      16)
-  (targa    17)
-  (tiff     18)
-  (wbmp     19)
-  (psd      20)
-  (cut      21)
-  (xbm      22)
-  (xpm      23)
-  (dds      24)
-  (gif      25)
-  (hdr      26)
-  (faxg3    27)
-  (sgi      28)
-  (exr      29)
-  (j2k      30)
-  (jp2      31)
-  (pfm      32)
-  (pict     33)
-  (raw      34))
-
-(export freeimage-format)
-
-;;;
-;;; General functions
-;;;
-
-(define-foreign %freeimage-get-version
-  '* "FreeImage_GetVersion" '())
-(define-foreign %freeimage-set-output-message
-  void "FreeImage_SetOutputMessage" '(*))
-
-(define (freeimage-get-version)
-  (pointer->string (%freeimage-get-version)))
-
-(define (freeimage-set-output-message callback)
-  (%freeimage-set-output-message
-   (procedure->pointer void
-                       (lambda (image-format message)
-                         (callback image-format (pointer->string message)))
-                       (list unsigned-int '*))))
-
-;; Set a default output message callback to writes to stdout.
-(freeimage-set-output-message
- (lambda (image-format message)
-   (display "freeimage error: ")
-   (display message)
-   (newline)))
-
-(export freeimage-get-version
-        freeimage-set-output-message)
-
-
-;;;
-;;; Bitmap management functions
-;;;
-
-(define-wrapped-pointer-type <freeimage-bitmap>
-  freeimage-bitmap?
-  wrap-freeimage-bitmap unwrap-freeimage-bitmap
-  (lambda (r port)
-    (let ((bitmap (unwrap-freeimage-bitmap r)))
-      (format port
-              "<freeimage-bitmap ~x width: ~d height: ~d bpp: ~d>"
-              (pointer-address bitmap)
-              (%freeimage-get-width bitmap)
-              (%freeimage-get-height bitmap)
-              (%freeimage-get-bpp bitmap)))))
-
-(define-foreign %freeimage-load
-  '* "FreeImage_Load" (list unsigned-int '* unsigned-int))
-(define-foreign %freeimage-unload
-  void "FreeImage_Unload" '(*))
-
-(define (freeimage-load image-format filename)
-  (wrap-freeimage-bitmap
-   (%freeimage-load image-format (string->pointer filename) 0)))
-
-(define (freeimage-unload bitmap)
-  (%freeimage-unload (unwrap-freeimage-bitmap bitmap)))
-
-(export <freeimage-bitmap>
-        freeimage-bitmap?
-        freeimage-load
-        freeimage-unload)
-
-;;;
-;;; Bitmap information functions
-;;;
-
-(define-foreign %freeimage-get-image-type
-  unsigned-int "FreeImage_GetImageType" '(*))
-(define-foreign %freeimage-get-bpp
-  unsigned-int "FreeImage_GetBPP" '(*))
-(define-foreign %freeimage-get-width
-  unsigned-int "FreeImage_GetWidth" '(*))
-(define-foreign %freeimage-get-height
-  unsigned-int "FreeImage_GetHeight" '(*))
-(define-foreign %freeimage-get-pitch
-  unsigned-int "FreeImage_GetPitch" '(*))
-(define-foreign %freeimage-get-red-mask
-  unsigned-int "FreeImage_GetRedMask" '(*))
-(define-foreign %freeimage-get-green-mask
-  unsigned-int "FreeImage_GetGreenMask" '(*))
-(define-foreign %freeimage-get-blue-mask
-  unsigned-int "FreeImage_GetBlueMask" '(*))
-(define-foreign %freeimage-has-pixels
-  unsigned-int "FreeImage_HasPixels" '(*))
-
-(define (freeimage-get-image-type bitmap)
-  (%freeimage-get-image-type (unwrap-freeimage-bitmap bitmap)))
-
-(define (freeimage-get-bpp bitmap)
-  (%freeimage-get-bpp (unwrap-freeimage-bitmap bitmap)))
-
-(define (freeimage-get-width bitmap)
-  (%freeimage-get-width (unwrap-freeimage-bitmap bitmap)))
-
-(define (freeimage-get-height bitmap)
-  (%freeimage-get-height (unwrap-freeimage-bitmap bitmap)))
-
-(define (freeimage-get-pitch bitmap)
-  (%freeimage-get-pitch (unwrap-freeimage-bitmap bitmap)))
-
-(define (freeimage-get-red-mask bitmap)
-  (%freeimage-get-red-mask (unwrap-freeimage-bitmap bitmap)))
-
-(define (freeimage-get-green-mask bitmap)
-  (%freeimage-get-green-mask (unwrap-freeimage-bitmap bitmap)))
-
-(define (freeimage-get-blue-mask bitmap)
-  (%freeimage-get-blue-mask (unwrap-freeimage-bitmap bitmap)))
-
-(define (freeimage-has-pixels? bitmap)
-  (number->boolean
-   (%freeimage-has-pixels (unwrap-freeimage-bitmap bitmap))))
-
-(export freeimage-get-image-type
-        freeimage-get-bpp
-        freeimage-get-width
-        freeimage-get-height
-        freeimage-get-red-mask
-        freeimage-get-green-mask
-        freeimage-get-blue-mask
-        freeimage-has-pixels?)
-
-;;;
-;;; Filetype functions
-;;;
-
-(define-foreign %freeimage-get-file-type
-  unsigned-int "FreeImage_GetFileType" (list '* int))
-
-(define (freeimage-get-file-type filename)
-  (%freeimage-get-file-type (string->pointer filename) 0))
-
-(export freeimage-get-file-type)
-
-;;;
-;;; Pixel access functions
-;;;
-
-(define-foreign %freeimage-get-bits '* "FreeImage_GetBits" '(*))
-
-(define (freeimage-get-bits bitmap)
-  (pointer->bytevector
-     (%freeimage-get-bits (unwrap-freeimage-bitmap bitmap))
-     (* (freeimage-get-height bitmap)
-        (freeimage-get-pitch bitmap))))
-
-(export freeimage-get-bits)
-
-;;;
-;;; Conversion functions
-;;;
-
-(define-foreign %freeimage-convert-to-24-bits
-  '* "FreeImage_ConvertTo24Bits" '(*))
-(define-foreign %freeimage-convert-to-32-bits
-  '* "FreeImage_ConvertTo32Bits" '(*))
-
-(define (freeimage-convert-to-24-bits bitmap)
-  (wrap-freeimage-bitmap
-   (%freeimage-convert-to-24-bits (unwrap-freeimage-bitmap bitmap))))
-
-(define (freeimage-convert-to-32-bits bitmap)
-  (wrap-freeimage-bitmap
-   (%freeimage-convert-to-32-bits (unwrap-freeimage-bitmap bitmap))))
-
-(export freeimage-convert-to-24-bits
-        freeimage-convert-to-32-bits)
-
-;;;
-;;; Rotation and flipping
-;;;
-
-(define-foreign %freeimage-flip-vertical
-  uint8 "FreeImage_FlipVertical" '(*))
-
-(define (freeimage-flip-vertical bitmap)
-  (number->boolean
-   (%freeimage-flip-vertical (unwrap-freeimage-bitmap bitmap))))
-
-(export freeimage-flip-vertical)
diff --git a/2d/wrappers/gl.scm b/2d/wrappers/gl.scm
deleted file mode 100644
index 3ee84dd..0000000
--- a/2d/wrappers/gl.scm
+++ /dev/null
@@ -1,96 +0,0 @@
-;;; guile-2d
-;;; Copyright (C) 2013, 2014 David Thompson <dthompson2@worcester.edu>
-;;;
-;;; This program 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.
-;;;
-;;; This program 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 (2d wrappers gl)
-  #:use-module ((gl low-level) #:renamer (symbol-prefix-proc '%))
-  #:use-module (gl runtime)
-  #:use-module (gl types))
-
-;;;
-;;; 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))
-
-;; emacs: (put 'with-gl-bind-texture 'scheme-indent-function 2)
-(define-syntax-rule (with-gl-bind-texture target id body ...)
-  (begin
-    (%glBindTexture target id)
-    body
-    ...
-    (%glBindTexture target 0)))
-
-(export with-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)
diff --git a/2d/wrappers/util.scm b/2d/wrappers/util.scm
deleted file mode 100644
index 254dc3a..0000000
--- a/2d/wrappers/util.scm
+++ /dev/null
@@ -1,40 +0,0 @@
-;;; guile-2d
-;;; Copyright (C) 2013, 2014 David Thompson <dthompson2@worcester.edu>
-;;;
-;;; This program 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.
-;;;
-;;; This program 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:
-;;
-;; Wrapper helper procedures.
-;;
-;;; Code:
-
-(define-module (2d wrappers util)
-  #:export (define-enumeration))
-
-;; Borrowed from guile-opengl
-(define-syntax-rule (define-enumeration enumerator (name value) ...)
-  (define-syntax enumerator
-    (lambda (x)
-      (syntax-case x ()
-        ((_)
-         #''(name ...))
-        ((_ enum) (number? (syntax->datum #'enum))
-         #'enum)
-        ((_ enum)
-         (or (assq-ref '((name . value) ...)
-                       (syntax->datum #'enum))
-             (syntax-violation 'enumerator "invalid enumerated value"
-                               #'enum)))))))
author	David Thompson <dthompson2@worcester.edu>	2014-06-28 18:46:16 -0400
committer	David Thompson <dthompson2@worcester.edu>	2014-06-28 18:46:16 -0400
commit	f47eb69a354188154731846dde8b384c2c2f39f6 (patch)
tree	6aa1ccb9212836b7c941e771475eb995fa6df9f9 /2d
parent	df0f2a5f3f09394f1953abbc7e33e9a98204680e (diff)