webgpu wip stuffwip-gpu

5 files changed, 409 insertions, 182 deletions

diff --git a/Makefile.am b/Makefile.am
index b6d4ab2..947b7e8 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -48,6 +48,7 @@ SOURCES = 					\
   chickadee/data/heap.scm			\
   chickadee/data/array-list.scm			\
   chickadee/data/queue.scm			\
+  chickadee/data/concurrent-queue.scm		\
   chickadee/data/quadtree.scm			\
   chickadee/data/grid.scm			\
   chickadee/data/path-finding.scm		\
@@ -67,6 +68,7 @@ SOURCES = 					\
   chickadee/image/jpeg.scm			\
   chickadee/image/png.scm			\
   chickadee/graphics/gpu.scm			\
+  chickadee/graphics/backend/opengl.scm		\
   chickadee/graphics/engine.scm			\
   chickadee/graphics/color.scm			\
   chickadee/graphics/buffer.scm			\
diff --git a/TODO.org b/TODO.org
index be19d88..9e1d9ed 100644
--- a/TODO.org
+++ b/TODO.org
@@ -32,10 +32,10 @@ whatever graphics API makes the most sense.
 
 Some big subtasks here:
 - [X] Decouple OpenGL state management from dynamic render context
-- [ ] Refactor all OpenGL calls into a single module
-- [ ] Add generic WebGPU-like graphics API
-- [ ] Implement that API for OpenGL backend
-- [ ] Update all graphics modules to use new API
+- [X] Refactor all OpenGL calls into a single module
+- [ ] Implement WebGPU-like graphics API
+- [ ] Update all graphics code to use the new API
+- [ ] Factor out OpenGL code into OpenGL backend
 
 One big caveat is that our shading language will still be GLSL at the
 end of this, which prevents us from being truly generic.  The Seagull
@@ -45,8 +45,15 @@ whichever shader language our backend uses.
 See this for how Trial does graphics pipelines:
 https://reader.tymoon.eu/article/363
 ** TODO [#A] Move game logic to its own thread
-The main thread should be reserved for running the game loop,
-processing the input queue, and processing the render queue.
+The main thread:
+- Flush render queue
+- Flush SDL input events and forward them to input queue
+- Launch game loop thread
+
+The game loop thread:
+- Flush input queue
+- Run input, update, draw event handlers
+
 ** TODO [#A] Switch from OpenAL to SDL2 audio
 I've decided that OpenAL is too high level to be a library that
 Chickadee should rely upon, since part of the goal of Chickadee is to
diff --git a/chickadee.scm b/chickadee.scm
index 8343a6b..289bc4d 100644
--- a/chickadee.scm
+++ b/chickadee.scm
@@ -313,7 +313,10 @@ border is disabled, otherwise it is enabled.")
                               (orthographic-projection 0 window-width
                                                        window-height 0
                                                        0 1)))
