WIP: Switch to WebGPU-like API

7 files changed, 1808 insertions, 1734 deletions

diff --git a/chickadee.scm b/chickadee.scm
index 656ce0b..8343a6b 100644
--- a/chickadee.scm
+++ b/chickadee.scm
@@ -16,7 +16,7 @@
 
 ;;; Commentary:
 ;;
-;; Simple SDL + OpenGL game loop implementation.
+;; Core event loop.
 ;;
 ;;; Code:
 
@@ -26,12 +26,12 @@
   #:use-module (chickadee game-loop)
   #:use-module (chickadee math matrix)
   #:use-module (chickadee graphics color)
-  #:use-module (chickadee graphics engine)
   #:use-module (chickadee graphics gpu)
-  #:use-module (chickadee graphics viewport)
+  ;; #:use-module (chickadee graphics viewport)
   #:use-module (chickadee utils)
   #:use-module (ice-9 atomic)
   #:use-module (ice-9 match)
+  #:use-module (ice-9 threads)
   #:use-module (sdl2)
   #:use-module (sdl2 events)
   #:use-module ((sdl2 input game-controller) #:prefix sdl2:)
@@ -76,6 +76,9 @@
   #:re-export (abort-game
                current-timestep))
 
+
+
+
 (define %time-freq (exact->inexact internal-time-units-per-second))
 
 (define (elapsed-time)
@@ -155,10 +158,8 @@ not being pushed at all."
 
 (define* (make-window #:key (title "Chickadee") fullscreen? resizable?
                       (width 640) (height 480) (multisample? #t))
-  ;; Hint that we want OpenGL 3.2 Core profile.  Doesn't mean we'll
-  ;; get it, though!
-  (sdl2:set-gl-attribute! 'context-major-version 3)
-  (sdl2:set-gl-attribute! 'context-major-version 2)
+  ;; Hint that we want the core profile with deprecated features
+  ;; disabled.  Doesn't mean we'll get it, though!
   (sdl2:set-gl-attribute! 'context-profile-mask 1) ; core profile
   (sdl2:set-gl-attribute! 'stencil-size 8) ; 8-bit stencil buffer
   (if multisample?
@@ -254,7 +255,8 @@ border is disabled, otherwise it is enabled.")
                    (window-height 480)
                    window-fullscreen?
                    window-resizable?
-                   (clear-color %default-clear-color)
+                   (clear-color black;; %default-clear-color
+                                )
                    (update-hz 60)
                    (load noop)
                    (update noop)
@@ -304,20 +306,19 @@ border is disabled, otherwise it is enabled.")
                                   #:fullscreen? window-fullscreen?
                                   #:resizable? window-resizable?
                                   #:multisample? #f)))
-         (default-viewport (vector
-                            (make-viewport 0 0 window-width window-height
-                                           #:clear-color clear-color)))
+         ;; (default-viewport (vector
+         ;;                    (make-viewport 0 0 window-width window-height
+         ;;                                   #:clear-color clear-color)))
          (default-projection (vector
                               (orthographic-projection 0 window-width
                                                        window-height 0
                                                        0 1)))
-         (gpu (make-gpu (window-gl-context window)))
-         (gfx (make-graphics-engine gpu)))
+         (gpu (make-gpu (unwrap-window window) (window-gl-context window))))
     (define (invert-y y)
       ;; SDL's origin is the top-left, but our origin is the bottom
       ;; left so we need to invert Y coordinates that SDL gives us.
       (- window-height y))
-    (define (input-sdl)
+    (define (flush-sdl-input)
       (define (process-event event)
         (cond
          ((quit-event? event)
@@ -398,9 +399,9 @@ border is disabled, otherwise it is enabled.")
             ((width height)
              (set! window-width width)
              (set! window-height height)
-             (vector-set! default-viewport 0
-                          (make-viewport 0 0 width height
-                                         #:clear-color clear-color))
+             ;; (vector-set! default-viewport 0
+             ;;              (make-viewport 0 0 width height
+             ;;                             #:clear-color clear-color))
              (vector-set! default-projection 0
                           (orthographic-projection 0 width height 0 0 1))
              (window-resize width height))))))
@@ -409,51 +410,58 @@ border is disabled, otherwise it is enabled.")
         (when event
           (process-event event)
           (loop (poll-event)))))
-    (define (update-sdl dt)
-      (input-sdl)
-      (update dt)
-      ;; Update audio after updating game state so that any sounds
-      ;; that were queued to play this frame start playing immediately.
-      (update-audio)
-      ;; Free any GPU resources that have been GC'd.
-      (graphics-engine-gc gfx))
-    (define (render-sdl-opengl alpha)
-      (graphics-engine-reset! gfx)
-      ;; Enable seamless cube maps.
-      ;; TODO: This should go somewhere else.
-      (set-gpu-seamless-cube-maps! (current-gpu) #t)
-      (with-viewport (vector-ref default-viewport 0)
-        (clear-viewport)
-        (with-graphics-state ((projection (vector-ref default-projection 0)))
-          (draw alpha)))
-      (sdl2:swap-gl-window (unwrap-window window)))
     (define (on-error e stack)
       (error e stack)
       ;; Flush all input events that have occurred while in the error
       ;; state.
       (while (poll-event) #t))
-    (dynamic-wind
-      (const #t)
-      (lambda ()
-        (parameterize ((current-window window)
-                       (current-graphics-engine gfx))
-          ;; Attempt to activate vsync, if possible.  Some systems do
-          ;; not support setting the OpenGL swap interval.
-          (catch #t
-            (lambda ()
-              (sdl2:set-gl-swap-interval! 'vsync))
-            (lambda args
-              (display "warning: could not enable vsync\n"
-                       (current-error-port))))
-          (sdl2:load-game-controller-mappings!
-           (scope-datadir "gamecontrollerdb.txt"))
-          (run-game* #:init load
-                     #:update update-sdl
-                     #:render render-sdl-opengl
-                     #:error (and error on-error)
-                     #:time elapsed-time
-                     #:update-hz update-hz)))
+    ;; The game loop will run in its own thread so that updating game
+    ;; state can happen while rendering and input are being processed
+    ;; in the main thread and thus improving overall performance.
+    ;; This is where all user code is executed.
+    (define (game-loop)
+      (parameterize ((current-window window)
+                     (current-gpu gpu))
+        (run-game* #:init load
+                   #:update update
+                   #:render draw
+                   #:error (and error on-error)
+                   #:time elapsed-time
+                   #:update-hz update-hz)))
+    ;; The main loop handles the input and rendering queues, as input
+    ;; polling and GPU calls have to be done from the main thread in
+    ;; SDL.
+    (define (main-loop)
+      (flush-sdl-input)
+      (update-audio)
+      ;; (graphics-engine-reset! gfx)
+      ;; Enable seamless cube maps.
+      ;; TODO: This should go somewhere else.
+      ;; (set-gpu-seamless-cube-maps! (current-gpu) #t)
+      ;; (with-viewport (vector-ref default-viewport 0)
+      ;;   (clear-viewport)
+      ;;   (with-graphics-state ((projection (vector-ref default-projection 0)))
+      ;;     (draw alpha)))
+      (gpu-tick gpu)
+      (gpu-swap gpu)
+      ;; Free any GPU resources that have been GC'd.
+      (gpu-gc gpu)
+      (usleep 1) ; don't use 100% of the cpu pls
+      (main-loop))
+    ;; Attempt to activate vsync, if possible.  Some systems do
+    ;; not support setting the OpenGL swap interval.
+    (catch #t
       (lambda ()
-        (quit-audio)
-        (sdl2:delete-gl-context! (window-gl-context window))
-        (sdl2:close-window! (unwrap-window window))))))
+        (sdl2:set-gl-swap-interval! 'vsync))
+      (lambda args
+        (display "warning: could not enable vsync\n"
+                 (current-error-port))))
+    ;; Make lots of game controllers "just work."
+    (sdl2:load-game-controller-mappings!
+     (scope-datadir "gamecontrollerdb.txt"))
+    ;; Launch game loop in a separate thread and start the main loop.
+    (let ((game-thread (call-with-new-thread game-loop)))
+      (main-loop)
+      (quit-audio)
+      (sdl2:delete-gl-context! (window-gl-context window))
+      (sdl2:close-window! (unwrap-window window)))))
diff --git a/chickadee/graphics/backend/opengl.scm b/chickadee/graphics/backend/opengl.scm
new file mode 100644
index 0000000..ab797a7
--- /dev/null
+++ b/chickadee/graphics/backend/opengl.scm
@@ -0,0 +1,896 @@
+;;; Chickadee Game Toolkit
+;;; Copyright © 2023 David Thompson <dthompson2@worcester.edu>
+;;;
+;;; Licensed under the Apache License, Version 2.0 (the "License");
+;;; you may not use this file except in compliance with the License.
+;;; You may obtain a copy of the License at
+;;;
+;;;    http://www.apache.org/licenses/LICENSE-2.0
+;;;
+;;; Unless required by applicable law or agreed to in writing, software
+;;; distributed under the License is distributed on an "AS IS" BASIS,
+;;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+;;; See the License for the specific language governing permissions and
+;;; limitations under the License.
+
+;;; Commentary:
+;;
+;; OpenGL GPU backend.  Supports even old ass OpenGL 2.1 hardware that
+;; lots of people are still using!
+;;
+;;; Code:
+
+(define-module (chickadee graphics backend opengl)
+  #:use-module (chickadee data array-list)
+  #:use-module (chickadee data queue)
+  #:use-module (chickadee graphics color)
+  #:use-module (chickadee graphics gpu)
+  #:use-module (chickadee math rect)
+  #:use-module (gl)
+  #:use-module ((gl low-level) #:renamer (symbol-prefix-proc '%))
+  #:use-module (gl runtime)
+  #:use-module (gl types)
+  #:use-module (ice-9 match)
+  #:use-module (rnrs bytevectors)
+  #:use-module ((sdl2 video) #:select (gl-context-make-current!
+                                       swap-gl-window))
+  #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-9)
+  #:use-module (srfi srfi-9 gnu)
+  #:use-module ((system foreign)
+                #:select (bytevector->pointer
+                          pointer->bytevector
+                          pointer->string
+                          pointer-address
+                          make-pointer
+                          %null-pointer)))
+
+
+;;;
+;;; Additional OpenGL wrappers
+;;;
+
+;; TODO: Upstream these to guile-opengl
+
+(define gl-clear-color %glClearColor)
+(define gl-scissor %glScissor)
+(define gl-blend-func %glBlendFunc)
+(define gl-blend-equation %glBlendEquation)
+(define gl-texture-image-3d %glTexImage3D)
+(define gl-texture-image-2d %glTexImage2D)
+(define gl-texture-image-1d %glTexImage1D)
+(define gl-copy-texture-image-2d %glCopyTexImage2D)
+(define gl-copy-texture-image-1d %glCopyTexImage1D)
+(define gl-copy-texture-sub-image-3d %glCopyTexSubImage3D)
+(define gl-copy-texture-sub-image-2d %glCopyTexSubImage2D)
+(define gl-copy-texture-sub-image-1d %glCopyTexSubImage1D)
+(define gl-texture-sub-image-3d %glTexSubImage3D)
+(define gl-texture-sub-image-2d %glTexSubImage2D)
+(define gl-texture-sub-image-1d %glTexSubImage1D)
+(define gl-compressed-texture-image-1d %glCompressedTexImage1D)
+(define gl-compressed-texture-image-2d %glCompressedTexImage2D)
+(define gl-compressed-texture-image-3d %glCompressedTexImage3D)
+(define gl-compressed-texture-sub-image-1d %glCompressedTexSubImage1D)
+(define gl-compressed-texture-sub-image-2d %glCompressedTexSubImage2D)
+(define gl-compressed-texture-sub-image-3d %glCompressedTexSubImage3D)
+(define gl-texture-parameter %glTexParameteri)
+(define gl-bind-texture %glBindTexture)
+(define gl-get-tex-image %glGetTexImage)
+(define gl-buffer-data %glBufferData)
+(define gl-buffer-sub-data %glBufferSubData)
+(define gl-map-buffer %glMapBuffer)
+(define gl-unmap-buffer %glUnmapBuffer)
+(define gl-draw-buffers %glDrawBuffers)
+(define gl-use-program %glUseProgram)
+(define gl-link-program  %glLinkProgram)
+(define gl-bind-attrib-location  %glBindAttribLocation)
+(define gl-attach-shader  %glAttachShader)
+(define gl-detach-shader  %glDetachShader)
+(define gl-get-attrib-location  %glGetAttribLocation)
+(define gl-get-uniform-location  %glGetUniformLocation)
+(define gl-create-program  %glCreateProgram)
+(define gl-get-program-info-log  %glGetProgramInfoLog)
+(define gl-get-programiv  %glGetProgramiv)
+(define gl-delete-program  %glDeleteProgram)
+(define gl-delete-shader  %glDeleteShader)
+(define gl-get-shaderiv  %glGetShaderiv)
+(define gl-get-shader-info-log  %glGetShaderInfoLog)
+(define gl-compile-shader  %glCompileShader)
+(define gl-shader-source  %glShaderSource)
+(define gl-create-shader  %glCreateShader)
+(define gl-get-active-uniform %glGetActiveUniform)
+(define gl-get-active-attrib %glGetActiveAttrib)
+(define gl-uniform1i  %glUniform1i)
+(define gl-uniform1iv %glUniform1iv)
+(define gl-uniform2i  %glUniform2i)
+(define gl-uniform3i  %glUniform3i)
+(define gl-uniform4i  %glUniform4i)
+(define gl-uniform1f %glUniform1f)
+(define gl-uniform1fv  %glUniform1fv)
+(define gl-uniform2f  %glUniform2f)
+(define gl-uniform2fv  %glUniform2fv)
+(define gl-uniform3f %glUniform3f)
+(define gl-uniform3fv %glUniform3fv)
+(define gl-uniform4f  %glUniform4f)
+(define gl-uniform4fv %glUniform4fv)
+(define gl-uniform-matrix3fv %glUniformMatrix3fv)
+(define gl-uniform-matrix4fv %glUniformMatrix4fv)
+(define gl-point-size %glPointSize)
+(define gl-get-string %glGetString)
+(define gl-get-integer-v %glGetIntegerv)
+(define gl-depth-func %glDepthFunc)
+(define gl-depth-mask %glDepthMask)
+(define gl-depth-range %glDepthRange)
+(define gl-stencil-mask %glStencilMask)
+(define gl-stencil-mask-separate %glStencilMaskSeparate)
+(define gl-stencil-func %glStencilFunc)
+(define gl-stencil-func-separate %glStencilFuncSeparate)
+(define gl-stencil-op %glStencilOp)
+(define gl-stencil-op-separate %glStencilOpSeparate)
+(define gl-polygon-mode %glPolygonMode)
+(define gl-cull-face %glCullFace)
+(define gl-front-face %glFrontFace)
+(define gl-color-mask %glColorMask)
+(define gl-get-error %glGetError)
+
+(define-gl-procedure (glGenerateMipmap (target GLenum) -> void)
+  "Generate mipmaps for the texture attached to target of the active
+texture unit.")
+
+(define-gl-procedure (glTextureView (texture GLuint)
+                                    (target GLenum)
+                                    (origtexture GLuint)
+                                    (internalformat GLenum)
+                                    (minlevel GLuint)
+                                    (numlevels GLuint)
+                                    (minlayer GLuint)
+                                    (numlayers GLuint)
+                                    -> void)
+  "Initialize a texture as a data alias of another texture's data
+store.")
+
+(define-gl-procedure (glGenSamplers (n GLsizei)
+                                    (ids GLuint-*)
+                                    -> void)
+  "Generate sampler object names.")
+
+(define-gl-procedure (glDeleteSamplers (n GLsizei)
+                                       (ids GLuint-*)
+                                       -> void)
+  "Delete named sampler objects.")
+
+(define-gl-procedure (glDrawArraysInstanced (mode GLenum)
+                                            (first GLint)
+                                            (count GLsizei)
+                                            (primcount GLsizei)
+                                            -> void)
+  "Draw multiple instances of a set of arrays.")
+
+(define-gl-procedure (glDrawElementsInstanced (mode GLenum)
+                                              (count GLsizei)
+                                              (type GLenum)
+                                              (indices void-*)
+                                              (primcount GLsizei)
+                                              -> void)
+  "Draw multiple instances of a set of elements.")
+
+(define-gl-procedure (glVertexAttribDivisor (index GLuint)
+                                            (divisor GLuint)
+                                            -> void)
+  "Modify the rate at which generic vertex attributes advance during
+instanced rendering.")
+
+(define-gl-procedure (glGenVertexArrays (n GLsizei)
+                                        (arrays GLuint-*)
+                                        -> void)
+  "Generate N vertex arrays.")
+
+(define-gl-procedure (glDeleteVertexArrays (n GLsizei)
+                                           (arrays GLuint-*)
+                                           -> void)
+  "Delete vertex array objects.")
+
+(define-gl-procedure (glBindVertexArray (array GLuint)
+                                        -> void)
+  "Bind vertex array object ARRAY.")
+
+(define-gl-procedure (glEnableVertexAttribArray (index GLuint)
+                                                -> void)
+  "Enable or disable a generic vertex attribute array.")
+
+(define-gl-procedure (glVertexAttribPointer (index GLuint)
+                                            (size GLint)
+                                            (type GLenum)
+                                            (normalized GLboolean)
+                                            (stride GLsizei)
+                                            (pointer GLvoid-*)
+                                            -> void)
+  "Define an array of generic vertex attribute data.")
+
+(define-gl-procedure (glDrawElements (mode GLenum)
+                                     (count GLsizei)
+                                     (type GLenum)
+                                     (indices GLvoid-*)
+                                     -> void)
+  "Render primitives from array data.")
+
+(define-gl-procedure (glGenFramebuffers (n GLsizei)
+                                        (ids GLuint-*)
+                                        -> void)
+  "Generate framebuffer object names.")
+
+(define-gl-procedure (glDeleteFramebuffers (n GLsizei)
+                                           (framebuffers GLuint-*)
+                                           -> void)
+  "Delete framebuffer objects.")
+
+(define-gl-procedure (glBindFramebuffer (target GLenum)
+                                        (framebuffer GLuint)
+                                        -> void)
+  "Bind a framebuffer to a framebuffer target.")
+
+(define-gl-procedure (glGetFramebufferAttachmentParameteriv (target GLenum)
+                                                            (attachment GLenum)
+                                                            (pname GLenum)
+                                                            (params GLint-*)
+                                                            -> void)
+  "Return attachment parameters of a framebuffer object.")
+
+(define-gl-procedure (glFramebufferTexture2D (target GLenum)
+                                             (attachment GLenum)
+                                             (textarget GLenum)
+                                             (texture GLuint)
+                                             (level GLint)
+                                             -> void)
+  "Attach a level of a texture object as a logical buffer to the
+currently bound framebuffer object.")
+
+(define-gl-procedure (glCheckFramebufferStatus (target GLenum)
+                                               -> GLenum)
+  "Return the framebuffer completeness status of a framebuffer
+object.")
+
+(define-gl-procedure (glGenRenderbuffers (n GLsizei)
+                                         (ids GLuint-*)
+                                         -> void)
+  "Generate renderbuffer object names.")
+
+(define-gl-procedure (glDeleteRenderbuffers (n GLsizei)
+                                            (renderbuffers GLuint-*)
+                                            -> void)
+  "Delete renderbuffer objects.")
+
+(define-gl-procedure (glBindRenderbuffer (target GLenum)
+                                         (renderbuffer GLuint)
+                                         -> void)
+  "Bind a named renderbuffer object.")
+
+(define-gl-procedure (glRenderbufferStorage (target GLenum)
+                                            (internalformat GLenum)
+                                            (width GLsizei)
+                                            (height GLsizei)
+                                            -> void)
+  "Create and initialize a renderbuffer object's data store.")
+
+(define-gl-procedure (glFramebufferRenderbuffer (target GLenum)
+                                                (attachment GLenum)
+                                                (renderbuffertarget GLenum)
+                                                (renderbuffer GLuint)
+                                                -> void)
+  "Attach a renderbuffer object to a framebuffer object.")
+
+(define-gl-procedure (glUniform1ui (location GLint)
+                                   (v0 GLuint)
+                                   -> void)
+  "Specify the value of a uniform variable for the current program object")
+
+(define-gl-procedure (glUniform1uiv (location GLint)
+                                    (count GLint)
+                                    (ptr GLvoid-*)
+                                    -> void)
+  "Specify the value of a uniform variable for the current program object")
+
+(define gl-generate-mipmap glGenerateMipmap)
+(define gl-texture-view glTextureView)
+(define gl-gen-samplers glGenSamplers)
+(define gl-draw-arrays-instanced glDrawArraysInstanced)
+(define gl-draw-elements-instanced glDrawElementsInstanced)
+(define gl-vertex-attrib-divisor glVertexAttribDivisor)
+(define gl-gen-vertex-arrays glGenVertexArrays)
+(define gl-delete-vertex-arrays glDeleteVertexArrays)
+(define gl-bind-vertex-array glBindVertexArray)
+(define gl-enable-vertex-attrib-array glEnableVertexAttribArray)
+(define gl-vertex-attrib-pointer glVertexAttribPointer)
+(define gl-draw-elements glDrawElements)
+(define gl-gen-framebuffers glGenFramebuffers)
+(define gl-bind-framebuffer glBindFramebuffer)
+(define gl-get-framebuffer-attachment-parameteriv
+  glGetFramebufferAttachmentParameteriv)
+(define gl-framebuffer-texture-2d glFramebufferTexture2D)
+(define gl-check-framebuffer-status glCheckFramebufferStatus)
+(define gl-gen-renderbuffers glGenRenderbuffers)
+(define gl-delete-renderbuffers glDeleteRenderbuffers)
+(define gl-bind-renderbuffer glBindRenderbuffer)
+(define gl-renderbuffer-storage glRenderbufferStorage)
+(define gl-framebuffer-renderbuffer glFramebufferRenderbuffer)
+(define gl-uniform1ui glUniform1ui)
+(define gl-uniform1uiv glUniform1uiv)
+
+(define (gl-generate-sampler)
+  (let ((bv (u32vector 0)))
+    (glGenSamplers 1 bv)
+    (u32vector-ref bv 0)))
+
+(define (gl-delete-sampler n)
+  (let ((bv (u32vector n)))
+    (glDeleteSamplers 1 bv)))
+
+(define (gl-generate-vertex-array)
+  (let ((bv (u32vector 0)))
+    (glGenVertexArrays 1 bv)
+    (u32vector-ref bv 0)))
+
+(define (gl-delete-vertex-array n)
+  (let ((bv (u32vector n)))
+    (glDeleteVertexArrays 1 bv)))
+
+(define (gl-generate-framebuffer)
+  (let ((bv (u32vector 0)))
+    (glGenFramebuffers 1 bv)
+    (u32vector-ref bv 0)))
+
+(define (gl-delete-framebuffer n)
+  (let ((bv (u32vector n)))
+    (glDeleteFramebuffers 1 bv)))
+
+(define (gl-generate-renderbuffer)
+  (let ((bv (u32vector 0)))
+    (glGenRenderbuffers 1 bv)
+    (u32vector-ref bv 0)))
+
+(define (gl-delete-renderbuffer n)
+  (let ((bv (u32vector n)))
+    (glDeleteRenderbuffers 1 bv)))
+
+
+;;;
+;;; Internal API imports
+;;;
+
+(define-syntax-rule (define-internal-import name)
+  (define name (@@ (chickadee graphics gpu) name)))
+
+(define-internal-import buffer-handle)
+(define-internal-import shader-module-handle)
+(define-internal-import <vertex-attribute>)
+(define-internal-import <vertex-buffer-layout>)
+(define-internal-import <vertex-state>)
+(define-internal-import <blend-component>)
+(define-internal-import <blend-state>)
+(define-internal-import <color-target-state>)
+(define-internal-import <fragment-state>)
+(define-internal-import <primitive-state>)
+(define-internal-import <stencil-face-state>)
+(define-internal-import <depth-stencil-state>)
+(define-internal-import <multisample-state>)
+(define-internal-import <render-pipeline>)
+(define-internal-import <render-state>)
+(define-internal-import <draw-command>)
+
+
+;;;
+;;; GPU backend
+;;;
+
+(define-record-type <gl-buffer>
+  (%make-gl-buffer id)
+  gl-buffer?
+  (id gl-buffer-id)
+  (map-target gl-buffer-map-target set-gl-buffer-map-target!))
+
+(define-record-type <gl-texture>
+  (%make-gl-texture id)
+  gl-texture?
+  (id gl-texture-id))
+
+(define-record-type <gl-texture-view>
+  (%make-gl-texture-view id)
+  gl-texture-view?
+  (id gl-texture-view-id))
+
+(define-record-type <gl-sampler>
+  (%make-gl-sampler id)
+  gl-sampler?
+  (id gl-sampler-id))
+
+(define-record-type <gl-shader>
+  (make-gl-shader id)
+  gl-shader?
+  (id gl-shader-id))
+
+(define-record-type <gl-shader-module>
+  (%make-gl-shader-module vertex fragment)
+  gl-shader-module?
+  (vertex gl-shader-module-vertex)
+  (fragment gl-shader-module-fragment))
+
+(define-record-type <gl-program>
+  (make-gl-program id)
+  gl-program?
+  (id gl-program-id))
+
+(define-record-type <gl-meta>
+  (%make-gl-meta version glsl-version vendor renderer driver extensions)
+  gl-meta?
+  (version gl-meta-version)
+  (glsl-version gl-meta-glsl-version)
+  (vendor gl-meta-vendor)
+  (renderer gl-meta-renderer)
+  (driver gl-meta-driver)
+  (extensions gl-meta-extensions))
+
+(define (make-gl-meta)
+  (define (get-string id)
+    (pointer->string (gl-get-string id)))
+  (define (parse-version str)
+    (match (string-split str #\space)
+      ((version . _) version)))
+  (let ((version (get-string (string-name version)))
+        (extensions (make-hash-table)))
+    (for-each (lambda (name)
+                (hash-set! extensions name #t))
+              (string-split (get-string (string-name extensions))
+                            #\space))
+    (%make-gl-meta (parse-version version)
+                   (parse-version
+                    (get-string
+                     (version-2-0 shading-language-version)))
+                   (get-string (string-name vendor))
+                   (get-string (string-name renderer))
+                   version
+                   extensions)))
+
+(define (gl-meta-has-extension? meta name)
+  (hash-ref (gl-meta-extensions meta) name))
+
+(define-record-type <gl-state>
+  (%make-gl-state window context meta queue)
+  gl-state?
+  (window gl-state-window)
+  (context gl-state-context)
+  (meta gl-state-meta)
+  (queue gl-state-queue)
+  (buffer-index gl-state-buffer-index %set-gl-state-buffer-index!)
+  (buffer-vertex gl-state-buffer-vertex %set-gl-state-buffer-vertex!)
+  (buffer-copy-read gl-state-buffer-copy-read %set-gl-state-buffer-copy-read!)
+  (buffer-copy-write gl-state-buffer-copy-write %set-gl-state-buffer-copy-write!)
+  (program gl-state-program %set-gl-state-program!)
+  (cull-mode gl-state-cull-mode %set-gl-state-cull-mode!)
+  (front-face gl-state-front-face %set-gl-state-front-face!))
+
+(define (make-gl-state window context)
+  (%make-gl-state window context (make-gl-meta) (make-queue)))
+
+(define debug-level (or (getenv "GL_DEBUG") -1))
+
+(define (gl-debug level msg)
+  (when (>= debug-level level)
+    (format #t "gl: ~a\n" msg)))
+
+(define (gl-state-version>= state version)
+  (string>= (gl-meta-version (gl-state-meta state)) version))
+
+(define-syntax-rule (gl-state-make-current! state)
+  (gl-context-make-current! (gl-state-window state) (gl-state-context state)))
+
+(define (gl-state-swap state)
+  (swap-gl-window (gl-state-window state)))
+
+(define (gl-state-enqueue state command-buffer)
+  (let ((q (gl-state-queue state)))
+    (for-each (lambda (cmd) (enqueue! q cmd))
+              (command-buffer-commands command-buffer))))
+
+(define (set-gl-state-buffer-vertex! state buffer)
+  (unless (eq? (gl-state-buffer-vertex state) buffer)
+    (gl-bind-buffer (version-1-5 array-buffer) (gl-buffer-id buffer))
+    (%set-gl-state-buffer-vertex! state buffer)))
+
+(define (set-gl-state-buffer-index! state buffer)
+  (unless (eq? (gl-state-buffer-index state) buffer)
+    (gl-bind-buffer (gl-buffer-id buffer) (version-1-5 element-array-buffer))
+    (%set-gl-state-buffer-index! state buffer)))
+
+(define (set-gl-state-buffer-copy-read! state buffer)
+  (unless (eq? (gl-state-buffer-copy-read state) buffer)
+    (gl-bind-buffer (gl-buffer-id buffer) (version-3-1 copy-read-buffer))
+    (%set-gl-state-buffer-copy-read! state buffer)))
+
+(define (set-gl-state-buffer-copy-write! state buffer)
+  (unless (eq? (gl-state-buffer-copy-write state) buffer)
+    (gl-bind-buffer (gl-buffer-id buffer) (version-3-1 copy-write-buffer))
+    (%set-gl-state-buffer-copy-write! state buffer)))
+
+(define (set-gl-state-program! state program)
+  (unless (eq? (gl-state-program state) program)
+    (gl-use-program (gl-program-id program))
+    (%set-gl-state-program! state program)))
+
+(define (set-gl-state-cull-mode! state cull-mode)
+  (unless (eq? (gl-state-cull-mode state) cull-mode)
+    (match cull-mode
+      ('none
+       (gl-disable (enable-cap cull-face)))
+      ('front
+       (gl-enable (enable-cap cull-face))
+       (gl-cull-face (cull-face-mode front)))
+      ('back
+       (gl-enable (enable-cap cull-face))
+       (gl-cull-face (cull-face-mode back))))
+    (%set-gl-state-cull-mode! state cull-mode)))
+
+(define (set-gl-state-front-face! state front-face)
+  (unless (eq? (gl-state-front-face state) front-face)
+    (match front-face
+      ('ccw (gl-front-face (front-face-direction ccw)))
+      ('cw (gl-front-face (front-face-direction cw))))
+    (%set-gl-state-front-face! state front-face)))
+
+;; (define (set-gl-state-blend-mode! state blend)
+;;   (unless (equal? (gl-state-blend state))
+;;     (match blend
+;;       (#f (gl-disable (enable-cap blend)))
+;;       (($ <blend-state> ($ <blend-component> color-op color-src color-dst)
+;;                         ($ <blend-component> alpha-op alpha-src alpha-dst))
+;;        (gl-enable (enable-cap blend))
+;;        (gl-blend-equation equation)
+;;        (gl-blend-func src dest)))
+;;     (%set-gl-state-blend! state blend)))
+
+(define *offset-cache* (make-hash-table))
+
+(define (offset->pointer offset)
+  (or (hashv-ref *offset-cache* offset)
+      (let ((ptr (make-pointer offset)))
+        (hashv-set! *offset-cache* offset ptr)
+        ptr)))
+
+(define (gl-state-tick state)
+  (define (format-component-count format)
+    (match format
+      ((or 'uint32 'float32) 1)
+      ((or 'uint8x2 'sint8x2 'unorm8x2 'snorm8x2 'uint16x2 'sint16x2
+           'unorm16x2 'snorm16x2 'float16x2 'float32x2 'uint32x2 'sint32
+           'sint32x2)
+       2)
+      ((or 'float32x3 'uint32x3 'sint32x3) 3)
+      ((or 'uint8x4 'sint8x4 'unorm8x4 'snorm8x4 'uint16x4 'sint16x4
+           'unorm16x4 'snorm16x4 'float16x4 'float32x4 'uint32x4 'sint32x4)
+       4)))
+  (define (format-type format)
+    (match format
+      ((or 'uint8x2 'uint8x4)
+       (data-type unsigned-byte))
+      ((or 'uint16x2 'uint16x4)
+       (data-type unsigned-short))
+      ((or 'uint32 'uint32x2 'uint32x3 'uint32x4)
+       (data-type unsigned-int))
+      ((or 'sint8x2 'sint8x4)
+       (data-type byte))
+      ((or 'sint16x2 'sint16x4)
+       (data-type short))
+      ((or 'sint32 'sint32x2 'sint32x3 'sint32x4)
+       (data-type int))
+      ((or 'float16x2 'float16x4)
+       (oes-vertex-half-float half-float-oes))
+      ((or 'float32 'float32x2 'float32x3 'float32x4 'unorm8x2 'unorm8x4
+           'snorm8x2 'snorm8x4 'unorm16x2 'unorm16x4 'snorm16x2 'snorm16x4)
+       (data-type float))))
+  (define (format-normalized? format)
+    (match format
+      ((or 'uint8x2 'uint8x4 'sint8x2 'sint8x4 'uint16x2 'uint16x4 'sint16x2
+           'sint16x4 'float16x2 'float16x4 'float32 'float32x2 'float32x3
+           'float32x4 'uint32 'uint32x2 'uint32x3 'uint32x4 'sint32 'sint32x2
+           'sint32x3 'sint32x4)
+       #f)
+      ((or 'unorm8x2 'unorm8x4 'snorm8x2 'snorm8x4 'unorm16x2 'unorm16x4
+           'snorm16x2 'snorm16x4)
+       #t)))
+  (define (primitive-mode primitive)
+    (match (primitive-state-topology primitive)
+      ('point-list (begin-mode points))
+      ('line-list (begin-mode lines))
+      ('line-strip (begin-mode line-strip))
+      ('triangle-list (begin-mode triangles))
+      ('triangle-strip (begin-mode triangle-strip))))
+  (define (apply-render-pipeline pipeline)
+    (match pipeline
+      (($ <render-pipeline> program
+                            ($ <vertex-state> _ buffers)
+                            fragment
+                            ($ <primitive-state> _ front-face cull-mode _)
+                            depth-stencil
+                            multisample)
+       (set-gl-state-program! state program)
+       (set-gl-state-front-face! state front-face)
+       (set-gl-state-cull-mode! state cull-mode))))
+  (define (apply-render-state render-state)
+    (match render-state
+      (($ <render-state> (and pipeline ($ <render-pipeline> _ vertex fragment))
+                         vertex-buffers)
+       (apply-render-pipeline pipeline)
+       ;; Bind vertex buffers and setup vertex attributes.
+       (let loop ((layouts (vertex-state-buffers vertex))
+                  (i 0))
+         (match layouts
+           (() #t)
+           ((($ <vertex-buffer-layout> stride step-mode attributes) . rest)
+            (set-gl-state-buffer-vertex! state
+                                         (buffer-handle
+                                          (vector-ref vertex-buffers i)))
+            (let attrib-loop ((attributes attributes))
+              (match attributes
+                (() (loop rest (+ i 1)))
+                ((($ <vertex-attribute> location format offset) . rest-attribs)
+                 (gl-enable-vertex-attrib-array location)
+                 (gl-vertex-attrib-pointer location
+                                           (format-component-count format)
+                                           (format-type format)
+                                           (format-normalized? format)
+                                           stride
+                                           (offset->pointer offset))
+                 (attrib-loop rest-attribs)))
+              attributes)))))))
+  (define (do-command cmd)
+    (match cmd
+      (($ <draw-command> render-state vertex-count instance-count
+                         first-vertex first-instance)
+       (apply-render-state render-state)
+       ;; TODO: Support instanced rendering.
+       ;; TODO: Support index buffers.
+       (gl-draw-arrays (primitive-mode
+                        (render-pipeline-primitive
+                         (render-state-pipeline render-state)))
+                       first-vertex vertex-count))))
+  (gl-state-make-current! state)
+  (let ((q (gl-state-queue state)))
+    (let loop ()
+      (unless (queue-empty? q)
+        (do-command (dequeue! q))
+        (loop)))))
+
+
+;;;
+;;; Buffers
+;;;
+
+;; The copy-src and uniform usages are available only if the GL
+;; version is 3.1 or greater.  The indirect and storage usages targets
+;; are available only if the GL version is 4.3 or greater.  The
+;; query-resolve target is available only if the GL version is 4.4 or
+;; greater.
+;;
+;; TODO: Do we somehow slowly emulate the missing buffer support on GL
+;; versions? Or do we just leave that up to higher-level APIs to
+;; handle?  Punt for now and see what the situation is like when we
+;; actually hit a real world compatibility problem.
+
+(define (make-gl-buffer state length usage)
+  (gl-state-make-current! state)
+  (let ((buffer (%make-gl-buffer (gl-generate-buffer))))
+    (set-gl-state-buffer-vertex! state buffer)
+    ;; Allocate buffer memory.
+    (gl-buffer-data (version-1-5 array-buffer)
+                    length %null-pointer
+                    ;; TODO: Set hints based on usage flags.
+                    (version-1-5 static-draw))
+    buffer))
+
+(define (gl-buffer-destroy state buffer)
+  (gl-delete-buffer (gl-buffer-id buffer)))
+
+(define (gl-buffer-map state buffer mode offset length)
+  (match mode
+    ('read
+     (let ((target (version-3-1 copy-write-buffer))
+           (access (version-1-5 read-only)))
+       (set-gl-buffer-map-target! buffer target)
+       (set-gl-state-buffer-copy-write! target buffer)
+       (pointer->bytevector (gl-map-buffer target access) length offset)))
+    ('write
+     (let ((target (version-3-1 copy-read-buffer))
+           (access (version-1-5 write-only)))
+       (set-gl-buffer-map-target! buffer target)
+       (set-gl-state-buffer-copy-read! target buffer)
+       (pointer->bytevector (gl-map-buffer target access) length offset)))))
+
+(define (gl-buffer-unmap state buffer)
+  (gl-unmap-buffer (gl-buffer-map-target buffer)))
+
+(define (gl-buffer-write state buffer buffer-offset data data-offset length)
+  (gl-state-make-current! state)
+  (set-gl-state-buffer-vertex! state buffer)
+  (gl-buffer-sub-data (version-1-5 array-buffer)
+                      buffer-offset length
+                      (bytevector->pointer data data-offset)))
+
+
+;;;
+;;; Textures and samplers
+;;;
+
+;; A texture simply maps to an OpenGL texture, but texture views and
+;; samplers are where things get complicated.  Texture views are
+;; supported in OpenGL >= 4.3 so older versions have to fall back to
+;; copying data into a new texture.  Samplers are supported in OpenGL
+;; >= 3.3 so older versions have to fall back to copying data into yet
+;; another new texture and using glTexParameter.
+
+(define (make-gl-texture state width height depth mip-level-count
+                         sample-count dimension format usage
+                         view-formats)
+  (%make-gl-texture (gl-generate-texture)))
+
+(define (gl-texture-destroy state texture)
+  (gl-delete-texture (gl-texture-id texture)))
+
+(define (make-gl-texture-view state texture format dimension aspect base-mip-level
+                              mip-level-count base-layer layer-count)
+  (if (gl-state-version>= state "4.3")
+      (let ((alias (gl-generate-texture)))
+        (gl-texture-view alias
+                         (match dimension
+                           ('2d (texture-target texture-2d))
+                           ('3d (texture-target texture-3d-ext)))
+                         (gl-texture-id (texture-handle texture))
+                         ;; TODO: Respect format
+                         (pixel-internal-format rgba8)
+                         base-mip-level mip-level-count
+                         base-layer layer-count)
+        (%make-gl-texture-view alias))
+      (error "texture view emulation for OpenGL <= 4.3 unimplemented")))
+
+(define (gl-texture-view-destroy view)
+  (gl-delete-texture (gl-texture-view-id view)))
+
+(define (make-gl-sampler state address-mode-u address-mode-v address-mode-w
+                         mag-filter min-filter mipmap-filter)
+  (if (gl-state-version>= state "3.3")
+      (%make-gl-sampler (gl-generate-sampler))
+      (error "sampler emulation for OpenGL <= 3.3 unimplemented")))
+
+(define (gl-sampler-destroy sampler)
+  (gl-delete-sampler (gl-sampler-id sampler)))
+
+
+;;;
+;;; Shaders
+;;;
+
+(define (make-gl-shader-module state vertex-source fragment-source)
+  (define header
+    ;; Set up preprocessor directives dynamically based on the current
+    ;; OpenGL context's GLSL version so that we can write shaders that
+    ;; are compatible with as many systems as possible.
+    (let ((version (gl-meta-glsl-version (gl-state-meta state))))
+      (cond
+       ((string>= version "3.3")
+        "#version 330
+#define GLSL330
+")
+       ((string>= version "1.3")
+        "#version 130
+#define GLSL130
+")
+       ((string>= version "1.2")
+        "#version 120
+#define GLSL120
+")
+       (else
+        (error "incompatible GLSL version" version)))))
+  (define (set-shader-source shader source)
+    (let ((bv (string->utf8 (string-append header source))))
+      (gl-shader-source shader 1
+                        (bytevector->pointer
+                         (u64vector
+                          (pointer-address (bytevector->pointer bv))))
+                        (bytevector->pointer
+                         (u32vector (bytevector-length bv))))))
+  (define (shader-info-log shader)
+    (let ((log-length-bv (make-u32vector 1 0)))
+      (gl-get-shaderiv shader (version-2-0 info-log-length)
+                       (bytevector->pointer log-length-bv))
+      ;; Add one byte to account for the null string terminator.
+      (let* ((log-length (u32vector-ref log-length-bv 0))
+             (log (make-u8vector (1+ log-length) 0)))
+        (gl-get-shader-info-log shader log-length %null-pointer
+                                (bytevector->pointer log))
+        (utf8->string log))))
+  (define (compiled? shader)
+    (let ((status (make-u32vector 1)))
+      (gl-get-shaderiv shader
+                       (version-2-0 compile-status)
+                       (bytevector->pointer status))
+      (= (u32vector-ref status 0) 1)))
+  (define (compile shader source)
+    (set-shader-source shader source)
+    (gl-compile-shader shader)
+    (unless (compiled? shader)
+      (let ((msg (shader-info-log shader)))
+        (gl-delete-shader shader)
+        (error (format #f "failed to compile shader: ~a" msg)))))
+  (define (make-shader source type)
+    (let ((shader (gl-create-shader type)))
+      (compile shader source)
+      (make-gl-shader shader)))
+  (gl-state-make-current! state)
+  (%make-gl-shader-module (make-shader vertex-source (version-2-0 vertex-shader))
+                          (make-shader fragment-source (version-2-0 fragment-shader))))
+
+(define (gl-shader-module-destroy state module)
+  (gl-state-make-current! state)
+  (gl-delete-shader (gl-shader-module-vertex module))
+  (gl-delete-shader (gl-shader-module-fragment module)))
+
+(define (make-gl-render-pipeline state vertex fragment primitive
+                                 depth-stencil multisample)
+  (define (program-info-log program)
+    (let ((log-length-bv (make-u32vector 1 0)))
+      (gl-get-shaderiv program (version-2-0 info-log-length)
+                       (bytevector->pointer log-length-bv))
+      ;; Add one byte to account for the null string terminator.
+      (let* ((log-length (u32vector-ref log-length-bv 0))
+             (log (make-u8vector (1+ log-length) 0)))
+        (gl-get-shader-info-log program log-length %null-pointer
+                                (bytevector->pointer log))
+        (utf8->string log))))
+  (define (linked? program)
+    (let ((status (make-u32vector 1 0)))
+      (gl-get-programiv program (version-2-0 link-status)
+                        (bytevector->pointer status))
+      (= (u32vector-ref status 0) 1)))
+  (gl-state-make-current! state)
+  (let ((program (gl-create-program))
+        (vertex* (gl-shader-id
+                  (gl-shader-module-vertex
+                   (shader-module-handle
+                    (vertex-state-module vertex)))))
+        (fragment* (gl-shader-id
+                    (gl-shader-module-fragment
+                     (shader-module-handle
+                      (fragment-state-module fragment))))))
+    (gl-attach-shader program vertex*)
+    (gl-attach-shader program fragment*)
+    (gl-link-program program)
+    (gl-detach-shader program vertex*)
+    (gl-detach-shader program fragment*)
+    (unless (linked? program)
+      (let ((msg (program-info-log program)))
+        (gl-delete-program program)
+        (error (format #f "failed to link shader: ~a" msg))))
+    (make-gl-program program)))
+
+(define (gl-render-pipeline-destroy state program)
+  (gl-state-make-current! state)
+  (gl-delete-program (gl-program-id program)))
+
+(define-gpu-backend opengl
+  make-gl-state
+  #:tick gl-state-tick
+  #:swap gl-state-swap
+  #:enqueue gl-state-enqueue
+  #:make-buffer make-gl-buffer
+  #:buffer-destroy gl-buffer-destroy
+  #:buffer-map gl-buffer-map
+  #:buffer-unmap gl-buffer-unmap
+  #:buffer-write gl-buffer-write
+  #:make-texture make-gl-texture
+  #:texture-destroy gl-texture-destroy
+  #:make-texture-view make-gl-texture-view
+  #:texture-view-destroy gl-texture-view-destroy
+  #:make-sampler make-gl-sampler
+  #:sampler-destroy gl-sampler-destroy
+  #:make-shader-module make-gl-shader-module
+  #:shader-module-destroy gl-shader-module-destroy
+  #:make-render-pipeline make-gl-render-pipeline
+  #:render-pipeline-destroy gl-render-pipeline-destroy)
diff --git a/chickadee/graphics/gpu.scm b/chickadee/graphics/gpu.scm
index 70cf5d8..ab9bb89 100644
--- a/chickadee/graphics/gpu.scm
+++ b/chickadee/graphics/gpu.scm
@@ -15,1692 +15,862 @@
 
 ;;; Commentary:
 ;;
-;; Abstraction over OpenGL state.
+;; WebGPU-like abstract GPU interface.
 ;;
 ;;; Code:
 
 (define-module (chickadee graphics gpu)
   #:use-module (chickadee graphics color)
-  #:use-module (chickadee math rect)
-  #:use-module (gl)
-  #:use-module ((gl low-level) #:renamer (symbol-prefix-proc '%))
-  #:use-module (gl runtime)
-  #:use-module (gl types)
   #:use-module (ice-9 match)
+  #:use-module (ice-9 threads)
   #:use-module (rnrs bytevectors)
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-9)
-  #:use-module ((system foreign)
-                #:select (bytevector->pointer
-                          pointer->bytevector
-                          pointer->string
-                          pointer-address
-                          make-pointer
-                          %null-pointer))
-  #:export (blend-mode?
-            blend-mode-equation
-            blend-mode-source-function
-            blend-mode-destination-function
-            blend:alpha
-            blend:multiply
-            blend:subtract
-            blend:add
-            blend:lighten
-            blend:darken
-            blend:screen
-            blend:replace
-
-            front-face?
-            front-face-winding
-            front-face:cw
-            front-face:ccw
-
-            cull-face-mode?
-            cull-face-mode-front?
-            cull-face-mode-back?
-            cull-face:none
-            cull-face:back
-            cull-face:front
-            cull-face:front+back
-
-            polygon-mode?
-            polygon-mode-front
-            polygon-mode-back
-            polygon:fill
-            polygon:line
-            polygon:point
-
-            make-color-mask
-            color-mask?
-            color-mask-red?
-            color-mask-green?
-            color-mask-blue?
-            color-mask-alpha?
-            color-mask:all
-            color-mask:none
-            color-mask:red
-            color-mask:green
-            color-mask:blue
-            color-mask:alpha
-
-            make-depth-test
-            depth-test?
-            depth-test-write?
-            depth-test-function
-            depth-test-near
-            depth-test-far
-            depth-test:default
-
-            make-stencil-test
-            stencil-test?
-            stencil-test-mask-front
-            stencil-test-mask-back
-            stencil-test-function-front
-            stencil-test-function-back
-            stencil-test-function-mask-front
-            stencil-test-function-mask-back
-            stencil-test-reference-front
-            stencil-test-reference-back
-            stencil-test-on-fail-front
-            stencil-test-on-fail-back
-            stencil-test-on-depth-fail-front
-            stencil-test-on-depth-fail-back
-            stencil-test-on-pass-front
-            stencil-test-on-pass-back
-            stencil-test:default
-
-            make-window-rect
-            window-rect?
-            window-rect-x
-            window-rect-y
-            window-rect-width
-            window-rect-height
-            window-rect:empty
-
-            fresh-gpu-framebuffer
-            free-gpu-framebuffer
-            gpu-framebuffer?
-            gpu-framebuffer-id
-            gpu-framebuffer-init
-            gpu-framebuffer:null
-
-            fresh-gpu-renderbuffer
-            free-gpu-renderbuffer
-            gpu-renderbuffer?
-            gpu-renderbuffer-id
-            gpu-renderbuffer:null
-
-            fresh-gpu-buffer
-            free-gpu-buffer
-            gpu-buffer?
-            gpu-buffer-id
-            gpu-buffer-upload
-            gpu-buffer-map
-            gpu-buffer-unmap
-            gpu-buffer-target
-            gpu-buffer:null
-
-            fresh-gpu-vertex-array
-            free-gpu-vertex-array
-            gpu-vertex-array?
-            gpu-vertex-array-id
-            gpu-vertex-array-apply-attribute
-            gpu-vertex-array:null
-
-            fresh-gpu-texture
-            free-gpu-texture
-            gpu-texture?
-            gpu-texture-id
-            gpu-texture-target
-            gpu-texture-upload-2d
-            gpu-texture-upload-2d/sub
-            gpu-texture-copy-image
-            gpu-texture-generate-mipmap
-            gpu-texture-upload-cube-map-positive-x
-            gpu-texture-upload-cube-map-negative-x
-            gpu-texture-upload-cube-map-positive-y
-            gpu-texture-upload-cube-map-negative-y
-            gpu-texture-upload-cube-map-positive-z
-            gpu-texture-upload-cube-map-negative-z
-            set-gpu-texture-min-filter!
-            set-gpu-texture-mag-filter!
-            set-gpu-texture-wrap-r!
-            set-gpu-texture-wrap-s!
-            set-gpu-texture-wrap-t!
-            gpu-texture:null
-
-            fresh-gpu-shader
-            free-gpu-shader
-            gpu-shader?
-            gpu-shader-id
-            gpu-shader-compiled?
-            gpu-shader-info-log
-            set-gpu-shader-source
-            gpu-shader-compile
-            gpu-shader:null
-
-            fresh-gpu-program
-            free-gpu-program
-            gpu-program?
-            gpu-program-id
-            gpu-program-linked?
-            gpu-program-attach-shader
-            gpu-program-link
-            gpu-program-info-log
-            gpu-program-uniform-count
-            gpu-program-attribute-count
-            gpu-program-uniform-ref
-            gpu-program-attribute-ref
-            set-gpu-program-uniform:signed-int
-            set-gpu-program-uniform:unsigned-int
-            set-gpu-program-uniform:float
-            set-gpu-program-uniform:vec2
-            set-gpu-program-uniform:vec3
-            set-gpu-program-uniform:vec4
-            set-gpu-program-uniform:mat3
-            set-gpu-program-uniform:mat4
-            gpu-program:null
-
-            make-gpu
-            gpu?
-            gpu-gl-context
-            gpu-gl-version
-            gpu-glsl-version
-            gpu-max-texture-size
-            gpu-max-texture-units
-            gpu-front-face
-            gpu-blend-mode
-            gpu-cull-face-mode
-            gpu-polygon-mode
-            gpu-color-mask
-            gpu-depth-test
-            gpu-stencil-test
-            gpu-scissor-test
-            gpu-multisample?
-            gpu-seamless-cube-maps?
-            gpu-viewport
-            gpu-clear-color
-            gpu-framebuffer
-            gpu-renderbuffer
-            gpu-buffer
-            gpu-vertex-array
-            gpu-program
-            gpu-texture
-            set-gpu-front-face!
-            set-gpu-blend-mode!
-            set-gpu-cull-face-mode!
-            set-gpu-polygon-mode!
-            set-gpu-color-mask!
-            set-gpu-depth-test!
-            set-gpu-stencil-test!
-            set-gpu-scissor-test!
-            set-gpu-multisample!
-            set-gpu-seamless-cube-maps!
-            set-gpu-viewport!
-            set-gpu-clear-color!
-            set-gpu-framebuffer!
-            set-gpu-renderbuffer!
-            set-gpu-buffer!
-            set-gpu-vertex-array!
-            set-gpu-program!
-            set-gpu-texture!
+  #:use-module (srfi srfi-9 gnu)
+  #:export (make-gpu
+            gpu-tick
+            gpu-swap
             gpu-gc
-            gpu-reset!
-            gpu-clear-viewport
-            gpu-draw
-            gpu-draw/indexed
-            gpu-draw/instanced
-            gpu-draw/instanced+indexed))
+            gpu-submit
+            current-gpu
+            define-gpu-backend
+
+            make-buffer
+            buffer?
+            buffer-available?
+            buffer-destroyed?
+            buffer-mapped?
+            buffer-destroy!
+            buffer-map!
+            buffer-unmap!
+            bytevector->buffer
+
+            make-texture
+            texture-destroy!
+            texture?
+            texture-gpu
+            texture-handle
+            texture-destroyed?
+            texture-width
+            texture-height
+            texture-layers
+            texture-mip-level-count
+            texture-sample-count
+            texture-dimension
+            texture-format
+            texture-usage
+            texture-view-formats
+
+            make-texture-view
+            texture-view-destroy!
+            texture-view?
+            texture-view-gpu
+            texture-view-handle
+            texture-view-destroyed?
+            texture-view-texture
+            texture-view-format
+            texture-view-dimension
+            texture-view-aspect
+            texture-view-base-mip-level
+            texture-view-mip-level-count
+            texture-view-base-layer
+            texture-view-layer-count
+
+            make-sampler
+            sampler-destroy!
+            sampler?
+            sampler-gpu
+            sampler-handle
+            sampler-destroyed?
+            sampler-address-mode-u
+            sampler-address-mode-v
+            sampler-address-mode-w
+            sampler-mag-filter
+            sampler-min-filter
+            sampler-mipmap-filter
+
+            make-shader-module
+            shader-module?
+            shader-module-vertex
+            shader-module-fragment
+
+            make-vertex-attribute
+            vertex-attribute?
+            vertex-attribute-location
+            vertex-attribute-format
+            vertex-attribute-offset
+
+            make-vertex-buffer-layout
+            vertex-buffer-layout?
+            vertex-buffer-layout-stride
+            vertex-buffer-layout-step-mode
+            vertex-buffer-layout-attributes
+
+            make-vertex-state
+            vertex-state?
+            vertex-state-module
+            vertex-state-buffers
+
+            make-blend-component
+            blend-component?
+            blend-component-operation
+            blend-component-src-factor
+            blend-component-dst-factor
+
+            make-blend-state
+            blend-state?
+            blend-state-color
+            blend-state-alpha
+
+            make-color-target-state
+            color-target-state?
+            color-target-state-format
+            color-target-state-blend
+            color-target-state-write-mask
+
+            make-fragment-state
+            fragment-state?
+            fragment-state-module
+            fragment-state-targets
+
+            make-primitive-state
+            primitive-state?
+            primitive-state-topology
+            primitive-state-front-face
+            primitive-state-cull-mode
+            primitive-state-unclipped-depth?
+
+            make-stencil-face-state
+            stencil-face-state?
+            stencil-face-state-compare
+            stencil-face-state-fail-op
+            stencil-face-state-depth-fail-op
+            stencil-face-state-pass-op
+
+            make-depth-stencil-format
+            depth-stencil-format?
+            depth-stencil-state-format
+            depth-stencil-state-depth-write-enabled?
+            depth-stencil-state-compare-function
+            depth-stencil-state-stencil-front
+            depth-stencil-state-stencil-back
+            depth-stencil-state-stencil-read-mask
+            depth-stencil-state-stencil-write-mask
+
+            make-multisample-state
+            multisample-state?
+            multisample-state-count
+            multisample-state-mask
+            multisample-state-alpha-to-coverage?
+
+            make-render-pipeline
+            render-pipeline?
+            render-pipeline-vertex
+            render-pipeline-fragment
+            render-pipeline-primitive
+            render-pipeline-depth-stencil
+            render-pipeline-multisample
+
+            make-color-attachment
+            color-attachment?
+            color-attachment-view
+            color-attachment-resolve-target
+            color-attachment-clear-color
+            color-attachment-load-op
+            color-attachment-store-op
+
+            make-depth-stencil-attachment
+            depth-stencil-attachment?
+            depth-stencil-attachment-view
+            depth-stencil-attachment-depth-clear-value
+            depth-stencil-attachment-depth-load-op
+            depth-stencil-attachment-depth-store-op
+            depth-stencil-attachment-depth-read-only?
+            depth-stencil-attachment-stencil-clear-value
+            depth-stencil-attachment-stencil-load-op
+            depth-stencil-attachment-stencil-store-op
+            depth-stencil-attachment-stencil-read-only?
+
+            make-render-pass-descriptor
+            render-pass-descriptor?
+            render-pass-descriptor?-color-attachments
+            render-pass-descriptor?-depth-stencil-attachment
+            render-pass-descriptor?-max-draw-count
+
+            render-state?
+            render-state-pipeline
+            render-state-vertex-buffers
+
+            command-buffer?
+            command-buffer-commands
+
+            make-command-encoder
+            command-encoder?
+            command-encoder-finish
+            begin-render-pass
+
+            render-pass-encoder?
+            render-pass-encoder-pipeline
+            render-pass-encoder-vertex-buffers
+            set-render-pass-encoder-pipeline!
+            set-render-pass-encoder-vertex-buffer!
+            render-pass-draw
+            end-render-pass))
+
+(define-syntax-rule (define-record-type* name
+                      make pred
+                      (field accessor default) ...)
+  (begin
+    (define-record-type name
+      (%make field ...)
+      pred
+      (field accessor) ...)
+    (define* (make #:key (field default) ...)
+      (%make field ...))))
 
 
 ;;;
-;;; Additional OpenGL wrappers
+;;; Generic GPU
 ;;;
 
-(define gl-clear-color %glClearColor)
-(define gl-scissor %glScissor)
-(define gl-blend-func %glBlendFunc)
-(define gl-blend-equation %glBlendEquation)
-(define gl-texture-image-3d %glTexImage3D)
-(define gl-texture-image-2d %glTexImage2D)
-(define gl-texture-image-1d %glTexImage1D)
-(define gl-copy-texture-image-2d %glCopyTexImage2D)
-(define gl-copy-texture-image-1d %glCopyTexImage1D)
-(define gl-copy-texture-sub-image-3d %glCopyTexSubImage3D)
-(define gl-copy-texture-sub-image-2d %glCopyTexSubImage2D)
-(define gl-copy-texture-sub-image-1d %glCopyTexSubImage1D)
-(define gl-texture-sub-image-3d %glTexSubImage3D)
-(define gl-texture-sub-image-2d %glTexSubImage2D)
-(define gl-texture-sub-image-1d %glTexSubImage1D)
-(define gl-compressed-texture-image-1d %glCompressedTexImage1D)
-(define gl-compressed-texture-image-2d %glCompressedTexImage2D)
-(define gl-compressed-texture-image-3d %glCompressedTexImage3D)
-(define gl-compressed-texture-sub-image-1d %glCompressedTexSubImage1D)
-(define gl-compressed-texture-sub-image-2d %glCompressedTexSubImage2D)
-(define gl-compressed-texture-sub-image-3d %glCompressedTexSubImage3D)
-(define gl-texture-parameter %glTexParameteri)
-(define gl-bind-texture %glBindTexture)
-(define gl-get-tex-image %glGetTexImage)
-(define gl-buffer-data %glBufferData)
-(define gl-buffer-sub-data %glBufferSubData)
-(define gl-map-buffer %glMapBuffer)
-(define gl-unmap-buffer %glUnmapBuffer)
-(define gl-draw-buffers %glDrawBuffers)
-(define gl-use-program %glUseProgram)
-(define gl-delete-program  %glDeleteProgram)
-(define gl-detach-shader  %glDetachShader)
-(define gl-link-program  %glLinkProgram)
-(define gl-bind-attrib-location  %glBindAttribLocation)
-(define gl-attach-shader  %glAttachShader)
-(define gl-get-attrib-location  %glGetAttribLocation)
-(define gl-get-uniform-location  %glGetUniformLocation)
-(define gl-create-program  %glCreateProgram)
-(define gl-get-program-info-log  %glGetProgramInfoLog)
-(define gl-get-programiv  %glGetProgramiv)
-(define gl-delete-program  %glDeleteProgram)
-(define gl-delete-shader  %glDeleteShader)
-(define gl-get-shaderiv  %glGetShaderiv)
-(define gl-get-shader-info-log  %glGetShaderInfoLog)
-(define gl-compile-shader  %glCompileShader)
-(define gl-shader-source  %glShaderSource)
-(define gl-create-shader  %glCreateShader)
-(define gl-get-active-uniform %glGetActiveUniform)
-(define gl-get-active-attrib %glGetActiveAttrib)
-(define gl-uniform1i  %glUniform1i)
-(define gl-uniform1iv %glUniform1iv)
-(define gl-uniform2i  %glUniform2i)
-(define gl-uniform3i  %glUniform3i)
-(define gl-uniform4i  %glUniform4i)
-(define gl-uniform1f %glUniform1f)
-(define gl-uniform1fv  %glUniform1fv)
-(define gl-uniform2f  %glUniform2f)
-(define gl-uniform2fv  %glUniform2fv)
-(define gl-uniform3f %glUniform3f)
-(define gl-uniform3fv %glUniform3fv)
-(define gl-uniform4f  %glUniform4f)
-(define gl-uniform4fv %glUniform4fv)
-(define gl-uniform-matrix3fv %glUniformMatrix3fv)
-(define gl-uniform-matrix4fv %glUniformMatrix4fv)
-(define gl-uniform4f  %glUniform4f)
-(define gl-point-size %glPointSize)
-(define gl-get-string %glGetString)
-(define gl-get-integer-v %glGetIntegerv)
-(define gl-depth-func %glDepthFunc)
-(define gl-depth-mask %glDepthMask)
-(define gl-depth-range %glDepthRange)
-(define gl-stencil-mask %glStencilMask)
-(define gl-stencil-mask-separate %glStencilMaskSeparate)
-(define gl-stencil-func %glStencilFunc)
-(define gl-stencil-func-separate %glStencilFuncSeparate)
-(define gl-stencil-op %glStencilOp)
-(define gl-stencil-op-separate %glStencilOpSeparate)
-(define gl-polygon-mode %glPolygonMode)
-(define gl-cull-face %glCullFace)
-(define gl-front-face %glFrontFace)
-(define gl-color-mask %glColorMask)
-(define gl-get-error %glGetError)
-
-(define-gl-procedure (glGenerateMipmap (target GLenum) -> void)
-  "Generate mipmaps for the texture attached to target of the active
-texture unit.")
-
-(define-gl-procedure (glDrawArraysInstanced (mode GLenum)
-                                            (first GLint)
-                                            (count GLsizei)
-                                            (primcount GLsizei)
-                                            -> void)
-  "Draw multiple instances of a set of arrays.")
-
-(define-gl-procedure (glDrawElementsInstanced (mode GLenum)
-                                              (count GLsizei)
-                                              (type GLenum)
-                                              (indices void-*)
-                                              (primcount GLsizei)
-                                              -> void)
-  "Draw multiple instances of a set of elements.")
-
-(define-gl-procedure (glVertexAttribDivisor (index GLuint)
-                                            (divisor GLuint)
-                                            -> void)
-  "Modify the rate at which generic vertex attributes advance during
-instanced rendering.")
-
-(define-gl-procedure (glGenVertexArrays (n GLsizei)
-                                        (arrays GLuint-*)
-                                        -> void)
-  "Generate N vertex arrays.")
-
-(define-gl-procedure (glDeleteVertexArrays (n GLsizei)
-                                           (arrays GLuint-*)
-                                           -> void)
-  "Delete vertex array objects.")
-
-(define-gl-procedure (glBindVertexArray (array GLuint)
-                                        -> void)
-  "Bind vertex array object ARRAY.")
-
-(define-gl-procedure (glEnableVertexAttribArray (index GLuint)
-                                                -> void)
-  "Enable or disable a generic vertex attribute array.")
-
-(define-gl-procedure (glVertexAttribPointer (index GLuint)
-                                            (size GLint)
-                                            (type GLenum)
-                                            (normalized GLboolean)
-                                            (stride GLsizei)
-                                            (pointer GLvoid-*)
-                                            -> void)
-  "Define an array of generic vertex attribute data.")
-
-(define-gl-procedure (glDrawElements (mode GLenum)
-                                     (count GLsizei)
-                                     (type GLenum)
-                                     (indices GLvoid-*)
-                                     -> void)
-  "Render primitives from array data.")
-
-(define-gl-procedure (glGenFramebuffers (n GLsizei)
-                                        (ids GLuint-*)
-                                        -> void)
-  "Generate framebuffer object names.")
-
-(define-gl-procedure (glDeleteFramebuffers (n GLsizei)
-                                           (framebuffers GLuint-*)
-                                           -> void)
-  "Delete framebuffer objects.")
-
-(define-gl-procedure (glBindFramebuffer (target GLenum)
-                                        (framebuffer GLuint)
-                                        -> void)
-  "Bind a framebuffer to a framebuffer target.")
-
-(define-gl-procedure (glFramebufferTexture2D (target GLenum)
-                                             (attachment GLenum)
-                                             (textarget GLenum)
-                                             (texture GLuint)
-                                             (level GLint)
-                                             -> void)
-  "Attach a level of a texture object as a logical buffer to the
-currently bound framebuffer object.")
-
-(define-gl-procedure (glCheckFramebufferStatus (target GLenum)
-                                               -> GLenum)
-  "Return the framebuffer completeness status of a framebuffer
-object.")
-
-(define-gl-procedure (glGenRenderbuffers (n GLsizei)
-                                         (ids GLuint-*)
-                                         -> void)
-  "Generate renderbuffer object names.")
-
-(define-gl-procedure (glDeleteRenderbuffers (n GLsizei)
-                                            (renderbuffers GLuint-*)
-                                            -> void)
-  "Delete renderbuffer objects.")
-
-(define-gl-procedure (glBindRenderbuffer (target GLenum)
-                                         (renderbuffer GLuint)
-                                         -> void)
-  "Bind a named renderbuffer object.")
-
-(define-gl-procedure (glRenderbufferStorage (target GLenum)
-                                            (internalformat GLenum)
-                                            (width GLsizei)
-                                            (height GLsizei)
-                                            -> void)
-  "Create and initialize a renderbuffer object's data store.")
-
-(define-gl-procedure (glFramebufferRenderbuffer (target GLenum)
-                                                (attachment GLenum)
-                                                (renderbuffertarget GLenum)
-                                                (renderbuffer GLuint)
-                                                -> void)
-  "Attach a renderbuffer object to a framebuffer object.")
-
-(define-gl-procedure (glUniform1ui (location GLint)
-                                   (v0 GLuint)
-                                   -> void)
-  "Specify the value of a uniform variable for the current program object")
-
-(define-gl-procedure (glUniform1uiv (location GLint)
-                                    (count GLint)
-                                    (ptr GLvoid-*)
-                                    -> void)
-  "Specify the value of a uniform variable for the current program object")
-
-(define gl-generate-mipmap glGenerateMipmap)
-(define gl-draw-arrays-instanced glDrawArraysInstanced)
-(define gl-draw-elements-instanced glDrawElementsInstanced)
-(define gl-vertex-attrib-divisor glVertexAttribDivisor)
-(define gl-gen-vertex-arrays glGenVertexArrays)
-(define gl-delete-vertex-arrays glDeleteVertexArrays)
-(define gl-bind-vertex-array glBindVertexArray)
-(define gl-enable-vertex-attrib-array glEnableVertexAttribArray)
-(define gl-vertex-attrib-pointer glVertexAttribPointer)
-(define gl-draw-elements glDrawElements)
-(define gl-gen-framebuffers glGenFramebuffers)
-(define gl-delete-framebuffer glDeleteFramebuffers)
-(define gl-bind-framebuffer glBindFramebuffer)
-(define gl-framebuffer-texture-2d glFramebufferTexture2D)
-(define gl-check-framebuffer-status glCheckFramebufferStatus)
-(define gl-gen-renderbuffers glGenRenderbuffers)
-(define gl-delete-renderbuffers glDeleteRenderbuffers)
-(define gl-bind-renderbuffer glBindRenderbuffer)
-(define gl-renderbuffer-storage glRenderbufferStorage)
-(define gl-framebuffer-renderbuffer glFramebufferRenderbuffer)
-(define gl-uniform1ui glUniform1ui)
-(define gl-uniform1uiv glUniform1uiv)
-
-(define (gl-generate-vertex-array)
-  (let ((bv (u32vector 0)))
-    (glGenVertexArrays 1 bv)
-    (u32vector-ref bv 0)))
-
-(define (gl-delete-vertex-array n)
-  (let ((bv (u32vector n)))
-    (glDeleteVertexArrays 1 bv)))
-
-(define (gl-generate-framebuffer)
-  (let ((bv (u32vector 0)))
-    (glGenFramebuffers 1 bv)
-    (u32vector-ref bv 0)))
-
-(define (gl-delete-framebuffer n)
-  (let ((bv (u32vector n)))
-    (glDeleteFramebuffers 1 bv)))
-
-(define (gl-generate-renderbuffer)
-  (let ((bv (u32vector 0)))
-    (glGenRenderbuffers 1 bv)
-    (u32vector-ref bv 0)))
-
-(define (gl-delete-renderbuffer n)
-  (let ((bv (u32vector n)))
-    (glDeleteRenderbuffers 1 bv)))
+(define-syntax-rule (define-gpu-type name make pred
+                      (mutex mutex-accessor)
+                      (guardian guardian-accessor)
+                      (internal internal-accessor)
+                      (vfield vfield-accessor
+                              (vfield-dispatch vfield-dispatch-args ...))
+                      ...)
+  (begin
+    (define-record-type name
+      (%make mutex guardian internal vfield ...)
+      pred
+      (mutex mutex-accessor)
+      (guardian guardian-accessor)
+      (internal internal-accessor)
+      (vfield vfield-accessor) ...)
+    (define* (make internal #:key vfield ...)
+      (%make (make-recursive-mutex) (make-guardian) internal vfield ...))
+    (define (vfield-dispatch gpu vfield-dispatch-args ...)
+      (with-mutex (mutex-accessor gpu)
+        ((vfield-accessor gpu)
+         (internal-accessor gpu)
+         vfield-dispatch-args ...)))
+    ...))
+
+(define-gpu-type <gpu>
+  %make-gpu
+  gpu?
+  (mutex gpu-mutex)
+  (guardian gpu-guardian)
+  (internal gpu-internal)
+  (tick %gpu-tick (gpu-tick))
+  (swap %gpu-swap (gpu-swap))
+  (enqueue %gpu-enqueue (backend:enqueue command-buffer))
+  (make-buffer %gpu-make-buffer
+               (backend:make-buffer length usage))
+  (buffer-destroy %gpu-buffer-destroy
+                  (backend:buffer-destroy buffer))
+  (buffer-map %gpu-buffer-map
+              (backend:buffer-map buffer mode offset sizes))
+  (buffer-unmap %gpu-buffer-unmap
+                (backend:buffer-unmap buffer))
+  (buffer-write %gpu-buffer-write
+                (backend:buffer-write buffer buffer-offset data data-offset
+                                      length))
+  (make-texture %gpu-make-texture
+                (backend:make-texture width height depth mip-level-count
+                                      sample-count dimension format usage
+                                      view-formats))
+  (texture-destroy %gpu-texture-destroy (backend:texture-destroy texture))
+  (make-texture-view %gpu-make-texture-view
+                     (backend:make-texture-view texture format dimension aspect
+                                                base-mip-level mip-level-count
+                                                base-depth depth))
+  (texture-view-destroy %gpu-texture-view-destroy
+                        (backend:texture-view-destroy view))
+  (make-sampler %gpu-make-sampler
+                (backend:make-sampler address-mode-u address-mode-v
+                                      address-mode-w mag-filter min-filter
+                                      mipmap-filter))
+  (sampler-destroy %gpu-sampler-destroy (backend:sampler-destroy module))
+  (make-shader-module %gpu-make-shader-module
+                      (backend:make-shader-module vertex-source fragment-source))
+  (shader-module-destroy %gpu-shader-module-destroy
+                         (backend:shader-module-destroy module))
+  (make-render-pipeline %gpu-make-render-pipeline
+                        (backend:make-render-pipeline vertex fragment
+                                                      primitive depth-stencil
+                                                      multisample))
+  (render-pipeline-destroy %gpu-render-pipeline-destroy
+                           (backend:render-pipeline-destroy pipeline)))
+
+(define (gpu-guard! gpu obj)
+  ((gpu-guardian gpu) obj))
+
+(define *gpu-backends* (make-hash-table))
+
+(define (gpu-backend-ref name)
+  (hashq-ref *gpu-backends* name))
+
+(define (gpu-backend-set! name proc)
+  (hashq-set! *gpu-backends* name proc))
+
+(define-syntax-rule (define-gpu-backend name
+                      internal-constructor
+                      args ...)
+  (gpu-backend-set! 'name
+                    (lambda (window context)
+                      (%make-gpu (internal-constructor window context)
+                                 args ...))))
+
+(define current-gpu (make-parameter #f))
+
+;; TODO: Respect the args according to WebGPU spec.
+;;
+;; TODO: Platform detection + open SDL window with proper GL, Vulkan,
+;; or Metal flag.  Forcing OpenGL for now.
+(define* (make-gpu window context #:key
+                   power-preference
+                   (required-features '())
+                   (required-limits '()))
+  ;; Include module at runtime to avoid circular reference.
+  ;;
+  ;; TODO: Programatically discover backend modules, load them, and
+  ;; pick the "best" one.
+  (module-use! (current-module)
+               (resolve-interface
+                '(chickadee graphics backend opengl)))
+  ((gpu-backend-ref 'opengl) window context))
 
 
 ;;;
-;;; GPU settings
+;;; Buffers
 ;;;
 
-(define-syntax symbol->enum
-  (syntax-rules ()
-    ((_ (x enum)) (error "symbol->enum: no match for" x))
-    ((_ (x enum) (sym name override-enum) . rest)
-     (if (eq? x 'sym) (override-enum name) (symbol->enum (x enum) . rest)))
-    ((_ (x enum) (sym name) . rest)
-     (if (eq? x 'sym) (enum name) (symbol->enum (x enum) . rest)))
-    ((_ (x enum) (sym) . rest)
-     (symbol->enum (x enum) (sym sym) . rest))))
-
-(define-syntax enum->symbol
-  (syntax-rules ()
-    ((_ (n enum)) (error "enum->symbol: no match for" n))
-    ((_ (n enum) (sym name override-enum) . rest)
-     (if (eqv? n (override-enum name)) 'sym (enum->symbol (n enum) . rest)))
-    ((_ (n enum) (sym name) . rest)
-     (if (eqv? n (enum name)) 'sym (enum->symbol (n enum) . rest)))
-    ((_ (n enum) (name) . rest)
-     (enum->symbol (n enum) (name name) . rest))))
-
-(define-syntax-rule (define-enum-converters enum ->enum ->symbol clause ...)
-  (begin
-    (define (->enum sym)
-      (symbol->enum (sym enum) clause ...))
-    (define (->symbol n)
-      (enum->symbol (n enum) clause ...))))
-
-(define-syntax-rule (define-config-type name
-                      constructor
-                      pred
-                      ((raw-field raccessor) ...)
-                      ((enum-field %eaccessor eaccessor ->gl ->scheme) ...))
-  (begin
-    (define-record-type name
-      (%make raw-field ... enum-field ...)
-      pred
-      (raw-field raccessor) ...
-      (enum-field %eaccessor) ...)
-    (define (constructor raw-field ... enum-field ...)
-      (%make raw-field ... (->gl enum-field) ...))
-    (define (eaccessor obj)
-      (->scheme (%eaccessor obj)))
-    ...))
+(define-record-type <buffer>
+  (%make-buffer gpu handle length usage state map-state)
+  buffer?
+  (gpu buffer-gpu)
+  (handle buffer-handle)
+  (length buffer-length)
+  (usage buffer-usage)
+  (state buffer-state set-buffer-state!)
+  (map-state buffer-map-state set-buffer-map-state!)
+  (mapping buffer-mapping set-buffer-mapping!))
+
+(define (print-buffer buffer port)
+  (match buffer
+    (($ <buffer> _ handle length usage)
+     (format #t "#<buffer handle: ~a length: ~a usage ~a>"
+             handle length usage))))
+
+(set-record-type-printer! <buffer> print-buffer)
+
+(define (buffer-available? buffer)
+  (eq? (buffer-state buffer) 'available))
+
+(define (buffer-destroyed? buffer)
+  (eq? (buffer-state buffer) 'destroyed))
+
+(define (buffer-mapped? buffer)
+  (eq? (buffer-map-state buffer) 'mapped))
+
+;; TODO: Validate length is > 0 and < max length.
+;; TODO: Validate usage flags.
+(define* (make-buffer gpu length #:optional (usage '(vertex)))
+  (let ((handle (backend:make-buffer gpu length usage)))
+    (%make-buffer gpu handle length usage 'available 'unmapped)))
+
+;; TODO: Ensure buffer is unmapped first.
+(define (buffer-destroy! buffer)
+  (unless (buffer-destroyed? buffer)
+    (backend:buffer-destroy (buffer-gpu buffer) (buffer-handle buffer))
+    (set-buffer-state! buffer 'destroyed)))
+
+(define (buffer-map! buffer mode offset size)
+  (backend:buffer-map (buffer-gpu buffer) (buffer-handle buffer)
+                      mode offset size))
+
+(define (buffer-unmap! buffer)
+  (when (buffer-mapped? buffer)
+    (backend:buffer-unmap (buffer-gpu buffer) (buffer-handle buffer))
+    (set-buffer-mapping! buffer #f)))
+
+(define* (bytevector->buffer gpu bv #:optional (usage '(vertex)))
+  (let* ((length (bytevector-length bv))
+         (buffer (make-buffer gpu length usage)))
+    (backend:buffer-write gpu (buffer-handle buffer) 0 bv 0 (bytevector-length bv))
+    buffer))
+
+
+;;;
+;;; Textures
+;;;
 
-(define-enum-converters begin-mode
-  symbol->begin-mode
-  begin-mode->symbol
-  (points)
-  (lines)
-  (line-loop)
-  (line-strip)
-  (triangles)
-  (triangle-strip)
-  (triangle-fan))
-
-(define-enum-converters data-type
-  symbol->data-type
-  data-type->symbol
-  (byte)
-  (unsigned-byte)
-  (short)
-  (unsigned-short)
-  (int)
-  (unsigned-int)
-  (float)
-  (double))
-
-(define (symbol->buffer-target target)
-  (match target
-    ('vertex (version-1-5 array-buffer))
-    ('index (version-1-5 element-array-buffer))))
-
-(define (symbol->buffer-usage usage)
-  (match usage
-    ('static (version-1-5 static-draw))
-    ('stream (version-1-5 stream-draw))))
-
-(define (symbol->access-mode mode)
-  (match mode
-    ('read-write (version-1-5 read-write))
-    ('read-only (version-1-5 read-only))
-    ('write-only (version-1-5 write-only))))
-
-(define-enum-converters texture-min-filter
-  symbol->texture-min-filter
-  texture-min-filter->symbol
-  (nearest)
-  (linear)
-  (nearest-mipmap-nearest)
-  (linear-mipmap-nearest)
-  (nearest-mipmap-linear)
-  (linear-mipmap-linear))
-
-(define-enum-converters texture-mag-filter
-  symbol->texture-mag-filter
-  texture-mag-filter->symbol
-  (nearest)
-  (linear))
-
-(define (symbol->texture-target target)
-  (match target
-    ('2d (texture-target texture-2d))
-    ('cube-map (version-1-3 texture-cube-map))))
-
-(define (symbol->texture-wrap-mode mode)
-  (match mode
-    ('repeat (texture-wrap-mode repeat))
-    ('mirrored-repeat (version-1-4 mirrored-repeat))
-    ('clamp (texture-wrap-mode clamp))
-    ('clamp-to-border (texture-wrap-mode clamp-to-border-sgis))
-    ('clamp-to-edge (texture-wrap-mode clamp-to-edge-sgis))))
-
-(define-enum-converters pixel-format
-  symbol->pixel-format
-  pixel-format->symbol
-  (rgb)
-  (rgba))
-
-(define-enum-converters blend-equation-mode-ext
-  symbol->blend-equation
-  blend-equation->symbol
-  (add func-add-ext)
-  (subtract func-subtract-ext)
-  (reverse-subtract func-reverse-subtract-ext)
-  (min min-ext)
-  (max max-ext)
-  (alpha-min alpha-min-sgix)
-  (alpha-max alpha-max-sgix))
-
-(define-enum-converters blending-factor-src
-  symbol->blend-factor-source
-  blend-factor-source->symbol
-  (zero)
-  (one)
-  (destination-color dst-color)
-  (one-minus-destination-color one-minus-dst-color)
-  (source-alpha-saturate src-alpha-saturate)
-  (source-alpha src-alpha)
-  (one-minus-source-alpha one-minus-src-alpha)
-  (destination-alpha dst-alpha)
-  (one-minus-destination-alpha one-minus-dst-alpha)
-  (constant-color constant-color-ext)
-  (one-minus-constant-color one-minus-constant-color-ext)
-  (contstant-alpha constant-alpha-ext)
-  (one-minus-constant-alpha one-minus-constant-alpha-ext))
-
-(define-enum-converters blending-factor-dest
-  symbol->blend-factor-destination
-  blend-factor-destination->symbol
-  (zero)
-  (one)
-  (source-color src-color)
-  (one-minus-source-color one-minus-src-color)
-  (source-alpha src-alpha)
-  (one-minus-source-alpha one-minus-src-alpha)
-  (destination-alpha dst-alpha)
-  (one-minus-destination-alpha one-minus-dst-alpha)
-  (constant-color constant-color-ext)
-  (one-minus-constant-color one-minus-constant-color-ext)
-  (contstant-alpha constant-alpha-ext)
-  (one-minus-constant-alpha one-minus-constant-alpha-ext))
-
-(define-config-type <blend-mode>
-  make-blend-mode
-  blend-mode?
-  ()
-  ((equation %blend-mode-equation
-             blend-mode-equation
-             symbol->blend-equation
-             blend-equation->symbol)
-   (source %blend-mode-source-function
-           blend-mode-source-function
-           symbol->blend-factor-source
-           blend-factor-source->symbol)
-   (destination %blend-mode-destination-function
-                blend-mode-destination-function
-                symbol->blend-factor-destination
-                blend-factor-destination->symbol)))
-
-(define (bind-blend-mode blend-mode)
-  (match blend-mode
-    (#f (gl-disable (enable-cap blend)))
-    (($ <blend-mode> equation src dest)
-     (gl-enable (enable-cap blend))
-     (gl-blend-equation equation)
-     (gl-blend-func src dest))))
-
-(define blend:alpha (make-blend-mode 'add 'source-alpha 'one-minus-source-alpha))
-(define blend:multiply (make-blend-mode 'add 'destination-color 'zero))
-(define blend:subtract (make-blend-mode 'reverse-subtract 'one 'zero))
-(define blend:add (make-blend-mode 'add 'one 'one))
-(define blend:lighten (make-blend-mode 'max 'one 'zero))
-(define blend:darken (make-blend-mode 'min 'one 'zero))
-(define blend:screen (make-blend-mode 'add 'one 'one-minus-source-color))
-(define blend:replace (make-blend-mode 'add 'one 'zero))
-
-(define-enum-converters front-face-direction
-  symbol->front-face-direction
-  front-face-direction->symbol
-  (cw)
-  (ccw))
-
-(define-config-type <front-face>
-  make-front-face
-  front-face
-  ()
-  ((winding %front-face-winding
-            front-face-winding
-            symbol->front-face-direction
-            front-face-direction->symbol)))
-
-(define (bind-front-face front-face)
-  (gl-front-face (%front-face-winding front-face)))
-
-(define front-face:cw (make-front-face 'cw))
-(define front-face:ccw (make-front-face 'ccw))
-
-(define-config-type <cull-face-mode>
-  make-cull-face-mode
-  cull-face-mode?
-  ((front? cull-face-mode-front?)
-   (back? cull-face-mode-back?))
-  ())
-
-(define (bind-cull-face-mode mode)
-  (match mode
-    (($ <cull-face-mode> #t #t)
-     (gl-enable (enable-cap cull-face))
-     (gl-cull-face (cull-face-mode front-and-back)))
-    (($ <cull-face-mode> #t #f)
-     (gl-enable (enable-cap cull-face))
-     (gl-cull-face (cull-face-mode front)))
-    (($ <cull-face-mode> #f #t)
-     (gl-enable (enable-cap cull-face))
-     (gl-cull-face (cull-face-mode back)))
-    (_
-     (gl-disable (enable-cap cull-face)))))
-
-(define cull-face:none (make-cull-face-mode #f #f))
-(define cull-face:back (make-cull-face-mode #f #t))
-(define cull-face:front (make-cull-face-mode #t #f))
-(define cull-face:front+back (make-cull-face-mode #t #t))
-
-(define-enum-converters polygon-mode
-  symbol->polygon-mode
-  polygon-mode->symbol
-  (fill)
-  (line)
-  (point))
-
-(define-config-type <polygon-mode>
-  make-polygon-mode
-  polygon-mode?
-  ()
-  ((front %polygon-mode-front
-          polygon-mode-front
-          symbol->polygon-mode
-          polygon-mode->symbol)
-   (back %polygon-mode-back
-         polygon-mode-back
-         symbol->polygon-mode
-         polygon-mode->symbol)))
-
-(define (bind-polygon-mode mode)
-  (match mode
-    (($ <polygon-mode> front back)
-     (if (= front back)
-         (gl-polygon-mode (cull-face-mode front-and-back) front)
-         (begin
-           (gl-polygon-mode (cull-face-mode front) front)
-           (gl-polygon-mode (cull-face-mode back) back))))))
-
-(define polygon:fill (make-polygon-mode 'fill 'fill))
-(define polygon:line (make-polygon-mode 'line 'line))
-(define polygon:point (make-polygon-mode 'point 'point))
-
-(define-config-type <color-mask>
-  make-color-mask
-  color-mask?
-  ((red? color-mask-red?)
-   (green? color-mask-green?)
-   (blue? color-mask-blue?)
-   (alpha? color-mask-alpha?))
-  ())
-
-(define (bind-color-mask mask)
-  (gl-color-mask (color-mask-red? mask)
-                 (color-mask-green? mask)
-                 (color-mask-blue? mask)
-                 (color-mask-alpha? mask)))
-
-(define color-mask:all (make-color-mask #t #t #t #t))
-(define color-mask:none (make-color-mask #f #f #f #f))
-(define color-mask:red (make-color-mask #t #f #f #f))
-(define color-mask:green (make-color-mask #f #t #f #f))
-(define color-mask:blue (make-color-mask #f #f #t #f))
-(define color-mask:alpha (make-color-mask #f #f #f #t))
-
-(define-enum-converters depth-function
-  symbol->depth-function
-  depth-function->symbol
-  (always)
-  (never)
-  (= equal)
-  (!= notequal)
-  (< less)
-  (<= lequal)
-  (> greater)
-  (>= gequal))
-
-(define-config-type <depth-test>
-  %make-depth-test
-  depth-test?
-  ((near depth-test-near)
-   (far depth-test-far)
-   (write? depth-test-write?))
-  ((function %depth-test-function
-             depth-test-function
-             symbol->depth-function
-             depth-function->symbol)))
-
-(define* (make-depth-test #:key (near 0.0) (far 1.0) (write? #t) (function '<))
-  (%make-depth-test near far write? function))
-
-(define (bind-depth-test depth-test)
-  (match depth-test
-    (#f (gl-disable (enable-cap depth-test)))
-    (($ <depth-test> near far write? func)
-     (gl-enable (enable-cap depth-test))
-     (gl-depth-func func)
-     (gl-depth-mask write?)
-     (gl-depth-range near far))))
-
-(define depth-test:default (make-depth-test))
-
-(define-enum-converters stencil-op
-  symbol->stencil-op
-  stencil-op->symbol
-  (zero)
-  (keep)
-  (replace)
-  (invert)
-  (increment incr)
-  (decrement decr)
-  (increment-wrap incr-wrap version-1-4)
-  (decrement-wrap decr-wrap version-1-4))
-
-(define-enum-converters stencil-function
-  symbol->stencil-function
-  stencil-function->symbol
-  (always)
-  (never)
-  (= equal)
-  (!= notequal)
-  (< less)
-  (<= lequal)
-  (> greater)
-  (>= gequal))
-
-(define-config-type <stencil-test>
-  %make-stencil-test
-  stencil-test?
-  ((mask-front stencil-test-mask-front)
-   (mask-back stencil-test-mask-back)
-   (function-mask-front stencil-test-function-mask-front)
-   (function-mask-back stencil-test-function-mask-back)
-   (reference-front stencil-test-reference-front)
-   (reference-back stencil-test-reference-back))
-  ((function-front %stencil-test-function-front
-                   stencil-test-function-front
-                   symbol->stencil-function
-                   stencil-function->symbol)
-   (function-back %stencil-test-function-back
-                  stencil-test-function-back
-                  symbol->stencil-function
-                  stencil-function->symbol)
-   (on-fail-front %stencil-test-on-fail-front
-                  stencil-test-on-fail-front
-                  symbol->stencil-op
-                  stencil-op->symbol)
-   (on-fail-back %stencil-test-on-fail-back
-                 stencil-test-on-fail-back
-                 symbol->stencil-op
-                 stencil-op->symbol)
-   (on-depth-fail-front %stencil-test-on-depth-fail-front
-                        stencil-test-on-depth-fail-front
-                        symbol->stencil-op
-                        stencil-op->symbol)
-   (on-depth-fail-back %stencil-test-on-depth-fail-back
-                       stencil-test-on-depth-fail-back
-                       symbol->stencil-op
-                       stencil-op->symbol)
-   (on-pass-front %stencil-test-on-pass-front
-                  stencil-test-on-pass-front
-                  symbol->stencil-op
-                  stencil-op->symbol)
-   (on-pass-back %stencil-test-on-pass-back
-                 stencil-test-on-pass-back
-                 symbol->stencil-op
-                 stencil-op->symbol)))
-
-(define* (make-stencil-test #:key (mask #xff) (function 'always)
-                            (function-mask #xff) (reference 0)
-                            (on-fail 'keep) (on-depth-fail 'keep) (on-pass 'keep)
-                            (mask-front mask) (mask-back mask)
-                            (function-front function) (function-back function)
-                            (function-mask-front function-mask)
-                            (function-mask-back function-mask)
-                            (reference-front reference)
-                            (reference-back reference)
-                            (on-fail-front on-fail) (on-fail-back on-fail)
-                            (on-depth-fail-front on-depth-fail)
-                            (on-depth-fail-back on-depth-fail)
-                            (on-pass-front on-pass) (on-pass-back on-pass))
-  (%make-stencil-test mask-front mask-back
-                      function-mask-front function-mask-back
-                      reference-front reference-back
-                      function-front function-back
-                      on-fail-front on-fail-back
-                      on-depth-fail-front on-depth-fail-back
-                      on-pass-front on-pass-back))
-
-(define (bind-stencil-test stencil-test)
-  (match stencil-test
-    (#f (gl-disable (enable-cap stencil-test)))
-    (($ <stencil-test> mask-front mask-back
-                       function-mask-front function-mask-back
-                       reference-front reference-back
-                       function-front function-back
-                       on-fail-front on-fail-back
-                       on-depth-fail-front on-depth-fail-back
-                       on-pass-front on-pass-back)
-     (gl-enable (enable-cap stencil-test))
-     ;; Mask
-     (gl-stencil-mask-separate (cull-face-mode front) mask-front)
-     (gl-stencil-mask-separate (cull-face-mode back) mask-back)
-     ;; Function
-     (gl-stencil-func-separate (cull-face-mode front)
-                               function-front reference-front mask-front)
-     (gl-stencil-func-separate (cull-face-mode back)
-                               function-back reference-back mask-back)
-     ;; Operation
-     (gl-stencil-op-separate (cull-face-mode front)
-                             on-fail-front on-depth-fail-front on-pass-front)
-     (gl-stencil-op-separate (cull-face-mode back)
-                             on-fail-back on-depth-fail-back on-pass-back))))
-
-(define stencil-test:default (make-stencil-test))
-
-(define (bind-multisample multisample?)
-  (if multisample?
-      (gl-enable (version-1-3 multisample))
-      (gl-disable (version-1-3 multisample))))
-
-(define (bind-seamless-cube-maps seamless-cube-maps?)
-  (if seamless-cube-maps?
-      (gl-enable (version-3-2 texture-cube-map-seamless))
-      (gl-disable (version-3-2 texture-cube-map-seamless))))
-
-(define (bind-clear-color color)
-  (gl-clear-color (color-r color)
-                  (color-g color)
-                  (color-b color)
-                  (color-a color)))
-
-(define-record-type <window-rect>
-  (make-window-rect x y width height)
-  window-rect?
-  (x window-rect-x)
-  (y window-rect-y)
-  (width window-rect-width)
-  (height window-rect-height))
-
-(define window-rect:empty (make-window-rect 0 0 0 0))
-
-(define (bind-scissor-test rect)
-  (match rect
-    (#f (gl-disable (enable-cap scissor-test)))
-    (($ <window-rect> x y width height)
-     (gl-enable (enable-cap scissor-test))
-     (gl-scissor x y width height))))
-
-(define (bind-viewport rect)
-  (match rect
-    (($ <window-rect> x y width height)
-     (gl-viewport x y width height))))
+(define-record-type <texture>
+  (%make-texture gpu handle destroyed? width height layers mip-level-count
+                 sample-count dimension format usage view-formats)
+  texture?
+  (gpu texture-gpu)
+  (handle texture-handle)
+  (destroyed? texture-destroyed? set-texture-destroyed!)
+  (width texture-width)
+  (height texture-height)
+  (layers texture-layers)
+  (mip-level-count texture-mip-level-count)
+  (sample-count texture-sample-count)
+  (dimension texture-dimension)
+  (format texture-format)
+  (usage texture-usage)
+  (view-formats texture-view-formats))
+
+(define (print-texture texture port)
+  (match texture
+    (($ <texture> _ handle _ width height layers _ _ dimension format* usage)
+     (format #t "#<texture handle: ~a width: ~a height: ~a layers: ~a dimension: ~a format: ~a usage: ~a>"
+             handle width height layers dimension format* usage))))
+
+(set-record-type-printer! <texture> print-texture)
+
+(define* (make-texture gpu #:key
+                       (width 1)
+                       (height 1)
+                       (layers 0)
+                       (mip-level-count 1)
+                       (sample-count 1)
+                       (dimension '2d)
+                       format usage
+                       (view-formats '()))
+  (let ((handle (backend:make-texture gpu width height layers mip-level-count
+                                      sample-count dimension format usage
+                                      view-formats)))
+    (%make-texture gpu handle #f width height layers mip-level-count
+                   sample-count dimension format usage view-formats)))
+
+(define (texture-destroy! texture)
+  (unless (texture-destroyed? texture)
+    (backend:texture-destroy (texture-gpu texture) (texture-handle texture))
+    (set-texture-destroyed! texture #t)))
+
+(define-record-type <texture-view>
+  (%make-texture-view gpu handle destroyed? texture format dimension aspect
+                      base-mip-level mip-level-count base-layer layer-count)
+  texture-view?
+  (gpu texture-view-gpu)
+  (handle texture-view-handle)
+  (destroyed? texture-view-destroyed? set-texture-view-destroyed!)
+  (texture texture-view-texture)
+  (format texture-view-format)
+  (dimension texture-view-dimension) ; 2d or 3d
+  (aspect texture-view-aspect) ; all, stencil-only, depth-only
+  (base-mip-level texture-view-base-mip-level)
+  (mip-level-count texture-view-mip-level-count)
+  (base-layer texture-view-base-layer)
+  (layer-count texture-view-layer-count))
+
+(define (print-texture-view view port)
+  (match view
+    (($ <texture-view> _ handle _ texture format* dimension)
+     (format #t "#<texture-view handle: ~a texture: ~a format: ~a dimension: ~a>"
+             handle texture format* dimension))))
+
+(set-record-type-printer! <texture-view> print-texture-view)
+
+(define* (make-texture-view gpu texture #:key
+                            format
+                            (dimension '2d)
+                            (aspect 'all)
+                            (base-mip-level 0)
+                            (mip-level-count 0)
+                            (base-layer 0)
+                            (layer-count 0))
+  (let ((handle (backend:make-texture-view gpu texture format dimension aspect
+                                           base-mip-level mip-level-count
+                                           base-layer layer-count)))
+    (%make-texture-view gpu handle #f texture format dimension aspect
+                        base-mip-level mip-level-count base-layer layer-count)))
+
+(define (texture-view-destroy! view)
+  (unless (texture-view-destroyed? view)
+    (backend:texture-view-destroy (texture-view-gpu view)
+                                  (texture-view-handle view))
+    (set-texture-view-destroyed! view #t)))
+
+;; TODO: lod, compare, anisotropy.
+(define-record-type <sampler>
+  (%make-sampler gpu handle destroyed?
+                 address-mode-u address-mode-v address-mode-w
+                 mag-filter min-filter mipmap-filter)
+  sampler?
+  (gpu sampler-gpu)
+  (handle sampler-handle)
+  (destroyed? sampler-destroyed? set-sampler-destroyed!)
+  ;; clamp-to-edge, repeat, or mirror-repeat
+  (address-mode-u sampler-address-mode-u)
+  (address-mode-v sampler-address-mode-v)
+  (address-mode-w sampler-address-mode-w)
+  ;; nearest or linear
+  (mag-filter sampler-mag-filter)
+  (min-filter sampler-min-filter)
+  (mipmap-filter sampler-mipmap-filter))
+
+(define (print-sampler view port)
+  (match view
+    (($ <sampler> _ handle _ u v w mag min mip)
+     (format #t "#<sampler handle: ~a address-mode-u: ~a address-mode-v: ~a address-mode-w: ~a mag-filter: ~a min-filter: ~a mipmap-filter: ~a>"
+             handle u v w mag min mip))))
+
+(set-record-type-printer! <sampler> print-sampler)
+
+(define* (make-sampler gpu #:key
+                       (address-mode-u 'clamp-to-edge)
+                       (address-mode-v 'clamp-to-edge)
+                       (address-mode-w 'clamp-to-edge)
+                       (mag-filter 'nearest)
+                       (min-filter 'nearest)
+                       (mipmap-filter 'nearest))
+  (let ((handle (backend:make-sampler gpu address-mode-u address-mode-v
+                                      address-mode-w mag-filter min-filter
+                                      mipmap-filter)))
+    (%make-sampler gpu handle #f address-mode-u address-mode-v
+                   address-mode-w mag-filter min-filter
+                   mipmap-filter)))
+
+(define (sampler-destroy! sampler)
+  (unless (sampler-destroyed? sampler)
+    (backend:sampler-destroy (sampler-gpu sampler) (sampler-handle sampler))
+    (set-sampler-destroyed! sampler #t)))
 
 
 ;;;
-;;; GPU objects
+;;; Shader modules
 ;;;
 
-(define-syntax-rule (define-gpu-type name
-                      (constructor (cparams ...) cargs ...)
-                      (free free-exp)
-                      (bind bind-exp)
-                      (null null-args ...)
-                      pred
-                      (field accessor) ...)
-  (begin
-    (define-record-type name
-      (%make field ... deleted?)
-      pred
-      (field accessor) ...
-      (deleted? %deleted? %set-deleted!))
-    (define (constructor cparams ...)
-      (%make cargs ... #f))
-    (define null (%make null-args ... #f))
-    (define (free obj)
-      (match obj
-        (($ name field ... deleted?)
-         (unless deleted?
-           free-exp
-           (%set-deleted! obj #t)))))
-    (define (bind obj)
-      (match obj
-        (($ name field ... deleted?)
-         (if deleted?
-             (error "GPU object has been deleted" obj)
-             bind-exp))))))
-
-(define-gpu-type <gpu-framebuffer>
-  (make-gpu-framebuffer () (gl-generate-framebuffer))
-  (free-gpu-framebuffer (gl-delete-framebuffer id))
-  (bind-gpu-framebuffer (gl-bind-framebuffer (version-3-0 framebuffer) id))
-  (gpu-framebuffer:null 0)
-  gpu-framebuffer?
-  (id gpu-framebuffer-id))
-
-(define-gpu-type <gpu-renderbuffer>
-  (make-gpu-renderbuffer () (gl-generate-renderbuffer))
-  (free-gpu-renderbuffer (gl-delete-renderbuffer id))
-  (bind-gpu-renderbuffer (gl-bind-renderbuffer (version-3-0 renderbuffer) id))
-  (gpu-renderbuffer:null 0)
-  gpu-renderbuffer?
-  (id gpu-renderbuffer-id))
-
-(define-gpu-type <gpu-buffer>
-  (make-gpu-buffer (target usage)
-                   (gl-generate-buffer)
-                   (symbol->buffer-target target)
-                   (symbol->buffer-usage usage)
-                   (and (eq? usage 'stream) (make-hash-table)))
-  (free-gpu-buffer (gl-delete-buffer id))
-  (bind-gpu-buffer (gl-bind-buffer target id))
-  (gpu-buffer:null 0 (symbol->buffer-target 'vertex)
-                   (symbol->buffer-usage 'static) #f)
-  gpu-buffer?
-  (id gpu-buffer-id)
-  (target gpu-buffer-target)
-  (usage gpu-buffer-usage)
-  (stream-cache gpu-buffer-stream-cache))
-
-(define-gpu-type <gpu-vertex-array>
-  (make-gpu-vertex-array () (gl-generate-vertex-array))
-  (free-gpu-vertex-array (gl-delete-vertex-array id))
-  (bind-gpu-vertex-array (gl-bind-vertex-array id))
-  (gpu-vertex-array:null 0)
-  gpu-vertex-array?
-  (id gpu-vertex-array-id))
-
-(define-gpu-type <gpu-texture>
-  (make-gpu-texture (target)
-                   (gl-generate-texture)
-                   (symbol->texture-target target))
-  (free-gpu-texture (gl-delete-texture id))
-  (bind-gpu-texture (gl-bind-texture target id))
-  (gpu-texture:null 0 (texture-target texture-2d))
-  gpu-texture?
-  (id gpu-texture-id)
-  (target gpu-texture-target))
-
-(define-gpu-type <gpu-shader>
-  (make-gpu-shader (type)
-                   (gl-create-shader
-                    (match type
-                      ('vertex (version-2-0 vertex-shader))
-                      ('fragment (version-2-0 fragment-shader)))))
-  (free-gpu-shader (gl-delete-shader id))
-  ;; Shaders are not bound but rather attached to a program, which is
-  ;; bound, so this is a stub.
-  (bind-gpu-shader #t)
-  (gpu-shader:null 0)
-  gpu-shader?
-  (id gpu-shader-id))
-
-(define-gpu-type <gpu-program>
-  (make-gpu-program () (gl-create-program))
-  (free-gpu-program (gl-delete-program id))
-  (bind-gpu-program (gl-use-program id))
-  (gpu-program:null 0)
-  gpu-program?
-  (id gpu-program-id))
+(define-record-type <shader-module>
+  (%make-shader-module gpu handle state)
+  shader-module?
+  (gpu shader-module-gpu)
+  (handle shader-module-handle)
+  (state shader-module-state set-shader-module-state!))
+
+(define (print-shader-module shader port)
+  (match shader
+    (($ <shader-module> _ handle)
+     (format #t "#<shader-module handle: ~a>" handle))))
+
+(set-record-type-printer! <shader-module> print-shader-module)
+
+(define (shader-module-available? shader-module)
+  (eq? (shader-module-state shader-module) 'available))
+
+(define (shader-module-destroyed? shader-module)
+  (eq? (shader-module-state shader-module) 'destroyed))
+
+(define* (make-shader-module gpu #:key vertex-source fragment-source)
+  (let ((handle (backend:make-shader-module gpu vertex-source fragment-source)))
+    (%make-shader-module gpu handle 'available)))
+
+(define (shader-module-destroy! module)
+  (unless (shader-module-destroyed? module)
+    (backend:shader-module-destroy (shader-module-gpu module)
+                                   (shader-module-handle module))
+    (set-shader-module-state! module 'destroyed)))
 
 
 ;;;
-;;; State management
+;;; Render pipelines
 ;;;
 
-;; An abstraction over the annoying OpenGL context state.  Minimizes
-;; GPU calls by keeping a local cache.
-(define-record-type <gpu>
-  (%make-gpu gl-context gl-version glsl-version max-texture-size
-             max-texture-units guardian textures)
-  gpu?
-  ;; Metadata:
-  (gl-context gpu-gl-context)
-  (gl-version gpu-gl-version)
-  (glsl-version gpu-glsl-version)
-  (max-texture-size gpu-max-texture-size)
-  (max-texture-units gpu-max-texture-units)
-  ;; GC integration for GPU data.
-  (guardian gpu-guardian)
-  ;; OpenGL state:
-  (front-face gpu-front-face %set-gpu-front-face!)
-  (blend-mode gpu-blend-mode %set-gpu-blend-mode!)
-  (cull-face-mode gpu-cull-face-mode %set-gpu-cull-face-mode!)
-  (polygon-mode gpu-polygon-mode %set-gpu-polygon-mode!)
-  (color-mask gpu-color-mask %set-gpu-color-mask!)
-  (depth-test gpu-depth-test %set-gpu-depth-test!)
-  (stencil-test gpu-stencil-test %set-gpu-stencil-test!)
-  (scissor-test gpu-scissor-test %set-gpu-scissor-test!)
-  (viewport gpu-viewport %set-gpu-viewport!)
-  (clear-color gpu-clear-color %set-gpu-clear-color!)
-  (multisample? gpu-multisample? %set-gpu-multisample!)
-  (seamless-cube-maps! gpu-seamless-cube-maps? %set-gpu-seamless-cube-maps!)
-  (framebuffer gpu-framebuffer %set-gpu-framebuffer!)
-  (renderbuffer gpu-renderbuffer %set-gpu-renderbuffer!)
-  (buffer gpu-buffer %set-gpu-buffer!)
-  (vertex-array gpu-vertex-array %set-gpu-vertex-array!)
-  (program gpu-program %set-gpu-program!)
-  ;; Unlike the other state, many textures can be bound to different
-  ;; units, and the maximum number of texture units varies from
-  ;; machine to machine.  So, we use a vector to hold the state of
-  ;; this unknown (until runtime) amount of textures.
-  (textures gpu-textures))
-
-(define (make-gpu gl-context)
-  (define (get-param name)
-    (let ((bv (make-s32vector 1)))
-      (gl-get-integer-v name (bytevector->pointer bv))
-      (s32vector-ref bv 0)))
-  (define (extract-version attr)
-    (match (string-split (pointer->string (gl-get-string attr)) #\space)
-      ((version . _) version)
-      (_ "unknown")))
-  (let* ((gl-version (extract-version (string-name version)))
-         (glsl-version (extract-version (version-2-0 shading-language-version)))
-         (max-texture-size (get-param (get-p-name max-texture-size)))
-         (max-texture-units (get-param (version-1-3 max-texture-units)))
-         (guardian (make-guardian))
-         (textures (make-vector max-texture-units #f)))
-    (%make-gpu gl-context gl-version glsl-version max-texture-size
-               max-texture-units guardian textures)))
-
-(define-syntax-rule (define-gpu-setter name %set! ref bind pred)
-  (define (name gpu obj)
-    (unless (pred obj (ref gpu))
-      (bind obj)
-      (%set! gpu obj))))
-
-(define-gpu-setter set-gpu-front-face!
-  %set-gpu-front-face! gpu-front-face bind-front-face eq?)
-(define-gpu-setter set-gpu-blend-mode!
-  %set-gpu-blend-mode! gpu-blend-mode bind-blend-mode eq?)
-(define-gpu-setter set-gpu-cull-face-mode!
-  %set-gpu-cull-face-mode! gpu-cull-face-mode bind-cull-face-mode eq?)
-(define-gpu-setter set-gpu-polygon-mode!
-  %set-gpu-polygon-mode! gpu-polygon-mode bind-polygon-mode eq?)
-(define-gpu-setter set-gpu-color-mask!
-  %set-gpu-color-mask! gpu-color-mask bind-color-mask equal?)
-(define-gpu-setter set-gpu-depth-test!
-  %set-gpu-depth-test! gpu-depth-test bind-depth-test equal?)
-(define-gpu-setter set-gpu-stencil-test!
-  %set-gpu-stencil-test! gpu-stencil-test bind-stencil-test equal?)
-(define-gpu-setter set-gpu-scissor-test!
-  %set-gpu-scissor-test! gpu-scissor-test bind-scissor-test equal?)
-(define-gpu-setter set-gpu-viewport!
-  %set-gpu-viewport! gpu-viewport bind-viewport equal?)
-(define-gpu-setter set-gpu-clear-color!
-  %set-gpu-clear-color! gpu-clear-color bind-clear-color equal?)
-(define-gpu-setter set-gpu-multisample!
-  %set-gpu-multisample! gpu-multisample? bind-multisample eq?)
-(define-gpu-setter set-gpu-seamless-cube-maps!
-  %set-gpu-seamless-cube-maps! gpu-seamless-cube-maps? bind-seamless-cube-maps eq?)
-(define-gpu-setter set-gpu-framebuffer!
-  %set-gpu-framebuffer! gpu-framebuffer bind-gpu-framebuffer eq?)
-(define-gpu-setter set-gpu-renderbuffer!
-  %set-gpu-renderbuffer! gpu-renderbuffer bind-gpu-renderbuffer eq?)
-(define-gpu-setter set-gpu-buffer!
-  %set-gpu-buffer! gpu-buffer bind-gpu-buffer eq?)
-(define-gpu-setter set-gpu-vertex-array!
-  %set-gpu-vertex-array! gpu-vertex-array bind-gpu-vertex-array eq?)
-(define-gpu-setter set-gpu-program!
-  %set-gpu-program! gpu-program bind-gpu-program eq?)
-
-(define (gpu-texture gpu unit)
-  (vector-ref (gpu-textures gpu) unit))
-
-(define (set-active-texture-unit! n)
-  (set-gl-active-texture (+ (version-1-3 texture0) n)))
-
-(define (set-gpu-texture! gpu unit texture)
-  (unless (eq? texture (gpu-texture gpu unit))
-    (set-active-texture-unit! unit)
-    (bind-gpu-texture texture)
-    (vector-set! (gpu-textures gpu) unit texture)))
+(define-record-type* <vertex-attribute>
+  make-vertex-attribute
+  attribute?
+  (location vertex-attribute-location #f)
+  (format vertex-attribute-format #f)
+  (offset vertex-attribute-offset 0))
+
+(define-record-type* <vertex-buffer-layout>
+  make-vertex-buffer-layout
+  vertex-buffer-layout?
+  (stride vertex-buffer-layout-stride 0)
+  (step-mode vertex-buffer-layout-step-mode 'vertex)
+  (attributes vertex-buffer-layout-attributes '()))
+
+(define-record-type* <vertex-state>
+  make-vertex-state
+  vertex-state?
+  (module vertex-state-module #f)
+  (buffers vertex-state-buffers '()))
+
+(define-record-type* <blend-component>
+  make-blend-component
+  blend-component?
+  (operation blend-component-operation 'add)
+  (src-factor blend-component-src-factor 'one)
+  (dst-factor blend-component-dst-factor 'zero))
+
+(define-record-type* <blend-state>
+  make-blend-state
+  blend-state?
+  (color blend-state-color (make-blend-component))
+  (alpha blend-state-alpha (make-blend-component)))
+
+(define-record-type* <color-target-state>
+  make-color-target-state
+  color-target-state?
+  (format color-target-state-format #f)
+  (blend color-target-state-blend #f)
+  (write-mask color-target-state-write-mask #xf))
+
+(define-record-type* <fragment-state>
+  make-fragment-state
+  fragment-state?
+  (module fragment-state-module #f)
+  (targets fragment-state-targets '()))
+
+(define-record-type* <primitive-state>
+  make-primitive-state
+  primitive-state
+  (topology primitive-state-topology 'triangle-list)
+  (front-face primitive-state-front-face 'ccw)
+  (cull-mode primitive-state-cull-mode 'none)
+  (unclipped-depth? primitive-state-unclipped-depth? #f))
+
+(define-record-type* <stencil-face-state>
+  make-stencil-face-state
+  stencil-face-state?
+  (compare stencil-face-state-compare 'always)
+  (fail-op stencil-face-state-fail-op 'keep)
+  (depth-fail-op stencil-face-state-depth-fail-op 'keep)
+  (pass-op stencil-face-state-pass-op 'keep))
+
+;; TODO: depth bias fields.
+(define-record-type* <depth-stencil-state>
+  make-depth-stencil-state
+  depth-stencil-state?
+  (format depth-stencil-state-format #f)
+  (depth-write-enabled? depth-stencil-state-depth-write-enabled? #f)
+  (compare-function depth-stencil-state-compare-function #f)
+  (stencil-front depth-stencil-state-stencil-front (make-stencil-face-state))
+  (stencil-back depth-stencil-state-stencil-back (make-stencil-face-state))
+  (stencil-read-mask depth-stencil-state-stencil-read-mask #xffffffff)
+  (stencil-write-mask depth-stencil-state-stencil-write-mask #xffffffff))
+
+(define-record-type* <multisample-state>
+  make-multisample-state
+  multisample-state?
+  (count multisample-state-count 1)
+  (mask multisample-state-mask #xffffffff)
+  (alpha-to-coverage? multisample-state-alpha-to-coverage? #f))
+
+(define-record-type <render-pipeline>
+  (%make-render-pipeline handle vertex fragment primitive depth-stencil multisample)
+  render-pipeline?
+  (handle render-pipeline-handle)
+  (vertex render-pipeline-vertex)
+  (fragment render-pipeline-fragment)
+  (primitive render-pipeline-primitive)
+  (depth-stencil render-pipeline-depth-stencil)
+  (multisample render-pipeline-multisample))
+
+(define* (make-render-pipeline gpu #:key vertex fragment
+                               (primitive (make-primitive-state))
+                               depth-stencil
+                               (multisample (make-multisample-state)))
+  (unless (vertex-state? vertex)
+    (error "vertex state is required"))
+  (let ((handle (backend:make-render-pipeline gpu vertex fragment primitive
+                                              depth-stencil multisample)))
+    (%make-render-pipeline handle vertex fragment primitive depth-stencil
+                           multisample)))
+
+(define default-clear-color (make-color 0.0 0.0 0.0 0.0))
+
+(define-record-type* <color-attachment>
+  make-color-attachment
+  color-attachment?
+  (view color-attachment-view #f)
+  (resolve-target color-attachment-resolve-target #f)
+  (clear-color color-attachment-clear-color default-clear-color)
+  (load-op color-attachment-load-op 'clear)
+  (store-op color-attachment-store-op 'store))
+
+(define-record-type* <depth-stencil-attachment>
+  make-depth-stencil-attachment
+  depth-stencil-attachment?
+  (view depth-stencil-attachment-view #f)
+  (depth-clear-value depth-stencil-attachment-depth-clear-value 0.0)
+  (depth-load-op depth-stencil-attachment-depth-load-op 'clear)
+  (depth-store-op depth-stencil-attachment-depth-store-op 'store)
+  (depth-read-only? depth-stencil-attachment-depth-read-only? #f)
+  (stencil-clear-value depth-stencil-attachment-stencil-clear-value 0)
+  (stencil-load-op depth-stencil-attachment-stencil-load-op 'clear)
+  (stencil-store-op depth-stencil-attachment-stencil-store-op 'store)
+  (stencil-read-only? depth-stencil-attachment-stencil-read-only? #f))
+
+(define-record-type* <render-pass-descriptor>
+  make-render-pass-descriptor
+  render-pass-descriptor?
+  (color-attachments render-pass--descriptorcolor-attachments '())
+  (depth-stencil-attachment render-pass-descriptor-depth-stencil-attachment #f)
+  (max-draw-count render-pass-descriptor-max-draw-count 50000000))
+
+;; (define-record-type <buffer-binding-layout>
+;;   (make-buffer-binding-layout type)
+;;   buffer-binding-layout?
+;;   ;; uniform, storage, or read-only-storage
+;;   (type buffer-binding-layout-type))
+
+;; (define-record-type <sampler-binding-layout>
+;;   (make-sampler-binding-layout type)
+;;   ;; filtering or non-filtering
+;;   (type sampler-binding-layout-type))
+
+;; (define-record-type <texture-binding-layout>
+;;   (make-texture-binding-layout type dimension multisample?)
+;;   texture-binding-layout?
+;;   ;; float, unfilterable-float, depth, sint, uint
+;;   (type texture-binding-layout-type)
+;;   (dimension texture-binding-layout-dimension) ; 2d or 3d
+;;   (multisample? texture-binding-layout-multisample?))
+
+;; (define-record-type <binding-layout>
+;;   (make-binding-layout index stages kind)
+;;   binding-layout?
+;;   (index binding-layout-index) ; integer
+;;   (stages binding-layout-stages) ; vertex, fragment, or compute
+;;   (kind binding-layout-kind))
+
+;; (define-record-type <bind-group-entry>
+;;   (make-bind-group-entry index resource)
+;;   bind-group-entry?
+;;   (index bind-group-entry-index)
+;;   (resource bind-group-entry-resource))
+
+;; (define-record-type <bind-group>
+;;   (make-bind-group layout bindings)
+;;   bind-group?
+;;   (layout bind-group-layout)
+;;   (bindings bind-group-bindings))
+
+;; ;; A single GPU command. These objects are re-used over and over to
+;; ;; reduce allocation during rendering.  Not directly exposed to users.
+;; (define-record-type <command>
+;;   (make-render-command op arg1 arg2 arg3 arg4 arg5)
+;;   render-command?
+;;   (op render-command-op)
+;;   (arg1 render-command-arg1)
+;;   (arg2 render-command-arg2)
+;;   (arg3 render-command-arg3)
+;;   (arg4 render-command-arg4)
+;;   (arg5 render-command-arg5))
+
+
+;;;
+;;; Commands
+;;;
+
+(define-record-type <command-buffer>
+  (make-command-buffer commands)
+  command-buffer?
+  (commands command-buffer-commands))
+
+;; A public wrapper around a command buffer.  The command encoder asks
+;; the GPU for a command buffer (so that the GPU can reuse command
+;; buffers repeatedly to reduce allocation), fills it up with
+;; commands, and then submits the buffer back to the GPU for
+;; execution.
+(define-record-type <command-encoder>
+  (%make-command-encoder state commands)
+  command-encoder?
+  (state command-encoder-state set-command-encoder-state!)
+  (commands command-encoder-commands set-command-encoder-commands!))
+
+;; TODO: Don't hardcode this limit and move the limit into the GPU
+;; object.
+(define max-vertex-buffers 8)
+
+(define-record-type <render-pass-encoder>
+  (make-render-pass-encoder state command-encoder descriptor pipeline
+                            vertex-buffers)
+  render-pass-encoder?
+  (state render-pass-encoder-state set-render-pass-encoder-state!)
+  (command-encoder render-pass-encoder-command-encoder)
+  (descriptor render-pass-encoder-descriptor)
+  (pipeline render-pass-encoder-pipeline set-render-pass-encoder-pipeline!)
+  (vertex-buffers render-pass-encoder-vertex-buffers
+                  set-render-pass-encoder-vertex-buffers!))
+
+(define-record-type <render-state>
+  (%make-render-state pipeline vertex-buffers)
+  render-state?
+  (pipeline render-state-pipeline)
+  (vertex-buffers render-state-vertex-buffers))
+
+(define-record-type <draw-command>
+  (make-draw-command render-state vertex-count instance-count
+                     first-vertex first-instance)
+  draw-command?
+  (render-state draw-command-render-state)
+  (vertex-count draw-command-vertex-count)
+  (instance-count draw-command-instance-count)
+  (first-vertex draw-command-first-vertex)
+  (first-instance draw-command-first-instance))
+
+(define (make-render-state pipeline vertex-buffers)
+  (%make-render-state pipeline (vector-copy vertex-buffers)))
+
+(define (make-command-encoder)
+  (%make-command-encoder 'open '()))
+
+(define (command-encoder-add! encoder command)
+  (set-command-encoder-commands! encoder
+                                 (cons command
+                                       (command-encoder-commands encoder))))
+
+(define (command-encoder-finish encoder)
+  (make-command-buffer (reverse (command-encoder-commands encoder))))
+
+(define (begin-render-pass command-encoder pass-descriptor)
+  (make-render-pass-encoder 'open command-encoder pass-descriptor
+                            #f (make-vector max-vertex-buffers #f)))
+
+(define (end-render-pass pass)
+  (set-render-pass-encoder-state! pass 'closed))
+
+(define (render-pass-encoder->render-state pass)
+  (match pass
+    (($ <render-pass-encoder> _ _ _ pipeline vertex-buffers)
+     (make-render-state pipeline vertex-buffers))))
+
+(define (set-render-pass-encoder-vertex-buffer! pass index buffer)
+  (vector-set! (render-pass-encoder-vertex-buffers pass) index buffer))
+
+(define* (render-pass-draw pass vertex-count #:key
+                           (instance-count 1)
+                           (first-vertex 0)
+                           (first-instance 0))
+  (let ((cmd (make-draw-command (render-pass-encoder->render-state pass)
+                                vertex-count instance-count
+                                first-vertex first-instance)))
+    (command-encoder-add! (render-pass-encoder-command-encoder pass) cmd)))
+
+(define (gpu-submit gpu command-buffer)
+  (with-mutex (gpu-mutex gpu)
+    (backend:enqueue gpu command-buffer)))
+
+
+;;;
+;;; Garbage collection
+;;;
 
 (define (gpu-gc gpu)
-  (let ((guardian (gpu-guardian gpu)))
-    (let loop ()
-      (match (guardian)
-        (#f *unspecified*)
-        ((? gpu-framebuffer? fb)
-         (free-gpu-framebuffer fb)
-         (loop))
-        ((? gpu-renderbuffer? rb)
-         (free-gpu-renderbuffer rb)
-         (loop))
-        ((? gpu-buffer? buf)
-         (free-gpu-buffer buf)
-         (loop))
-        ((? gpu-vertex-array? va)
-         (free-gpu-vertex-array va)
-         (loop))
-        ((? gpu-texture? t)
-         (free-gpu-texture t)
-         (loop))
-        ((? gpu-shader? s)
-         (free-gpu-shader s)
-         (loop))
-        ((? gpu-program? p)
-         (free-gpu-program p)
-         (loop))))))
-
-(define (guard! gpu obj)
-  ((gpu-guardian gpu) obj)
-  obj)
-
-(define-syntax-rule (define-fresh name constructor params ...)
-  (define (name gpu params ...)
-    (guard! gpu (constructor params ...))))
-
-(define-fresh fresh-gpu-framebuffer make-gpu-framebuffer)
-(define-fresh fresh-gpu-renderbuffer make-gpu-renderbuffer)
-(define-fresh fresh-gpu-buffer make-gpu-buffer target usage)
-(define-fresh fresh-gpu-vertex-array make-gpu-vertex-array)
-(define-fresh fresh-gpu-texture make-gpu-texture target)
-(define-fresh fresh-gpu-shader make-gpu-shader type)
-(define-fresh fresh-gpu-program make-gpu-program)
-
-(define (gpu-reset! gpu)
-  (set-gpu-front-face! gpu front-face:ccw)
-  (set-gpu-blend-mode! gpu blend:replace)
-  (set-gpu-cull-face-mode! gpu cull-face:back)
-  (set-gpu-polygon-mode! gpu polygon:fill)
-  (set-gpu-color-mask! gpu color-mask:all)
-  (set-gpu-depth-test! gpu #f)
-  (set-gpu-stencil-test! gpu #f)
-  (set-gpu-scissor-test! gpu #f)
-  (set-gpu-viewport! gpu window-rect:empty)
-  (set-gpu-clear-color! gpu black)
-  (set-gpu-multisample! gpu #f)
-  (set-gpu-seamless-cube-maps! gpu #f)
-  (set-gpu-framebuffer! gpu gpu-framebuffer:null)
-  (set-gpu-renderbuffer! gpu gpu-renderbuffer:null)
-  (set-gpu-buffer! gpu gpu-buffer:null)
-  (set-gpu-vertex-array! gpu gpu-vertex-array:null)
-  (set-gpu-program! gpu gpu-program:null)
-  (let ((textures (gpu-textures gpu)))
-    (let loop ((i 0))
-      (when (< i (vector-length textures))
-        (set-gpu-texture! gpu i gpu-texture:null)
-        (loop (+ i 1))))))
-
-(define (set-gpu-texture-min-filter! gpu texture filter)
-  (set-gpu-texture! gpu 0 texture)
-  (set-active-texture-unit! 0)
-  (gl-texture-parameter (gpu-texture-target texture)
-                        (texture-parameter-name texture-min-filter)
-                        (symbol->texture-min-filter filter)))
-
-(define (set-gpu-texture-mag-filter! gpu texture filter)
-  (set-gpu-texture! gpu 0 texture)
-  (set-active-texture-unit! 0)
-  (gl-texture-parameter (gpu-texture-target texture)
-                        (texture-parameter-name texture-mag-filter)
-                        (symbol->texture-mag-filter filter)))
-
-(define (set-gpu-texture-wrap-r! gpu texture mode)
-  (set-gpu-texture! gpu 0 texture)
-  (set-active-texture-unit! 0)
-  (gl-texture-parameter (gpu-texture-target texture)
-                        (texture-parameter-name texture-wrap-r-ext)
-                        (symbol->texture-wrap-mode mode)))
-
-(define (set-gpu-texture-wrap-s! gpu texture mode)
-  (set-gpu-texture! gpu 0 texture)
-  (set-active-texture-unit! 0)
-  (gl-texture-parameter (gpu-texture-target texture)
-                        (texture-parameter-name texture-wrap-s)
-                        (symbol->texture-wrap-mode mode)))
-
-(define (set-gpu-texture-wrap-t! gpu texture mode)
-  (set-gpu-texture! gpu 0 texture)
-  (set-active-texture-unit! 0)
-  (gl-texture-parameter (gpu-texture-target texture)
-                        (texture-parameter-name texture-wrap-t)
-                        (symbol->texture-wrap-mode mode)))
-
-(define-inlinable (tex-image-2d gpu target level internal-format
-                                width height pixel-format pixels)
-  (gl-texture-image-2d target
-                       level
-                       (symbol->pixel-format internal-format)
-                       width height 0
-                       (symbol->pixel-format pixel-format)
-                       (color-pointer-type unsigned-byte)
-                       (or pixels %null-pointer)))
-
-(define (gpu-texture-upload-2d gpu texture level internal-format
-                                width height pixel-format pixels)
-  (set-gpu-texture! gpu 0 texture)
-  (set-active-texture-unit! 0)
-  (tex-image-2d gpu (gpu-texture-target texture) level internal-format
-                width height pixel-format pixels))
-
-(define (gpu-texture-upload-2d/sub gpu texture level x y width height
-                                   pixel-format pixels)
-  (set-gpu-texture! gpu 0 texture)
-  (set-active-texture-unit! 0)
-  (gl-texture-sub-image-2d (gpu-texture-target texture) 0
-                           x y width height
-                           (symbol->pixel-format pixel-format)
-                           (color-pointer-type unsigned-byte)
-  	                   pixels))
-
-(define (gpu-texture-copy-image gpu texture level pixel-format dst offset)
-  (set-gpu-texture! gpu 0 texture)
-  (set-active-texture-unit! 0)
-  (gl-get-tex-image (gpu-texture-target texture) level
-                    (symbol->pixel-format pixel-format)
-                    (color-pointer-type unsigned-byte)
-                    (bytevector->pointer dst offset)))
-
-(define (gpu-texture-upload-cube-map-positive-x gpu texture internal-format
-                                                width height pixel-format
-                                                pixels)
-  (set-gpu-texture! gpu 0 texture)
-  (set-active-texture-unit! 0)
-  (tex-image-2d gpu (version-1-3 texture-cube-map-positive-x)
-                0 internal-format
-                width height pixel-format pixels))
-
-(define (gpu-texture-upload-cube-map-negative-x gpu texture internal-format
-                                                width height pixel-format
-                                                pixels)
-  (set-gpu-texture! gpu 0 texture)
-  (set-active-texture-unit! 0)
-  (tex-image-2d gpu (version-1-3 texture-cube-map-negative-x)
-                0 internal-format
-                width height pixel-format pixels))
-
-(define (gpu-texture-upload-cube-map-positive-y gpu texture internal-format
-                                                width height pixel-format
-                                                pixels)
-  (set-gpu-texture! gpu 0 texture)
-  (set-active-texture-unit! 0)
-  (tex-image-2d gpu (version-1-3 texture-cube-map-positive-y)
-                0 internal-format
-                width height pixel-format pixels))
-
-(define (gpu-texture-upload-cube-map-negative-y gpu texture internal-format
-                                                width height pixel-format
-                                                pixels)
-  (set-gpu-texture! gpu 0 texture)
-  (set-active-texture-unit! 0)
-  (tex-image-2d gpu (version-1-3 texture-cube-map-negative-y)
-                0 internal-format
-                width height pixel-format pixels))
-
-(define (gpu-texture-upload-cube-map-positive-z gpu texture internal-format
-                                                width height pixel-format
-                                                pixels)
-  (set-gpu-texture! gpu 0 texture)
-  (set-active-texture-unit! 0)
-  (tex-image-2d gpu (version-1-3 texture-cube-map-positive-z)
-                0 internal-format
-                width height pixel-format pixels))
-
-(define (gpu-texture-upload-cube-map-negative-z gpu texture internal-format
-                                                width height pixel-format
-                                                pixels)
-  (set-gpu-texture! gpu 0 texture)
-  (set-active-texture-unit! 0)
-  (tex-image-2d gpu (version-1-3 texture-cube-map-negative-z)
-                0 internal-format
-                width height pixel-format pixels))
-
-(define (gpu-texture-generate-mipmap gpu texture)
-  (set-gpu-texture! gpu 0 texture)
-  (set-active-texture-unit! 0)
-  (gl-generate-mipmap (gpu-texture-target texture)))
-
-(define %draw-buffers
-  (bytevector->pointer (u32vector (version-3-0 color-attachment0))))
-
-(define (gpu-framebuffer-init gpu framebuffer renderbuffer texture width height)
-  (set-gpu-framebuffer! gpu framebuffer)
-  ;; Setup depth buffer.
-  (set-gpu-renderbuffer! gpu renderbuffer)
-  (gl-renderbuffer-storage (version-3-0 renderbuffer)
-                           (arb-framebuffer-object depth24-stencil8)
-                           width
-                           height)
-  (set-gpu-renderbuffer! gpu gpu-renderbuffer:null)
-  (gl-framebuffer-renderbuffer (version-3-0 framebuffer)
-                               (arb-framebuffer-object depth-stencil-attachment)
-                               (version-3-0 renderbuffer)
-                               renderbuffer)
-  ;; Setup framebuffer texture.
-  (gl-framebuffer-texture-2d (version-3-0 framebuffer)
-                             (version-3-0 color-attachment0)
-                             (texture-target texture-2d)
-                             (gpu-texture-id texture)
-                             0)
-  (gl-draw-buffers 1 %draw-buffers)
-  ;; Check for errors.
-  (unless (= (gl-check-framebuffer-status (version-3-0 framebuffer))
-             (version-3-0 framebuffer-complete))
-    (error "Framebuffer cannot be created")))
-
-(define (gpu-buffer-upload gpu buffer usage data length offset)
-  (set-gpu-buffer! gpu buffer)
-  (gl-buffer-data (gpu-buffer-target buffer)
-                  length
-                  (if data
-                      (bytevector->pointer data offset)
-                      %null-pointer)
-                  (symbol->buffer-usage usage)))
-
-;; For streaming buffers, we use buffer re-specification to achieve
-;; good throughput.  However, it requires getting a new data pointer
-;; every frame and allocating a Scheme bytevector for that memory
-;; region.  Allocating this bytevector every frame causes significant
-;; GC pressure.  It turns out that GPU drivers tend to return the same
-;; set of pointers over and over, or at least the driver I'm using
-;; does this.  So, by caching bytevectors for those memory regions we
-;; avoid bytevector allocation after a frame or two of warmup.
-(define (pointer->bytevector/cached buffer pointer length)
-  (let* ((cache (gpu-buffer-stream-cache buffer))
-         (address (pointer-address pointer))
-         (cached (hashv-ref cache address)))
-    ;; It could be that there is a cached bytevector for the address,
-    ;; but the bytevector is a different length.  We must treat this
-    ;; as a cache miss and allocate a new bytevector.
-    (if (and cached (= (bytevector-length cached) length))
-        cached
-        (let ((bv (pointer->bytevector pointer length)))
-          (hashv-set! cache address bv)
-          bv))))
-
-(define (gpu-buffer-map gpu buffer length mode)
-  (let ((target (gpu-buffer-target buffer))
-        (usage (gpu-buffer-usage buffer)))
-    (set-gpu-buffer! gpu buffer)
-    (when (= usage (version-1-5 stream-draw))
-      ;; Orphan the buffer to avoid implicit synchronization.
-      ;; https://www.opengl.org/wiki/Buffer_Object_Streaming#Buffer_re-specification
-      (gl-buffer-data target length %null-pointer (gpu-buffer-usage buffer)))
-    (let ((ptr (gl-map-buffer target (symbol->access-mode mode))))
-      (pointer->bytevector/cached buffer ptr length))))
-
-(define (gpu-buffer-unmap gpu buffer)
-  (set-gpu-buffer! gpu buffer)
-  (gl-unmap-buffer (gpu-buffer-target buffer)))
-
-(define *offset-cache* (make-hash-table))
-
-(define (offset->pointer offset)
-  (or (hashv-ref *offset-cache* offset)
-      (let ((ptr (make-pointer offset)))
-        (hashv-set! *offset-cache* offset ptr)
-        ptr)))
-
-(define (gpu-vertex-array-apply-attribute gpu array buffer index size type
-                                          normalized? stride offset divisor)
-  (set-gpu-vertex-array! gpu array)
-  (set-gpu-buffer! gpu buffer)
-  (gl-enable-vertex-attrib-array index)
-  (gl-vertex-attrib-pointer index size (symbol->data-type type) normalized?
-                            stride (offset->pointer offset))
-  (when divisor
-    (gl-vertex-attrib-divisor index divisor)))
-
-(define (gpu-clear-viewport flags)
-  (gl-clear
-   (fold (lambda (flag result)
-           (logior (match flag
-                     ('depth-buffer 256)
-                     ('accum-buffer 512)
-                     ('stencil-buffer 1024)
-                     ('color-buffer 16384))
-                   result))
-         0 flags)))
-
-(define (gpu-draw gpu mode count offset)
-  (gl-draw-arrays (symbol->begin-mode mode) offset count))
-
-(define (gpu-draw/indexed gpu indices type mode count offset)
-  (set-gpu-buffer! gpu indices)
-  (gl-draw-elements (symbol->begin-mode mode)
-                    count
-                    (symbol->data-type type)
-                    (offset->pointer offset)))
-
-(define (gpu-draw/instanced gpu mode count offset instances)
-  (gl-draw-arrays-instanced (symbol->begin-mode mode) offset count instances))
-
-(define (gpu-draw/instanced+indexed gpu indices type mode count offset instances)
-  (set-gpu-buffer! gpu indices)
-  (gl-draw-elements-instanced (symbol->begin-mode mode)
-                              count
-                              (symbol->data-type type)
-                              (offset->pointer offset)
-                              instances))
-
-(define (gpu-shader-compiled? shader)
-  (let ((status (make-u32vector 1)))
-    (gl-get-shaderiv (gpu-shader-id shader)
-                     (version-2-0 compile-status)
-                     (bytevector->pointer status))
-    (= (u32vector-ref status 0) 1)))
-
-(define (set-gpu-shader-source shader source)
-  (let ((bv (string->utf8 source)))
-    (gl-shader-source (gpu-shader-id shader)
-                      1
-                      (bytevector->pointer
-                       (u64vector
-                        (pointer-address (bytevector->pointer bv))))
-                      (bytevector->pointer
-                       (u32vector (bytevector-length bv))))))
-
-(define (gpu-shader-compile shader)
-  (gl-compile-shader (gpu-shader-id shader)))
-
-(define (set-gpu-program-uniform:signed-int location ptr)
-  (gl-uniform1iv location 1 ptr))
-
-(define (set-gpu-program-uniform:unsigned-int location ptr)
-  (gl-uniform1uiv location 1 ptr))
-
-(define (set-gpu-program-uniform:float location ptr)
-  (gl-uniform1fv location 1 ptr))
-
-(define (set-gpu-program-uniform:vec2 location ptr)
-  (gl-uniform2fv location 1 ptr))
-
-(define (set-gpu-program-uniform:vec3 location ptr)
-  (gl-uniform3fv location 1 ptr))
-
-(define (set-gpu-program-uniform:vec4 location ptr)
-  (gl-uniform4fv location 1 ptr))
-
-(define (set-gpu-program-uniform:mat3 location ptr)
-  (gl-uniform-matrix3fv location 1 #f ptr))
-
-(define (set-gpu-program-uniform:mat4 location ptr)
-  (gl-uniform-matrix4fv location 1 #f ptr))
-
-(define (gpu-program-linked? program)
-  (let ((status (make-u32vector 1)))
-    (gl-get-programiv (gpu-program-id program)
-                      (version-2-0 link-status)
-                      (bytevector->pointer status))
-    (= (u32vector-ref status 0) 1)))
-
-(define (gpu-shader-info-log shader)
-    (let ((log-length-bv (make-u32vector 1)))
-      (gl-get-shaderiv (gpu-shader-id shader) (version-2-0 info-log-length)
-                       (bytevector->pointer log-length-bv))
-      (u32vector-ref log-length-bv 0)
-      ;; Add one byte to account for the null string terminator.
-      (let* ((log-length (u32vector-ref log-length-bv 0))
-             (log (make-u8vector (1+ log-length))))
-        (gl-get-shader-info-log (gpu-shader-id shader) log-length
-                                %null-pointer (bytevector->pointer log))
-        (utf8->string log))))
-
-(define (gpu-program-info-log program)
-    (let ((log-length-bv (make-u32vector 1)))
-      (gl-get-shaderiv (gpu-shader-id program) (version-2-0 info-log-length)
-                       (bytevector->pointer log-length-bv))
-      (u32vector-ref log-length-bv 0)
-      ;; Add one byte to account for the null string terminator.
-      (let* ((log-length (u32vector-ref log-length-bv 0))
-             (log (make-u8vector (1+ log-length))))
-        (gl-get-shader-info-log (gpu-shader-id program) log-length
-                                %null-pointer (bytevector->pointer log))
-        (utf8->string log))))
-
-(define (gpu-program-attach-shader program shader)
-  (gl-attach-shader (gpu-program-id program) (gpu-shader-id shader)))
-
-(define (gpu-program-link program)
-  (gl-link-program (gpu-program-id program)))
-
-(define (gpu-program-uniform-count program)
-  (let ((bv (make-u32vector 1)))
-    (gl-get-programiv (gpu-program-id program)
-                      (arb-shader-objects active-uniforms)
-                      (bytevector->pointer bv))
-    (u32vector-ref bv 0)))
-
-(define (gpu-program-attribute-count program)
-  (let ((bv (make-u32vector 1)))
-    (gl-get-programiv (gpu-program-id program)
-                      (arb-shader-objects active-attributes)
-                      (bytevector->pointer bv))
-    (u32vector-ref bv 0)))
-
-(define (utf8->string* bv length)
-  (let ((bv* (make-bytevector length)))
-    (bytevector-copy! bv 0 bv* 0 length)
-    (utf8->string bv*)))
-
-(define (parse-data-type type)
-  (cond
-   ((= type (version-2-0 bool)) 'bool)
-   ((= type (data-type int)) 'int)
-   ((= type (data-type unsigned-int)) 'unsigned-int)
-   ((= type (data-type float)) 'float)
-   ((= type (version-2-0 float-vec2)) 'float-vec2)
-   ((= type (version-2-0 float-vec3)) 'float-vec3)
-   ((= type (version-2-0 float-vec4)) 'float-vec4)
-   ((= type (version-2-0 float-mat3)) 'mat3)
-   ((= type (version-2-0 float-mat4)) 'mat4)
-   ((= type (version-2-0 sampler-2d)) 'sampler-2d)
-   ((= type (version-2-0 sampler-cube)) 'sampler-cube)
-   (else
-    (error "unsupported OpenGL uniform type" type))))
-
-(define (gpu-program-uniform-ref program index)
-  (let ((length-bv (make-u32vector 1))
-        (size-bv (make-u32vector 1))
-        (type-bv (make-u32vector 1))
-        (name-bv (make-bytevector 255)))
-    (gl-get-active-uniform (gpu-program-id program)
-                           index
-                           (bytevector-length name-bv)
-                           (bytevector->pointer length-bv)
-                           (bytevector->pointer size-bv)
-                           (bytevector->pointer type-bv)
-                           (bytevector->pointer name-bv))
-    (let* ((name-length (u32vector-ref length-bv 0))
-           (name (utf8->string* name-bv name-length))
-           (location (gl-get-uniform-location (gpu-program-id program) name))
-           (size (u32vector-ref size-bv 0))
-           (type (parse-data-type (u32vector-ref type-bv 0))))
-      (values name location size type))))
-
-(define (gpu-program-attribute-ref program index)
-  (let ((length-bv (make-u32vector 1))
-              (size-bv (make-u32vector 1))
-              (type-bv (make-u32vector 1))
-              (name-bv (make-bytevector 255)))
-          (gl-get-active-attrib (gpu-program-id program)
-                                index
-                                (bytevector-length name-bv)
-                                (bytevector->pointer length-bv)
-                                (bytevector->pointer size-bv)
-                                (bytevector->pointer type-bv)
-                                (bytevector->pointer name-bv))
-          (let* ((length (u32vector-ref length-bv 0))
-                 (name (utf8->string* name-bv length))
-                 (size (u32vector-ref size-bv 0))
-                 (type (parse-data-type (u32vector-ref type-bv 0)))
-                 (location (gl-get-attrib-location (gpu-program-id program)
-                                                   name)))
-            (values name location size type))))
+  (with-mutex (gpu-mutex gpu)
+    (let ((guardian (gpu-guardian gpu)))
+      (let loop ()
+        (let ((obj (guardian)))
+          (when obj
+            (match obj
+              ((? buffer? buffer) (buffer-destroy! buffer))
+              ((? texture? texture) (texture-destroy! texture))
+              ((? shader-module? module) (shader-module-destroy! module)))
+            (loop)))))))
diff --git a/chickadee/graphics/shader.scm b/chickadee/graphics/shader.scm
index 9974b38..83f0b46 100644
--- a/chickadee/graphics/shader.scm
+++ b/chickadee/graphics/shader.scm
@@ -134,7 +134,7 @@
   #:serializer
   (lambda (bv i bool)
     (bytevector-s32-native-set! bv i (if bool 1 0)))
-  #:setter set-gpu-program-uniform:signed-int
+  #:setter 'set-gpu-program-uniform:signed-int
   #:null #false)
 
 (define-shader-primitive-type int
@@ -144,7 +144,7 @@
   #:serializer
   (lambda (bv i n)
     (bytevector-s32-native-set! bv i n))
-  #:setter set-gpu-program-uniform:signed-int
+  #:setter 'set-gpu-program-uniform:signed-int
   #:null 0)
 
 (define-shader-primitive-type unsigned-int
@@ -156,7 +156,7 @@
   #:serializer
   (lambda (bv i u)
     (bytevector-u32-native-set! bv i u))
-  #:setter set-gpu-program-uniform:unsigned-int
+  #:setter 'set-gpu-program-uniform:unsigned-int
   #:null 0)
 
 (define-shader-primitive-type float
@@ -166,7 +166,7 @@
   #:serializer
   (lambda (bv i f)
     (bytevector-ieee-single-native-set! bv i f))
-  #:setter set-gpu-program-uniform:float
+  #:setter 'set-gpu-program-uniform:float
   #:null 0.0)
 
 (define-shader-primitive-type float-vec2
@@ -177,7 +177,7 @@
   (let ((unwrap-vec2 (@@ (chickadee math vector) unwrap-vec2)))
     (lambda (bv i v)
       (bytevector-copy! (unwrap-vec2 v) 0 bv i 8)))
-  #:setter set-gpu-program-uniform:vec2
+  #:setter 'set-gpu-program-uniform:vec2
   #:null (vec2 0.0 0.0))
 
 (define-shader-primitive-type float-vec3
@@ -188,7 +188,7 @@
   (let ((unwrap-vec3 (@@ (chickadee math vector) unwrap-vec3)))
     (lambda (bv i v)
       (bytevector-copy! (unwrap-vec3 v) 0 bv i 12)))
-  #:setter set-gpu-program-uniform:vec3
+  #:setter 'set-gpu-program-uniform:vec3
   #:null (vec3 0.0 0.0 0.0))
 
 (define-shader-primitive-type float-vec4
@@ -207,7 +207,7 @@
         (bytevector-copy! (unwrap-rect v) 0 bv i 16))
        ((color? v)
         (bytevector-copy! (unwrap-color v) 0 bv i 16)))))
-  #:setter set-gpu-program-uniform:vec4
+  #:setter 'set-gpu-program-uniform:vec4
   #:null (make-null-rect))
 
 (define-shader-primitive-type mat3
@@ -218,7 +218,7 @@
   (let ((matrix3-bv (@@ (chickadee math matrix) matrix3-bv)))
     (lambda (bv i m)
       (bytevector-copy! (matrix3-bv m) 0 bv i (* 3 3 4))))
-  #:setter set-gpu-program-uniform:mat3
+  #:setter 'set-gpu-program-uniform:mat3
   #:null (make-identity-matrix3))
 
 (define-shader-primitive-type mat4
@@ -230,7 +230,7 @@
     (lambda (bv i m)
       ;; 4 rows x 4 columns x 4 bytes per float = 4^3
       (bytevector-copy! (matrix4-bv m) 0 bv i (* 4 4 4))))
-  #:setter set-gpu-program-uniform:mat4
+  #:setter 'set-gpu-program-uniform:mat4
   #:null (make-identity-matrix4))
 
 (define-shader-primitive-type sampler-2d
@@ -240,7 +240,7 @@
   #:serializer
   (lambda (bv i texture-unit)
     (bytevector-s32-native-set! bv i texture-unit))
-  #:setter set-gpu-program-uniform:signed-int
+  #:setter 'set-gpu-program-uniform:signed-int
   #:null 0)
 
 (define-shader-primitive-type sampler-cube
@@ -250,7 +250,7 @@
   #:serializer
   (lambda (bv i texture-unit)
     (bytevector-s32-native-set! bv i texture-unit))
-  #:setter set-gpu-program-uniform:signed-int
+  #:setter 'set-gpu-program-uniform:signed-int
   #:null 0)
 
 
@@ -497,7 +497,7 @@
   (type attribute-type))
 
 (define null-shader
-  (%make-shader gpu-program:null (make-hash-table) (make-hash-table) #f #f))
+  (%make-shader 'gpu-program:null (make-hash-table) (make-hash-table) #f #f))
 
 (define (make-shader vertex-port fragment-port)
   "Read GLSL source from VERTEX-PORT and FRAGMENT-PORT and compile
diff --git a/chickadee/graphics/texture.scm b/chickadee/graphics/texture.scm
index faf9953..112b25f 100644
--- a/chickadee/graphics/texture.scm
+++ b/chickadee/graphics/texture.scm
@@ -113,7 +113,7 @@
             (texture-wrap-t texture))))
 
 (define null-texture
-  (%make-texture gpu-texture:null '2d #f 'linear 'linear 'repeat 'repeat 0 0 0 0
+  (%make-texture 'gpu-texture:null '2d #f 'linear 'linear 'repeat 'repeat 0 0 0 0
                  (make-rect 0.0 0.0 0.0 0.0) (make-rect 0.0 0.0 0.0 0.0)))
 
 (define (texture-null? texture)
diff --git a/chickadee/graphics/viewport.scm b/chickadee/graphics/viewport.scm
index 9d93c0e..dd51b57 100644
--- a/chickadee/graphics/viewport.scm
+++ b/chickadee/graphics/viewport.scm
@@ -63,10 +63,10 @@ viewport with CLEAR-COLOR when clearing the screen.  Clear the buffers
 denoted by the list of symbols in CLEAR-FLAGS.  Possible values for
 CLEAR-FLAGS are 'color-buffer', 'depth-buffer', 'accum-buffer', and
 'stencil-buffer'."
-  (%make-viewport (make-window-rect (assert-non-negative-integer x)
-                                    (assert-non-negative-integer y)
-                                    (assert-non-negative-integer width)
-                                    (assert-non-negative-integer height))
+  (%make-viewport `(make-window-rect ,(assert-non-negative-integer x)
+                                    ,(assert-non-negative-integer y)
+                                    ,(assert-non-negative-integer width)
+                                    ,(assert-non-negative-integer height))
                   clear-color
                   clear-flags))
 
diff --git a/guix.scm b/guix.scm
index 50237e3..b6c44eb 100644
--- a/guix.scm
+++ b/guix.scm
@@ -60,7 +60,7 @@
 (define target-guile guile-3.0-latest)
 
 (define guile-sdl2
-  (let ((commit "e9a7f5e748719ce5b6ccd08ff91861b578034ea6"))
+  (let ((commit "b4f168ee72fecd8cc97d87ee032ea47283585f46"))
     (package
       (name "guile-sdl2")
       (version (string-append "0.7.0-1." (string-take commit 7)))
@@ -71,7 +71,7 @@
                       (commit commit)))
                 (sha256
                  (base32
-                  "0ay7mcar8zs0j5rihwlzi0l46vgg9i93piip4v8a3dzwjx3myr7v"))))
+                  "07rl7ll03wh6n6yshlcw6l6hz73iwwai3r6xhvmnywpx8wpkxfhv"))))
       (build-system gnu-build-system)
       (arguments
        '(#:make-flags '("GUILE_AUTO_COMPILE=0")))