-         (gpu (make-gpu (unwrap-window window) (window-gl-context window))))
+         (adapter (make-gpu-adapter))
+         (device (gpu-adapter-request-device adapter
+                                             (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.
@@ -421,7 +424,7 @@ border is disabled, otherwise it is enabled.")
     ;; This is where all user code is executed.
     (define (game-loop)
       (parameterize ((current-window window)
-                     (current-gpu gpu))
+                     (current-gpu-device device))
         (run-game* #:init load
                    #:update update
                    #:render draw
@@ -442,10 +445,10 @@ border is disabled, otherwise it is enabled.")
       ;;   (clear-viewport)
       ;;   (with-graphics-state ((projection (vector-ref default-projection 0)))
       ;;     (draw alpha)))
-      (gpu-tick gpu)
-      (gpu-swap gpu)
+      (gpu-device-tick device)
+      (gpu-device-swap device)
       ;; Free any GPU resources that have been GC'd.
-      (gpu-gc gpu)
+      (gpu-device-gc device)
       (usleep 1) ; don't use 100% of the cpu pls
       (main-loop))
     ;; Attempt to activate vsync, if possible.  Some systems do
diff --git a/chickadee/graphics/backend/opengl.scm b/chickadee/graphics/backend/opengl.scm
index ab797a7..bb333a0 100644
--- a/chickadee/graphics/backend/opengl.scm
+++ b/chickadee/graphics/backend/opengl.scm
@@ -874,7 +874,7 @@ object.")
   (gl-state-make-current! state)
   (gl-delete-program (gl-program-id program)))
 
-(define-gpu-backend opengl
+(define-gpu-device-backend opengl
   make-gl-state
   #:tick gl-state-tick
   #:swap gl-state-swap
diff --git a/chickadee/graphics/gpu.scm b/chickadee/graphics/gpu.scm
index ab9bb89..ab007f9 100644
--- a/chickadee/graphics/gpu.scm
+++ b/chickadee/graphics/gpu.scm
@@ -21,30 +21,51 @@
 
 (define-module (chickadee graphics gpu)
   #:use-module (chickadee graphics color)
+  #:use-module (chickadee math vector)
   #: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 (srfi srfi-9 gnu)
-  #:export (make-gpu
-            gpu-tick
-            gpu-swap
-            gpu-gc
-            gpu-submit
-            current-gpu
-            define-gpu-backend
+  #:export (gpu-preferred-canvas-format
+            gpu-shader-language-features
+
+            make-gpu-adapter
+            gpu-adapter?
+            gpu-adapter-supported-features
+            gpu-adapter-supported-limits
+            gpu-adapter-fallback?
+            gpu-adapter-info
+            gpu-adapter-request-device
+
+            make-gpu-device
+            gpu-device-tick
+            gpu-device-swap
+            gpu-device-gc
+            gpu-device-submit
+            current-gpu-device
+            define-gpu-device-backend
 
             make-buffer
             buffer?
             buffer-available?
             buffer-destroyed?
             buffer-mapped?
+            buffer-size
+            buffer-usage
             buffer-destroy!
+            buffer-write!
             buffer-map!
             buffer-unmap!
             bytevector->buffer
 
+            make-extent-3d
+            extent-3d?
+            extent-3d-width
+            extent-3d-height
+            extent-3d-depth
+
             make-texture
             texture-destroy!
             texture?
@@ -53,7 +74,7 @@
             texture-destroyed?
             texture-width
             texture-height
-            texture-layers
+            texture-depth
             texture-mip-level-count
             texture-sample-count
             texture-dimension
@@ -89,10 +110,56 @@
             sampler-min-filter
             sampler-mipmap-filter
 
+            make-buffer-binding-layout
+            buffer-binding-layout?
+            buffer-binding-layout-type
+            buffer-binding-layout-dynamic-offset?
+            buffer-binding-layout-min-binding-size
+
+            make-texture-binding-layout
+            texture-binding-layout?
+            texture-binding-layout-sample-type
+            texture-binding-layout-view-dimension
+            texture-binding-layout-multisampled?
+
+            make-storage-texture-binding-layout
+            storage-texture-binding-layout?
+            storage-texture-binding-layout-access
+            storage-texture-binding-layout-format
+            storage-texture-binding-layout-view-dimension
+
+            make-external-texture-binding-layout
+            external-texture-binding-layout?
+
+            make-bind-group-layout-entry
+            bind-group-layout-entry-binding
+            bind-group-layout-entry-visibility
+            bind-group-layout-entry-layout
+
+            make-bind-group-layout
+            bind-group-layout?
+            bind-group-layout-entries
+
+            make-bind-group-entry
+            bind-group-entry?
+            bind-group-entry-binding
+            bind-group-entry-resource
+
+            make-bind-group
+            bind-group?
+            bind-group-layout
+            bind-group-entries
+
+            make-pipeline-layout
+            pipeline-layout?
+            pipeline-layout-device
+            pipeline-layout-bind-group-layouts
+
             make-shader-module
             shader-module?
             shader-module-vertex
             shader-module-fragment
+            shader-module-destroyed?
 
             make-vertex-attribute
             vertex-attribute?
@@ -230,10 +297,17 @@
 
 
 ;;;
-;;; Generic GPU
+;;; Device Queue
 ;;;
 
-(define-syntax-rule (define-gpu-type name make pred
+
+
+
+;;;
+;;; Device
+;;;
+
+(define-syntax-rule (define-gpu-device-type name make pred
                       (mutex mutex-accessor)
                       (guardian guardian-accessor)
                       (internal internal-accessor)
@@ -250,109 +324,99 @@
       (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)
+    (define (vfield-dispatch gpu-device vfield-dispatch-args ...)
+      (with-mutex (mutex-accessor gpu-device)
+        ((vfield-accessor gpu-device)
+         (internal-accessor gpu-device)
          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
+(define-gpu-device-type <gpu-device>
+  %make-gpu-device
+  gpu-device?
+  (mutex gpu-device-mutex)
+  (guardian gpu-device-guardian)
+  (internal gpu-device-internal)
+  (tick %gpu-device-tick (gpu-device-tick))
+  (swap %gpu-device-swap (gpu-device-swap))
+  (enqueue %gpu-device-enqueue (backend:enqueue command-buffer))
+  (make-buffer %gpu-device-make-buffer
                (backend:make-buffer length usage))
-  (buffer-destroy %gpu-buffer-destroy
+  (buffer-destroy %gpu-device-buffer-destroy
                   (backend:buffer-destroy buffer))
-  (buffer-map %gpu-buffer-map
+  (buffer-map %gpu-device-buffer-map
               (backend:buffer-map buffer mode offset sizes))
-  (buffer-unmap %gpu-buffer-unmap
+  (buffer-unmap %gpu-device-buffer-unmap
                 (backend:buffer-unmap buffer))
-  (buffer-write %gpu-buffer-write
+  (buffer-write %gpu-device-buffer-write
                 (backend:buffer-write buffer buffer-offset data data-offset
                                       length))
-  (make-texture %gpu-make-texture
+  (make-texture %gpu-device-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
+  (texture-destroy %gpu-device-texture-destroy (backend:texture-destroy texture))
+  (make-texture-view %gpu-device-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
+  (texture-view-destroy %gpu-device-texture-view-destroy
                         (backend:texture-view-destroy view))
-  (make-sampler %gpu-make-sampler
+  (make-sampler %gpu-device-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
+  (sampler-destroy %gpu-device-sampler-destroy (backend:sampler-destroy module))
+  (make-shader-module %gpu-device-make-shader-module
                       (backend:make-shader-module vertex-source fragment-source))
-  (shader-module-destroy %gpu-shader-module-destroy
+  (shader-module-destroy %gpu-device-shader-module-destroy
                          (backend:shader-module-destroy module))
-  (make-render-pipeline %gpu-make-render-pipeline
+  (make-render-pipeline %gpu-device-make-render-pipeline
                         (backend:make-render-pipeline vertex fragment
                                                       primitive depth-stencil
                                                       multisample))
-  (render-pipeline-destroy %gpu-render-pipeline-destroy
+  (render-pipeline-destroy %gpu-device-render-pipeline-destroy
                            (backend:render-pipeline-destroy pipeline)))
 
-(define (gpu-guard! gpu obj)
-  ((gpu-guardian gpu) obj))
+(define (gpu-device-guard! gpu-device obj)
+  ((gpu-device-guardian gpu-device) obj))
 
-(define *gpu-backends* (make-hash-table))
+(define *gpu-device-backends* (make-hash-table))
 
-(define (gpu-backend-ref name)
-  (hashq-ref *gpu-backends* name))
+(define (gpu-device-backend-ref name)
+  (hashq-ref *gpu-device-backends* name))
 
-(define (gpu-backend-set! name proc)
-  (hashq-set! *gpu-backends* name proc))
+(define (gpu-device-backend-set! name proc)
+  (hashq-set! *gpu-device-backends* name proc))
 
-(define-syntax-rule (define-gpu-backend name
+(define-syntax-rule (define-gpu-device-backend name
                       internal-constructor
                       args ...)
-  (gpu-backend-set! 'name
-                    (lambda (window context)
-                      (%make-gpu (internal-constructor window context)
-                                 args ...))))
+  (gpu-device-backend-set! 'name
+                           (lambda (window context)
+                             (%make-gpu-device (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))
+(define current-gpu-device (make-parameter #f))
 
 
 ;;;
 ;;; Buffers
 ;;;
 
+;; (define-record-type* <buffer-descriptor>
+;;   make-buffer-descriptor
+;;   buffer-descriptor?
+;;   (label buffer-descriptor-label "")
+;;   (size buffer-descriptor-size #f)
+;;   (mapped-at-creation? buffer-descriptor-mapped-at-creation? #f))
+
 (define-record-type <buffer>
-  (%make-buffer gpu handle length usage state map-state)
+  (%make-buffer device handle size usage state map-state)
   buffer?
-  (gpu buffer-gpu)
+  (device buffer-device)
   (handle buffer-handle)
-  (length buffer-length)
+  (size buffer-size)
   (usage buffer-usage)
   (state buffer-state set-buffer-state!)
   (map-state buffer-map-state set-buffer-map-state!)
@@ -377,29 +441,37 @@
 
 ;; 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)))
+(define* (make-buffer device length #:optional (usage '(vertex)))
+  (let ((handle (backend:make-buffer device length usage)))
+    (%make-buffer device 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))
+    (backend:buffer-destroy (buffer-device buffer)
+                            (buffer-handle buffer))
     (set-buffer-state! buffer 'destroyed)))
 
+(define (buffer-write! buffer at data start size)
+  (backend:buffer-write (buffer-device buffer)
+                        (buffer-handle buffer)
+                        0 data 0 size))
+
 (define (buffer-map! buffer mode offset size)
-  (backend:buffer-map (buffer-gpu buffer) (buffer-handle buffer)
+  (backend:buffer-map (buffer-device buffer)
+                      (buffer-handle buffer)
                       mode offset size))
 
 (define (buffer-unmap! buffer)
   (when (buffer-mapped? buffer)
-    (backend:buffer-unmap (buffer-gpu buffer) (buffer-handle buffer))
+    (backend:buffer-unmap (buffer-device 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))
+(define* (bytevector->buffer gpu data #:optional (usage '(vertex)))
+  (let* ((size (bytevector-length data))
+         (buffer (make-buffer gpu size usage)))
+    (buffer-write! buffer 0 data 0 size)
     buffer))
 
 
@@ -407,16 +479,23 @@
 ;;; Textures
 ;;;
 
+(define-record-type* <extent-3d>
+  make-extent-3d
+  extent-3d?
+  (width extent-3d-width #f)
+  (height extent-3d-height 1)
+  (depth extent-3d-depth 1))
+
 (define-record-type <texture>
-  (%make-texture gpu handle destroyed? width height layers mip-level-count
+  (%make-texture device handle destroyed? width height depth mip-level-count
                  sample-count dimension format usage view-formats)
   texture?
-  (gpu texture-gpu)
+  (device texture-device)
   (handle texture-handle)
   (destroyed? texture-destroyed? set-texture-destroyed!)
   (width texture-width)
   (height texture-height)
-  (layers texture-layers)
+  (depth texture-depth)
   (mip-level-count texture-mip-level-count)
   (sample-count texture-sample-count)
   (dimension texture-dimension)
@@ -426,43 +505,63 @@
 
 (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))))
+    (($ <texture> _ handle _ width height depth _ _ dimension format* usage)
+     (format #t "#<texture handle: ~a width: ~a height: ~a depth: ~a dimension: ~a format: ~a usage: ~a>"
+             handle width height depth dimension format* usage))))
 
 (set-record-type-printer! <texture> print-texture)
 
-(define* (make-texture gpu #:key
-                       (width 1)
-                       (height 1)
-                       (layers 0)
+(define* (make-texture device #:key
+                       (size (make-extent-3d #:width 1))
                        (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)))
+  (match size
+    (($ <extent-3d> width height depth)
+     (let ((handle (backend:make-texture device width height depth mip-level-count
+                                         sample-count dimension format usage
+                                         view-formats)))
+       (%make-texture device handle #f width height depth 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))
+    (backend:texture-destroy (texture-device texture)
+                             (texture-handle texture))
     (set-texture-destroyed! texture #t)))
 
+(define-record-type* <image-data-layout>
+  make-image-data-layout
+  image-data-layout?
+  (offset image-data-layout-offset 0)
+  (bytes-per-row image-data-layout-bytes-per-row #f)
+  (rows-per-image image-data-layout-rows-per-image #f))
+
+(define-record-type* <image-copy-texture>
+  make-image-copy-texture
+  image-copy-texture?
+  (texture image-copy-texture-texture #f)
+  (mip-level image-copy-texture-mip-level 0)
+  (origin image-copy-texture-origin (vec3 0.0 0.0 0.0))
+  ;; all, depth-only, or stencil-only
+  (aspect image-copy-texture-aspect 'all))
+
+(define (texture-write! destination data data-layout size)
+  #t)
+
 (define-record-type <texture-view>
-  (%make-texture-view gpu handle destroyed? texture format dimension aspect
+  (%make-texture-view device handle destroyed? texture format dimension aspect
                       base-mip-level mip-level-count base-layer layer-count)
   texture-view?
-  (gpu texture-view-gpu)
+  (device texture-view-device)
   (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
+  (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)
@@ -476,7 +575,7 @@
 
 (set-record-type-printer! <texture-view> print-texture-view)
 
-(define* (make-texture-view gpu texture #:key
+(define* (make-texture-view device texture #:key
                             format
                             (dimension '2d)
                             (aspect 'all)
@@ -484,25 +583,25 @@
                             (mip-level-count 0)
                             (base-layer 0)
                             (layer-count 0))
-  (let ((handle (backend:make-texture-view gpu texture format dimension aspect
+  (let ((handle (backend:make-texture-view device texture format dimension aspect
                                            base-mip-level mip-level-count
                                            base-layer layer-count)))
-    (%make-texture-view gpu handle #f texture format dimension aspect
+    (%make-texture-view device 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)
+    (backend:texture-view-destroy (texture-view-device view)
                                   (texture-view-handle view))
     (set-texture-view-destroyed! view #t)))
 
 ;; TODO: lod, compare, anisotropy.
 (define-record-type <sampler>
-  (%make-sampler gpu handle destroyed?
+  (%make-sampler device handle destroyed?
                  address-mode-u address-mode-v address-mode-w
                  mag-filter min-filter mipmap-filter)
   sampler?
-  (gpu sampler-gpu)
+  (device sampler-device)
   (handle sampler-handle)
   (destroyed? sampler-destroyed? set-sampler-destroyed!)
   ;; clamp-to-edge, repeat, or mirror-repeat
@@ -522,34 +621,132 @@
 
 (set-record-type-printer! <sampler> print-sampler)
 
-(define* (make-sampler gpu #:key
+(define* (make-sampler device #: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
+  (let ((handle (backend:make-sampler device 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
+    (%make-sampler device 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))
+    (backend:sampler-destroy (sampler-device sampler)
+                             (sampler-handle sampler))
     (set-sampler-destroyed! sampler #t)))
 
 
 ;;;
+;;; Bind groups
+;;;
+
+(define-record-type* <buffer-binding-layout>
+  make-buffer-binding-layout
+  buffer-binding-layout?
+  ;; uniform, storage, or read-only-storage
+  (type buffer-binding-layout-type 'uniform)
+  (dynamic-offset? buffer-binding-layout-dynamic-offset? #f)
+  (min-binding-size buffer-binding-layout-min-binding-size 0))
+
+(define-record-type* <texture-binding-layout>
+  make-texture-binding-layout
+  texture-binding-layout?
+  ;; float, unfilterable-float, depth, sint, or uint
+  (sample-type texture-binding-layout-sample-type 'float)
+  ;; 2d or 3d
+  (view-dimension texture-binding-layout-view-dimension '2d)
+  (multisampled? texture-binding-layout-multisampled? #f))
+
+(define-record-type* <storage-texture-binding-layout>
+  make-storage-texture-binding-layout
+  storage-texture-binding-layout?
+  ;; write-only, read-only, or read-write
+  (access storage-texture-binding-layout-access 'write-only)
+  (format storage-texture-binding-layout-format #f)
+  ;; 2d or 3d
+  (view-dimension storage-texture-binding-layout-view-dimension '2d))
+
+(define-record-type* <external-texture-binding-layout>
+  make-external-texture-binding-layout
+  external-texture-binding-layout?)
+
+(define-record-type* <bind-group-layout-entry>
+  make-bind-group-layout-entry
+  bind-group-layout-entry?
+  (binding bind-group-layout-entry-binding (error "binding required"))
+  ;; A list of flags: vertex, fragment, compute
+  (visibility bind-group-layout-entry-visibility (error "visibility required"))
+  ;; Not following the spec here which has separate object keys for
+  ;; buffer, sampler, texture, storage texture, and external texture.
+  (layout bind-group-layout-entry-layout #f))
+
+(define-record-type <bind-group-layout>
+  (%make-bind-group-layout entries entry-map dynamic-offset-count exclusive-pipeline)
+  bind-group-layout?
+  (entries bind-group-layout-entries)
+  (entry-map bind-group-layout-entry-map)
+  (dynamic-offset-count bind-group-layout-dynamic-offset-count)
+  (exclusive-pipeline bind-group-layout-exclusive-pipeline))
+
+(define (make-bind-group-layout device entries)
+  (let ((entry-map
+         (map (match-lambda
+                ((and layout ($ <bind-group-layout-entry> binding))
+                 (cons binding layout)))
+              entries))
+        (dynamic-offset-count
+         (fold (lambda (entry sum)
+                 (match entry
+                   (($ <bind-group-layout-entry> _ _
+                       ($ <buffer-binding-layout> _ #t))
+                    (+ sum 1))
+                   (_ sum)))
+               0
+               entries)))
+    (%make-bind-group-layout entries entry-map dynamic-offset-count #f)))
+
+(define-record-type* <bind-group-entry>
+  make-bind-group-entry
+  bind-group-entry?
+  (binding bind-group-entry-binding #f)
+  (resource bind-group-entry-resource #f))
+
+(define-record-type <bind-group>
+  (%make-bind-group device layout entries used-resources)
+  bind-group?
+  (device bind-group-device)
+  (layout bind-group-layout)
+  (entries bind-group-entries)
+  (used-resources bind-group-used-resources))
+
+(define* (make-bind-group device #:key layout (entries '()))
+  ;; TODO: compute used resources.
+  (%make-bind-group device layout entries #f))
+
+(define-record-type <pipeline-layout>
+  (%make-pipeline-layout device bind-group-layouts)
+  pipeline-layout?
+  (device pipeline-layout-device)
+  (bind-group-layouts pipeline-layout-bind-group-layouts))
+
+(define (make-pipeline-layout device bind-group-layouts)
+  (%make-pipeline-layout device bind-group-layouts))
+
+
+;;;
 ;;; Shader modules
 ;;;
 
 (define-record-type <shader-module>
-  (%make-shader-module gpu handle state)
+  (%make-shader-module device handle state)
   shader-module?
-  (gpu shader-module-gpu)
+  (device shader-module-device)
   (handle shader-module-handle)
   (state shader-module-state set-shader-module-state!))
 
@@ -572,7 +769,7 @@
 
 (define (shader-module-destroy! module)
   (unless (shader-module-destroyed? module)
-    (backend:shader-module-destroy (shader-module-gpu module)
+    (backend:shader-module-destroy (shader-module-device module)
                                    (shader-module-handle module))
     (set-shader-module-state! module 'destroyed)))
 
@@ -714,56 +911,6 @@
   (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
@@ -854,18 +1001,18 @@
                                 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)))
+(define (gpu-device-submit device command-buffer)
+  (with-mutex (gpu-device-mutex device)
+    (backend:enqueue device command-buffer)))
 
 
 ;;;
 ;;; Garbage collection
 ;;;
 
-(define (gpu-gc gpu)
-  (with-mutex (gpu-mutex gpu)
-    (let ((guardian (gpu-guardian gpu)))
+(define (gpu-device-gc device)
+  (with-mutex (gpu-device-mutex device)
+    (let ((guardian (gpu-device-guardian device)))
       (let loop ()
         (let ((obj (guardian)))
           (when obj
@@ -874,3 +1021,71 @@
               ((? texture? texture) (texture-destroy! texture))
               ((? shader-module? module) (shader-module-destroy! module)))
             (loop)))))))
+
+
+;;;
+;;; Adapter
+;;;
+
+(define (gpu-adapter-supported-features adapter)
+  (error "unimplemented"))
+
+(define (gpu-adapter-supported-limits adapter)
+  (error "unimplemented"))
+
+(define (gpu-adapter-fallback? adapter)
+  (error "unimplemented"))
+
+;; requestAdapterInfo
+(define (gpu-adapter-info adapter)
+  (error "unimplemented"))
+
+;; Feature names:
+;; depth-clip-control
+;; depth32float-stencil8
+;; texture-compression-bc
+;; texture-compression-etc2
+;; texture-compression-astc
+;; timestamp-query
+;; indirect-first-instance
+;; shader-f16
+;; rg11b10ufloat-renderable
+;; bgra8unorm-storage
+;; float32-filterable
+(define* (gpu-adapter-request-device adapter window context #:key
+                                     (required-features '())
+                                     (required-limits '())
+                                     default-queue)
+  ;; 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-device-backend-ref 'opengl) window context))
+
+
+;;;
+;;; GPU
+;;;
+
+(define-record-type <gpu-adapter>
+  (%make-gpu-adapter power-preference force-fallback?)
+  gpu-adapter?
+  (power-preference gpu-adapter-power-preference)
+  (force-fallback? gpu-adapter-force-fallback?))
+
+;; navigator.gpu.requestAdapter
+;;
+;; Power preference can either be low-power or high-performance
+(define* (make-gpu-adapter #:key power-preference force-fallback?)
+  (%make-gpu-adapter power-preference force-fallback?))
+
+(define (gpu-preferred-canvas-format)
+  (error "unimplemented"))
+
+;; Avoiding the official name with "wgsl" in it because Chickadee has
+;; its own shader language and does not expose WGSL at all.
+(define (gpu-shader-language-features)
+  (error "unimplemented"))