diff --git a/bot/Makefile b/bot/Makefile
new file mode 100644
index 0000000..1372735
--- /dev/null
+++ b/bot/Makefile
@@ -0,0 +1,12 @@
+# See https://gitlab.com/preserves/preserves/-/issues/39
+WORKAROUND_PRESERVES_ISSUE_39=--base `realpath ../protocols/schemas`/
+
+schemas:
+	preserves-schema-rkt \
+		--output schemas \
+		$(WORKAROUND_PRESERVES_ISSUE_39) \
+		--module noise=:syndicate/schemas/noise \
+		../protocols/schemas/**.prs
+
+clean:
+	rm -rf schemas/
diff --git a/bot/bot.rkt b/bot/bot.rkt
new file mode 100644
index 0000000..db10331
--- /dev/null
+++ b/bot/bot.rkt
@@ -0,0 +1,43 @@
+#lang syndicate
+
+(module+ main
+  (require syndicate/distributed/tcp)
+  (require syndicate/drivers/timer)
+  (require syndicate/gensym)
+  (require racket/math)
+
+  (require "schemas/scene.rkt")
+  (require "schemas/shapes.rkt")
+
+  (assertion-struct SceneHandle (ds))
+
+  (standard-actor-system (ds)
+    (define (on-connected remote-ds)
+      (at remote-ds
+        (during (SceneHandle $scene-e)
+          (define scene (embedded-value scene-e))
+
+          (define (bouncy-box)
+            (define me (symbol->string (strong-gensym 'user)))
+            (define start-time (current-inexact-milliseconds))
+            (define-field deadline start-time)
+            (define-field x (* (- (random) 0.5) 100))
+            (define y0 (+ 1.0 (* (random) 10)))
+            (define-field y y0)
+            (define-field z (* (- (random) 0.5) 100))
+            (at ds
+              (on (asserted (LaterThan (deadline)))
+                (deadline (+ (deadline) (/ 1000 10)))
+                (y (+ y0 (cos (/ (- (deadline) start-time) 1000.0 (/ 1 2 pi)))))))
+            (define r (random))
+            (define g (random))
+            (define b (random))
+            (at scene
+              (assert (Sprite me (Move (Vector3 (x) (y) (z))
+                                       (Color-opaque r g b (Box)))))
+              ))
+
+          (for [(i 100)] (bouncy-box)))))
+
+    (run-tcp-client-relay ds #:hostname "vr.demo.leastfixedpoint.com" #:port 9001
+                          #:import (lambda (v) (on-connected (embedded-value v))))))
diff --git a/bot/schemas/scene.rkt b/bot/schemas/scene.rkt
new file mode 100644
index 0000000..0ef34da
--- /dev/null
+++ b/bot/schemas/scene.rkt
@@ -0,0 +1,148 @@
+(module scene racket/base
+  (provide (except-out (all-defined-out) :decode-embedded :encode-embedded)
+           (rename-out
+            (:decode-embedded decode-embedded:scene)
+            (:encode-embedded encode-embedded:scene)))
+  (require preserves)
+  (require preserves-schema/methods)
+  (require preserves-schema/support)
+  (require racket/match)
+  (require racket/set)
+  (require racket/dict)
+  (require (only-in racket/generic define/generic))
+  (require (prefix-in noise: syndicate/schemas/noise))
+  (require (prefix-in shapes: "shapes.rkt"))
+  (define :decode-embedded values)
+  (define :encode-embedded values)
+  (struct
+   AmbientSound
+   (name spec)
+   #:transparent
+   #:methods
+   gen:preservable
+   ((define/generic *->preserve ->preserve)
+    (define (->preserve preservable)
+      (match
+       preservable
+       ((AmbientSound ?name ?spec)
+        (record
+         'ambient-sound
+         (list (*->preserve ?name) (*->preserve ?spec))))))))
+  (define (parse-AmbientSound input)
+    (match
+     input
+     ((and dest
+           (record
+            'ambient-sound
+            (list
+             (and ?name (? string?))
+             (app shapes:parse-SoundSpec (and ?spec (not (== eof)))))))
+      (AmbientSound ?name ?spec))
+     (_ eof)))
+  (define parse-AmbientSound!
+    (parse-success-or-error 'parse-AmbientSound parse-AmbientSound))
+  (struct
+   Gravity
+   (direction)
+   #:transparent
+   #:methods
+   gen:preservable
+   ((define/generic *->preserve ->preserve)
+    (define (->preserve preservable)
+      (match
+       preservable
+       ((Gravity ?direction)
+        (record 'gravity (list (*->preserve ?direction))))))))
+  (define (parse-Gravity input)
+    (match
+     input
+     ((and dest
+           (record
+            'gravity
+            (list (app shapes:parse-Vector3 (and ?direction (not (== eof)))))))
+      (Gravity ?direction))
+     (_ eof)))
+  (define parse-Gravity! (parse-success-or-error 'parse-Gravity parse-Gravity))
+  (struct
+   Portal
+   (name destination position)
+   #:transparent
+   #:methods
+   gen:preservable
+   ((define/generic *->preserve ->preserve)
+    (define (->preserve preservable)
+      (match
+       preservable
+       ((Portal ?name ?destination ?position)
+        (record
+         'portal
+         (list
+          (*->preserve ?name)
+          (*->preserve ?destination)
+          (*->preserve ?position))))))))
+  (define (parse-Portal input)
+    (match
+     input
+     ((and dest
+           (record
+            'portal
+            (list
+             (and ?name (? string?))
+             (app parse-PortalDestination (and ?destination (not (== eof))))
+             (app shapes:parse-Vector3 (and ?position (not (== eof)))))))
+      (Portal ?name ?destination ?position))
+     (_ eof)))
+  (define parse-Portal! (parse-success-or-error 'parse-Portal parse-Portal))
+  (define (PortalDestination? p)
+    (or (PortalDestination-local? p) (PortalDestination-remote? p)))
+  (struct
+   PortalDestination-local
+   (value)
+   #:transparent
+   #:methods
+   gen:preservable
+   ((define/generic *->preserve ->preserve)
+    (define (->preserve preservable)
+      (match preservable ((PortalDestination-local src) (embedded src))))))
+  (struct
+   PortalDestination-remote
+   (value)
+   #:transparent
+   #:methods
+   gen:preservable
+   ((define/generic *->preserve ->preserve)
+    (define (->preserve preservable)
+      (match preservable ((PortalDestination-remote src) (*->preserve src))))))
+  (define (parse-PortalDestination input)
+    (match
+     input
+     ((embedded dest) (PortalDestination-local dest))
+     ((app noise:parse-Route (and dest (not (== eof))))
+      (PortalDestination-remote dest))
+     (_ eof)))
+  (define parse-PortalDestination!
+    (parse-success-or-error 'parse-PortalDestination parse-PortalDestination))
+  (struct
+   Touch
+   (subject object)
+   #:transparent
+   #:methods
+   gen:preservable
+   ((define/generic *->preserve ->preserve)
+    (define (->preserve preservable)
+      (match
+       preservable
+       ((Touch ?subject ?object)
+        (record
+         'touch
+         (list (*->preserve ?subject) (*->preserve ?object))))))))
+  (define (parse-Touch input)
+    (match
+     input
+     ((and dest
+           (record
+            'touch
+            (list (and ?subject (? string?)) (and ?object (? string?)))))
+      (Touch ?subject ?object))
+     (_ eof)))
+  (define parse-Touch! (parse-success-or-error 'parse-Touch parse-Touch)))
diff --git a/bot/schemas/shapes.rkt b/bot/schemas/shapes.rkt
new file mode 100644
index 0000000..a1d87e4
--- /dev/null
+++ b/bot/schemas/shapes.rkt
@@ -0,0 +1,1061 @@
+(module shapes racket/base
+  (provide (except-out (all-defined-out) :decode-embedded :encode-embedded)
+           (rename-out
+            (:decode-embedded decode-embedded:shapes)
+            (:encode-embedded encode-embedded:shapes)))
+  (require preserves)
+  (require preserves-schema/methods)
+  (require preserves-schema/support)
+  (require racket/match)
+  (require racket/set)
+  (require racket/dict)
+  (require (only-in racket/generic define/generic))
+  (define :decode-embedded values)
+  (define :encode-embedded values)
+  (struct
+   Box
+   ()
+   #:transparent
+   #:methods
+   gen:preservable
+   ((define/generic *->preserve ->preserve)
+    (define (->preserve preservable)
+      (match preservable ((Box) (record 'box (list)))))))
+  (define (parse-Box input)
+    (match input ((and dest (record 'box (list))) (Box)) (_ eof)))
+  (define parse-Box! (parse-success-or-error 'parse-Box parse-Box))
+  (struct
+   CSG
+   (expr)
+   #:transparent
+   #:methods
+   gen:preservable
+   ((define/generic *->preserve ->preserve)
+    (define (->preserve preservable)
+      (match
+       preservable
+       ((CSG ?expr) (record 'csg (list (*->preserve ?expr))))))))
+  (define (parse-CSG input)
+    (match
+     input
+     ((and dest
+           (record 'csg (list (app parse-CSGExpr (and ?expr (not (== eof)))))))
+      (CSG ?expr))
+     (_ eof)))
+  (define parse-CSG! (parse-success-or-error 'parse-CSG parse-CSG))
+  (define (CSGExpr? p)
+    (or (CSGExpr-mesh? p)
+        (CSGExpr-scale? p)
+        (CSGExpr-move? p)
+        (CSGExpr-rotate? p)
+        (CSGExpr-subtract? p)
+        (CSGExpr-union? p)
+        (CSGExpr-intersect? p)
+        (CSGExpr-invert? p)))
+  (struct
+   CSGExpr-mesh
+   (shape)
+   #:transparent
+   #:methods
+   gen:preservable
+   ((define/generic *->preserve ->preserve)
+    (define (->preserve preservable)
+      (match
+       preservable
+       ((CSGExpr-mesh ?shape) (record 'mesh (list (*->preserve ?shape))))))))
+  (struct
+   CSGExpr-scale
+   (v shape)
+   #:transparent
+   #:methods
+   gen:preservable
+   ((define/generic *->preserve ->preserve)
+    (define (->preserve preservable)
+      (match
+       preservable
+       ((CSGExpr-scale ?v ?shape)
+        (record 'scale (list (*->preserve ?v) (*->preserve ?shape))))))))
+  (struct
+   CSGExpr-move
+   (v shape)
+   #:transparent
+   #:methods
+   gen:preservable
+   ((define/generic *->preserve ->preserve)
+    (define (->preserve preservable)
+      (match
+       preservable
+       ((CSGExpr-move ?v ?shape)
+        (record 'move (list (*->preserve ?v) (*->preserve ?shape))))))))
+  (struct
+   CSGExpr-rotate
+   (v shape)
+   #:transparent
+   #:methods
+   gen:preservable
+   ((define/generic *->preserve ->preserve)
+    (define (->preserve preservable)
+      (match
+       preservable
+       ((CSGExpr-rotate ?v ?shape)
+        (record 'rotate (list (*->preserve ?v) (*->preserve ?shape))))))))
+  (struct
+   CSGExpr-subtract
+   (base more)
+   #:transparent
+   #:methods
+   gen:preservable
+   ((define/generic *->preserve ->preserve)
+    (define (->preserve preservable)
+      (match
+       preservable
+       ((CSGExpr-subtract ?base ?more)
+        (record
+         'subtract
+         (list
+          (list*
+           (*->preserve ?base)
+           (for/list ((item (in-list ?more))) (*->preserve item))))))))))
+  (struct
+   CSGExpr-union
+   (base more)
+   #:transparent
+   #:methods
+   gen:preservable
+   ((define/generic *->preserve ->preserve)
+    (define (->preserve preservable)
+      (match
+       preservable
+       ((CSGExpr-union ?base ?more)
+        (record
+         'union
+         (list
+          (list*
+           (*->preserve ?base)
+           (for/list ((item (in-list ?more))) (*->preserve item))))))))))
+  (struct
+   CSGExpr-intersect
+   (base more)
+   #:transparent
+   #:methods
+   gen:preservable
+   ((define/generic *->preserve ->preserve)
+    (define (->preserve preservable)
+      (match
+       preservable
+       ((CSGExpr-intersect ?base ?more)
+        (record
+         'intersect
+         (list
+          (list*
+           (*->preserve ?base)
+           (for/list ((item (in-list ?more))) (*->preserve item))))))))))
+  (struct
+   CSGExpr-invert
+   (shape)
+   #:transparent
+   #:methods
+   gen:preservable
+   ((define/generic *->preserve ->preserve)
+    (define (->preserve preservable)
+      (match
+       preservable
+       ((CSGExpr-invert ?shape)
+        (record 'invert (list (*->preserve ?shape))))))))
+  (define (parse-CSGExpr input)
+    (match
+     input
+     ((and dest
+           (record 'mesh (list (app parse-Mesh (and ?shape (not (== eof)))))))
+      (CSGExpr-mesh ?shape))
+     ((and dest
+           (record
+            'scale
+            (list
+             (app parse-Vector3 (and ?v (not (== eof))))
+             (app parse-CSGExpr (and ?shape (not (== eof)))))))
+      (CSGExpr-scale ?v ?shape))
+     ((and dest
+           (record
+            'move
+            (list
+             (app parse-Vector3 (and ?v (not (== eof))))
+             (app parse-CSGExpr (and ?shape (not (== eof)))))))
+      (CSGExpr-move ?v ?shape))
+     ((and dest
+           (record
+            'rotate
+            (list
+             (app parse-Vector3 (and ?v (not (== eof))))
+             (app parse-CSGExpr (and ?shape (not (== eof)))))))
+      (CSGExpr-rotate ?v ?shape))
+     ((and dest
+           (record
+            'subtract
+            (list
+             (list*
+              (app parse-CSGExpr (and ?base (not (== eof))))
+              (list (app parse-CSGExpr (and ?more (not (== eof)))) ...)))))
+      (CSGExpr-subtract ?base ?more))
+     ((and dest
+           (record
+            'union
+            (list
+             (list*
+              (app parse-CSGExpr (and ?base (not (== eof))))
+              (list (app parse-CSGExpr (and ?more (not (== eof)))) ...)))))
+      (CSGExpr-union ?base ?more))
+     ((and dest
+           (record
+            'intersect
+            (list
+             (list*
+              (app parse-CSGExpr (and ?base (not (== eof))))
+              (list (app parse-CSGExpr (and ?more (not (== eof)))) ...)))))
+      (CSGExpr-intersect ?base ?more))
+     ((and dest
+           (record
+            'invert
+            (list (app parse-CSGExpr (and ?shape (not (== eof)))))))
+      (CSGExpr-invert ?shape))
+     (_ eof)))
+  (define parse-CSGExpr! (parse-success-or-error 'parse-CSGExpr parse-CSGExpr))
+  (define (Color? p) (or (Color-opaque? p) (Color-transparent? p)))
+  (struct
+   Color-opaque
+   (r g b shape)
+   #:transparent
+   #:methods
+   gen:preservable
+   ((define/generic *->preserve ->preserve)
+    (define (->preserve preservable)
+      (match
+       preservable
+       ((Color-opaque ?r ?g ?b ?shape)
+        (record
+         'color
+         (list
+          (exact->inexact (*->preserve ?r))
+          (exact->inexact (*->preserve ?g))
+          (exact->inexact (*->preserve ?b))
+          (*->preserve ?shape))))))))
+  (struct
+   Color-transparent
+   (r g b alpha shape)
+   #:transparent
+   #:methods
+   gen:preservable
+   ((define/generic *->preserve ->preserve)
+    (define (->preserve preservable)
+      (match
+       preservable
+       ((Color-transparent ?r ?g ?b ?alpha ?shape)
+        (record
+         'color
+         (list
+          (exact->inexact (*->preserve ?r))
+          (exact->inexact (*->preserve ?g))
+          (exact->inexact (*->preserve ?b))
+          (exact->inexact (*->preserve ?alpha))
+          (*->preserve ?shape))))))))
+  (define (parse-Color input)
+    (match
+     input
+     ((and dest
+           (record
+            'color
+            (list
+             (and ?r (? flonum?))
+             (and ?g (? flonum?))
+             (and ?b (? flonum?))
+             (app parse-Shape (and ?shape (not (== eof)))))))
+      (Color-opaque ?r ?g ?b ?shape))
+     ((and dest
+           (record
+            'color
+            (list
+             (and ?r (? flonum?))
+             (and ?g (? flonum?))
+             (and ?b (? flonum?))
+             (and ?alpha (? flonum?))
+             (app parse-Shape (and ?shape (not (== eof)))))))
+      (Color-transparent ?r ?g ?b ?alpha ?shape))
+     (_ eof)))
+  (define parse-Color! (parse-success-or-error 'parse-Color parse-Color))
+  (struct
+   External
+   (path)
+   #:transparent
+   #:methods
+   gen:preservable
+   ((define/generic *->preserve ->preserve)
+    (define (->preserve preservable)
+      (match
+       preservable
+       ((External ?path) (record 'external (list (*->preserve ?path))))))))
+  (define (parse-External input)
+    (match
+     input
+     ((and dest (record 'external (list (and ?path (? string?)))))
+      (External ?path))
+     (_ eof)))
+  (define parse-External!
+    (parse-success-or-error 'parse-External parse-External))
+  (struct
+   Floor
+   (shape)
+   #:transparent
+   #:methods
+   gen:preservable
+   ((define/generic *->preserve ->preserve)
+    (define (->preserve preservable)
+      (match
+       preservable
+       ((Floor ?shape) (record 'floor (list (*->preserve ?shape))))))))
+  (define (parse-Floor input)
+    (match
+     input
+     ((and dest
+           (record
+            'floor
+            (list (app parse-Shape (and ?shape (not (== eof)))))))
+      (Floor ?shape))
+     (_ eof)))
+  (define parse-Floor! (parse-success-or-error 'parse-Floor parse-Floor))
+  (struct
+   Ground
+   (size)
+   #:transparent
+   #:methods
+   gen:preservable
+   ((define/generic *->preserve ->preserve)
+    (define (->preserve preservable)
+      (match
+       preservable
+       ((Ground ?size) (record 'ground (list (*->preserve ?size))))))))
+  (define (parse-Ground input)
+    (match
+     input
+     ((and dest
+           (record
+            'ground
+            (list (app parse-Vector2 (and ?size (not (== eof)))))))
+      (Ground ?size))
+     (_ eof)))
+  (define parse-Ground! (parse-success-or-error 'parse-Ground parse-Ground))
+  (struct
+   Light
+   (v)
+   #:transparent
+   #:methods
+   gen:preservable
+   ((define/generic *->preserve ->preserve)
+    (define (->preserve preservable)
+      (match
+       preservable
+       ((Light ?v) (record 'hemispheric-light (list (*->preserve ?v))))))))
+  (define (parse-Light input)
+    (match
+     input
+     ((and dest
+           (record
+            'hemispheric-light
+            (list (app parse-Vector3 (and ?v (not (== eof)))))))
+      (Light ?v))
+     (_ eof)))
+  (define parse-Light! (parse-success-or-error 'parse-Light parse-Light))
+  (define (Mesh? p)
+    (or (Mesh-Sphere? p)
+        (Mesh-Box? p)
+        (Mesh-Ground? p)
+        (Mesh-Plane? p)
+        (Mesh-External? p)))
+  (struct
+   Mesh-Sphere
+   (value)
+   #:transparent
+   #:methods
+   gen:preservable
+   ((define/generic *->preserve ->preserve)
+    (define (->preserve preservable)
+      (match preservable ((Mesh-Sphere src) (*->preserve src))))))
+  (struct
+   Mesh-Box
+   (value)
+   #:transparent
+   #:methods
+   gen:preservable
+   ((define/generic *->preserve ->preserve)
+    (define (->preserve preservable)
+      (match preservable ((Mesh-Box src) (*->preserve src))))))
+  (struct
+   Mesh-Ground
+   (value)
+   #:transparent
+   #:methods
+   gen:preservable
+   ((define/generic *->preserve ->preserve)
+    (define (->preserve preservable)
+      (match preservable ((Mesh-Ground src) (*->preserve src))))))
+  (struct
+   Mesh-Plane
+   (value)
+   #:transparent
+   #:methods
+   gen:preservable
+   ((define/generic *->preserve ->preserve)
+    (define (->preserve preservable)
+      (match preservable ((Mesh-Plane src) (*->preserve src))))))
+  (struct
+   Mesh-External
+   (value)
+   #:transparent
+   #:methods
+   gen:preservable
+   ((define/generic *->preserve ->preserve)
+    (define (->preserve preservable)
+      (match preservable ((Mesh-External src) (*->preserve src))))))
+  (define (parse-Mesh input)
+    (match
+     input
+     ((app parse-Sphere (and dest (not (== eof)))) (Mesh-Sphere dest))
+     ((app parse-Box (and dest (not (== eof)))) (Mesh-Box dest))
+     ((app parse-Ground (and dest (not (== eof)))) (Mesh-Ground dest))
+     ((app parse-Plane (and dest (not (== eof)))) (Mesh-Plane dest))
+     ((app parse-External (and dest (not (== eof)))) (Mesh-External dest))
+     (_ eof)))
+  (define parse-Mesh! (parse-success-or-error 'parse-Mesh parse-Mesh))
+  (struct
+   Move
+   (v shape)
+   #:transparent
+   #:methods
+   gen:preservable
+   ((define/generic *->preserve ->preserve)
+    (define (->preserve preservable)
+      (match
+       preservable
+       ((Move ?v ?shape)
+        (record 'move (list (*->preserve ?v) (*->preserve ?shape))))))))
+  (define (parse-Move input)
+    (match
+     input
+     ((and dest
+           (record
+            'move
+            (list
+             (app parse-Vector3 (and ?v (not (== eof))))
+             (app parse-Shape (and ?shape (not (== eof)))))))
+      (Move ?v ?shape))
+     (_ eof)))
+  (define parse-Move! (parse-success-or-error 'parse-Move parse-Move))
+  (struct
+   Name
+   (base shape)
+   #:transparent
+   #:methods
+   gen:preservable
+   ((define/generic *->preserve ->preserve)
+    (define (->preserve preservable)
+      (match
+       preservable
+       ((Name ?base ?shape)
+        (record 'name (list (*->preserve ?base) (*->preserve ?shape))))))))
+  (define (parse-Name input)
+    (match
+     input
+     ((and dest
+           (record
+            'name
+            (list
+             (and ?base (? string?))
+             (app parse-Shape (and ?shape (not (== eof)))))))
+      (Name ?base ?shape))
+     (_ eof)))
+  (define parse-Name! (parse-success-or-error 'parse-Name parse-Name))
+  (struct
+   Nonphysical
+   (shape)
+   #:transparent
+   #:methods
+   gen:preservable
+   ((define/generic *->preserve ->preserve)
+    (define (->preserve preservable)
+      (match
+       preservable
+       ((Nonphysical ?shape)
+        (record 'nonphysical (list (*->preserve ?shape))))))))
+  (define (parse-Nonphysical input)
+    (match
+     input
+     ((and dest
+           (record
+            'nonphysical
+            (list (app parse-Shape (and ?shape (not (== eof)))))))
+      (Nonphysical ?shape))
+     (_ eof)))
+  (define parse-Nonphysical!
+    (parse-success-or-error 'parse-Nonphysical parse-Nonphysical))
+  (struct
+   Plane
+   ()
+   #:transparent
+   #:methods
+   gen:preservable
+   ((define/generic *->preserve ->preserve)
+    (define (->preserve preservable)
+      (match preservable ((Plane) (record 'plane (list)))))))
+  (define (parse-Plane input)
+    (match input ((and dest (record 'plane (list))) (Plane)) (_ eof)))
+  (define parse-Plane! (parse-success-or-error 'parse-Plane parse-Plane))
+  (struct
+   Quaternion
+   (a b c d)
+   #:transparent
+   #:methods
+   gen:preservable
+   ((define/generic *->preserve ->preserve)
+    (define (->preserve preservable)
+      (match
+       preservable
+       ((Quaternion ?a ?b ?c ?d)
+        (record
+         'q
+         (list
+          (exact->inexact (*->preserve ?a))
+          (exact->inexact (*->preserve ?b))
+          (exact->inexact (*->preserve ?c))
+          (exact->inexact (*->preserve ?d)))))))))
+  (define (parse-Quaternion input)
+    (match
+     input
+     ((and dest
+           (record
+            'q
+            (list
+             (and ?a (? flonum?))
+             (and ?b (? flonum?))
+             (and ?c (? flonum?))
+             (and ?d (? flonum?)))))
+      (Quaternion ?a ?b ?c ?d))
+     (_ eof)))
+  (define parse-Quaternion!
+    (parse-success-or-error 'parse-Quaternion parse-Quaternion))
+  (define (Rotate? p) (or (Rotate-euler? p) (Rotate-quaternion? p)))
+  (struct
+   Rotate-euler
+   (v shape)
+   #:transparent
+   #:methods
+   gen:preservable
+   ((define/generic *->preserve ->preserve)
+    (define (->preserve preservable)
+      (match
+       preservable
+       ((Rotate-euler ?v ?shape)
+        (record 'rotate (list (*->preserve ?v) (*->preserve ?shape))))))))
+  (struct
+   Rotate-quaternion
+   (q shape)
+   #:transparent
+   #:methods
+   gen:preservable
+   ((define/generic *->preserve ->preserve)
+    (define (->preserve preservable)
+      (match
+       preservable
+       ((Rotate-quaternion ?q ?shape)
+        (record 'rotate (list (*->preserve ?q) (*->preserve ?shape))))))))
+  (define (parse-Rotate input)
+    (match
+     input
+     ((and dest
+           (record
+            'rotate
+            (list
+             (app parse-Vector3 (and ?v (not (== eof))))
+             (app parse-Shape (and ?shape (not (== eof)))))))
+      (Rotate-euler ?v ?shape))
+     ((and dest
+           (record
+            'rotate
+            (list
+             (app parse-Quaternion (and ?q (not (== eof))))
+             (app parse-Shape (and ?shape (not (== eof)))))))
+      (Rotate-quaternion ?q ?shape))
+     (_ eof)))
+  (define parse-Rotate! (parse-success-or-error 'parse-Rotate parse-Rotate))
+  (struct
+   Scale
+   (v shape)
+   #:transparent
+   #:methods
+   gen:preservable
+   ((define/generic *->preserve ->preserve)
+    (define (->preserve preservable)
+      (match
+       preservable
+       ((Scale ?v ?shape)
+        (record 'scale (list (*->preserve ?v) (*->preserve ?shape))))))))
+  (define (parse-Scale input)
+    (match
+     input
+     ((and dest
+           (record
+            'scale
+            (list
+             (app parse-Vector3 (and ?v (not (== eof))))
+             (app parse-Shape (and ?shape (not (== eof)))))))
+      (Scale ?v ?shape))
+     (_ eof)))
+  (define parse-Scale! (parse-success-or-error 'parse-Scale parse-Scale))
+  (define (Shape? p)
+    (or (Shape-Mesh? p)
+        (Shape-Light? p)
+        (Shape-Scale? p)
+        (Shape-Move? p)
+        (Shape-Rotate? p)
+        (Shape-many? p)
+        (Shape-Texture? p)
+        (Shape-Color? p)
+        (Shape-Sound? p)
+        (Shape-Name? p)
+        (Shape-Floor? p)
+        (Shape-Nonphysical? p)
+        (Shape-Touchable? p)
+        (Shape-CSG? p)
+        (Shape-Skybox? p)))
+  (struct
+   Shape-Mesh
+   (value)
+   #:transparent
+   #:methods
+   gen:preservable
+   ((define/generic *->preserve ->preserve)
+    (define (->preserve preservable)
+      (match preservable ((Shape-Mesh src) (*->preserve src))))))
+  (struct
+   Shape-Light
+   (value)
+   #:transparent
+   #:methods
+   gen:preservable
+   ((define/generic *->preserve ->preserve)
+    (define (->preserve preservable)
+      (match preservable ((Shape-Light src) (*->preserve src))))))
+  (struct
+   Shape-Scale
+   (value)
+   #:transparent
+   #:methods
+   gen:preservable
+   ((define/generic *->preserve ->preserve)
+    (define (->preserve preservable)
+      (match preservable ((Shape-Scale src) (*->preserve src))))))
+  (struct
+   Shape-Move
+   (value)
+   #:transparent
+   #:methods
+   gen:preservable
+   ((define/generic *->preserve ->preserve)
+    (define (->preserve preservable)
+      (match preservable ((Shape-Move src) (*->preserve src))))))
+  (struct
+   Shape-Rotate
+   (value)
+   #:transparent
+   #:methods
+   gen:preservable
+   ((define/generic *->preserve ->preserve)
+    (define (->preserve preservable)
+      (match preservable ((Shape-Rotate src) (*->preserve src))))))
+  (struct
+   Shape-many
+   (value)
+   #:transparent
+   #:methods
+   gen:preservable
+   ((define/generic *->preserve ->preserve)
+    (define (->preserve preservable)
+      (match
+       preservable
+       ((Shape-many src)
+        (for/list ((item (in-list src))) (*->preserve item)))))))
+  (struct
+   Shape-Texture
+   (value)
+   #:transparent
+   #:methods
+   gen:preservable
+   ((define/generic *->preserve ->preserve)
+    (define (->preserve preservable)
+      (match preservable ((Shape-Texture src) (*->preserve src))))))
+  (struct
+   Shape-Color
+   (value)
+   #:transparent
+   #:methods
+   gen:preservable
+   ((define/generic *->preserve ->preserve)
+    (define (->preserve preservable)
+      (match preservable ((Shape-Color src) (*->preserve src))))))
+  (struct
+   Shape-Sound
+   (value)
+   #:transparent
+   #:methods
+   gen:preservable
+   ((define/generic *->preserve ->preserve)
+    (define (->preserve preservable)
+      (match preservable ((Shape-Sound src) (*->preserve src))))))
+  (struct
+   Shape-Name
+   (value)
+   #:transparent
+   #:methods
+   gen:preservable
+   ((define/generic *->preserve ->preserve)
+    (define (->preserve preservable)
+      (match preservable ((Shape-Name src) (*->preserve src))))))
+  (struct
+   Shape-Floor
+   (value)
+   #:transparent
+   #:methods
+   gen:preservable
+   ((define/generic *->preserve ->preserve)
+    (define (->preserve preservable)
+      (match preservable ((Shape-Floor src) (*->preserve src))))))
+  (struct
+   Shape-Nonphysical
+   (value)
+   #:transparent
+   #:methods
+   gen:preservable
+   ((define/generic *->preserve ->preserve)
+    (define (->preserve preservable)
+      (match preservable ((Shape-Nonphysical src) (*->preserve src))))))
+  (struct
+   Shape-Touchable
+   (value)
+   #:transparent
+   #:methods
+   gen:preservable
+   ((define/generic *->preserve ->preserve)
+    (define (->preserve preservable)
+      (match preservable ((Shape-Touchable src) (*->preserve src))))))
+  (struct
+   Shape-CSG
+   (value)
+   #:transparent
+   #:methods
+   gen:preservable
+   ((define/generic *->preserve ->preserve)
+    (define (->preserve preservable)
+      (match preservable ((Shape-CSG src) (*->preserve src))))))
+  (struct
+   Shape-Skybox
+   (value)
+   #:transparent
+   #:methods
+   gen:preservable
+   ((define/generic *->preserve ->preserve)
+    (define (->preserve preservable)
+      (match preservable ((Shape-Skybox src) (*->preserve src))))))
+  (define (parse-Shape input)
+    (match
+     input
+     ((app parse-Mesh (and dest (not (== eof)))) (Shape-Mesh dest))
+     ((app parse-Light (and dest (not (== eof)))) (Shape-Light dest))
+     ((app parse-Scale (and dest (not (== eof)))) (Shape-Scale dest))
+     ((app parse-Move (and dest (not (== eof)))) (Shape-Move dest))
+     ((app parse-Rotate (and dest (not (== eof)))) (Shape-Rotate dest))
+     ((list (app parse-Shape (and dest (not (== eof)))) ...) (Shape-many dest))
+     ((app parse-Texture (and dest (not (== eof)))) (Shape-Texture dest))
+     ((app parse-Color (and dest (not (== eof)))) (Shape-Color dest))
+     ((app parse-Sound (and dest (not (== eof)))) (Shape-Sound dest))
+     ((app parse-Name (and dest (not (== eof)))) (Shape-Name dest))
+     ((app parse-Floor (and dest (not (== eof)))) (Shape-Floor dest))
+     ((app parse-Nonphysical (and dest (not (== eof))))
+      (Shape-Nonphysical dest))
+     ((app parse-Touchable (and dest (not (== eof)))) (Shape-Touchable dest))
+     ((app parse-CSG (and dest (not (== eof)))) (Shape-CSG dest))
+     ((app parse-Skybox (and dest (not (== eof)))) (Shape-Skybox dest))
+     (_ eof)))
+  (define parse-Shape! (parse-success-or-error 'parse-Shape parse-Shape))
+  (struct
+   Skybox
+   (path)
+   #:transparent
+   #:methods
+   gen:preservable
+   ((define/generic *->preserve ->preserve)
+    (define (->preserve preservable)
+      (match
+       preservable
+       ((Skybox ?path) (record 'skybox (list (*->preserve ?path))))))))
+  (define (parse-Skybox input)
+    (match
+     input
+     ((and dest (record 'skybox (list (and ?path (? string?)))))
+      (Skybox ?path))
+     (_ eof)))
+  (define parse-Skybox! (parse-success-or-error 'parse-Skybox parse-Skybox))
+  (struct
+   Sound
+   (spec shape)
+   #:transparent
+   #:methods
+   gen:preservable
+   ((define/generic *->preserve ->preserve)
+    (define (->preserve preservable)
+      (match
+       preservable
+       ((Sound ?spec ?shape)
+        (record 'sound (list (*->preserve ?spec) (*->preserve ?shape))))))))
+  (define (parse-Sound input)
+    (match
+     input
+     ((and dest
+           (record
+            'sound
+            (list
+             (app parse-SoundSpec (and ?spec (not (== eof))))
+             (app parse-Shape (and ?shape (not (== eof)))))))
+      (Sound ?spec ?shape))
+     (_ eof)))
+  (define parse-Sound! (parse-success-or-error 'parse-Sound parse-Sound))
+  (define (SoundSpec? p) (or (SoundSpec-stream? p) (SoundSpec-loop? p)))
+  (struct
+   SoundSpec-stream
+   (url)
+   #:transparent
+   #:methods
+   gen:preservable
+   ((define/generic *->preserve ->preserve)
+    (define (->preserve preservable)
+      (match
+       preservable
+       ((SoundSpec-stream ?url) (record 'stream (list (*->preserve ?url))))))))
+  (struct
+   SoundSpec-loop
+   (url)
+   #:transparent
+   #:methods
+   gen:preservable
+   ((define/generic *->preserve ->preserve)
+    (define (->preserve preservable)
+      (match
+       preservable
+       ((SoundSpec-loop ?url) (record 'loop (list (*->preserve ?url))))))))
+  (define (parse-SoundSpec input)
+    (match
+     input
+     ((and dest (record 'stream (list (and ?url (? string?)))))
+      (SoundSpec-stream ?url))
+     ((and dest (record 'loop (list (and ?url (? string?)))))
+      (SoundSpec-loop ?url))
+     (_ eof)))
+  (define parse-SoundSpec!
+    (parse-success-or-error 'parse-SoundSpec parse-SoundSpec))
+  (struct
+   Sphere
+   ()
+   #:transparent
+   #:methods
+   gen:preservable
+   ((define/generic *->preserve ->preserve)
+    (define (->preserve preservable)
+      (match preservable ((Sphere) (record 'sphere (list)))))))
+  (define (parse-Sphere input)
+    (match input ((and dest (record 'sphere (list))) (Sphere)) (_ eof)))
+  (define parse-Sphere! (parse-success-or-error 'parse-Sphere parse-Sphere))
+  (struct
+   Sprite
+   (name shape)
+   #:transparent
+   #:methods
+   gen:preservable
+   ((define/generic *->preserve ->preserve)
+    (define (->preserve preservable)
+      (match
+       preservable
+       ((Sprite ?name ?shape)
+        (record 'sprite (list (*->preserve ?name) (*->preserve ?shape))))))))
+  (define (parse-Sprite input)
+    (match
+     input
+     ((and dest
+           (record
+            'sprite
+            (list
+             (and ?name (? string?))
+             (app parse-Shape (and ?shape (not (== eof)))))))
+      (Sprite ?name ?shape))
+     (_ eof)))
+  (define parse-Sprite! (parse-success-or-error 'parse-Sprite parse-Sprite))
+  (struct
+   Texture
+   (spec shape)
+   #:transparent
+   #:methods
+   gen:preservable
+   ((define/generic *->preserve ->preserve)
+    (define (->preserve preservable)
+      (match
+       preservable
+       ((Texture ?spec ?shape)
+        (record 'texture (list (*->preserve ?spec) (*->preserve ?shape))))))))
+  (define (parse-Texture input)
+    (match
+     input
+     ((and dest
+           (record
+            'texture
+            (list
+             (app parse-TextureSpec (and ?spec (not (== eof))))
+             (app parse-Shape (and ?shape (not (== eof)))))))
+      (Texture ?spec ?shape))
+     (_ eof)))
+  (define parse-Texture! (parse-success-or-error 'parse-Texture parse-Texture))
+  (define (TextureSpec? p)
+    (or (TextureSpec-simple? p) (TextureSpec-uv? p) (TextureSpec-uvAlpha? p)))
+  (struct
+   TextureSpec-simple
+   (path)
+   #:transparent
+   #:methods
+   gen:preservable
+   ((define/generic *->preserve ->preserve)
+    (define (->preserve preservable)
+      (match
+       preservable
+       ((TextureSpec-simple ?path) (list (*->preserve ?path)))))))
+  (struct
+   TextureSpec-uv
+   (path scale offset)
+   #:transparent
+   #:methods
+   gen:preservable
+   ((define/generic *->preserve ->preserve)
+    (define (->preserve preservable)
+      (match
+       preservable
+       ((TextureSpec-uv ?path ?scale ?offset)
+        (list
+         (*->preserve ?path)
+         (*->preserve ?scale)
+         (*->preserve ?offset)))))))
+  (struct
+   TextureSpec-uvAlpha
+   (path scale offset alpha)
+   #:transparent
+   #:methods
+   gen:preservable
+   ((define/generic *->preserve ->preserve)
+    (define (->preserve preservable)
+      (match
+       preservable
+       ((TextureSpec-uvAlpha ?path ?scale ?offset ?alpha)
+        (list
+         (*->preserve ?path)
+         (*->preserve ?scale)
+         (*->preserve ?offset)
+         (exact->inexact (*->preserve ?alpha))))))))
+  (define (parse-TextureSpec input)
+    (match
+     input
+     ((and dest (list (and ?path (? string?)))) (TextureSpec-simple ?path))
+     ((and dest
+           (list
+            (and ?path (? string?))
+            (app parse-Vector2 (and ?scale (not (== eof))))
+            (app parse-Vector2 (and ?offset (not (== eof))))))
+      (TextureSpec-uv ?path ?scale ?offset))
+     ((and dest
+           (list
+            (and ?path (? string?))
+            (app parse-Vector2 (and ?scale (not (== eof))))
+            (app parse-Vector2 (and ?offset (not (== eof))))
+            (and ?alpha (? flonum?))))
+      (TextureSpec-uvAlpha ?path ?scale ?offset ?alpha))
+     (_ eof)))
+  (define parse-TextureSpec!
+    (parse-success-or-error 'parse-TextureSpec parse-TextureSpec))
+  (struct
+   Touchable
+   (shape)
+   #:transparent
+   #:methods
+   gen:preservable
+   ((define/generic *->preserve ->preserve)
+    (define (->preserve preservable)
+      (match
+       preservable
+       ((Touchable ?shape) (record 'touchable (list (*->preserve ?shape))))))))
+  (define (parse-Touchable input)
+    (match
+     input
+     ((and dest
+           (record
+            'touchable
+            (list (app parse-Shape (and ?shape (not (== eof)))))))
+      (Touchable ?shape))
+     (_ eof)))
+  (define parse-Touchable!
+    (parse-success-or-error 'parse-Touchable parse-Touchable))
+  (struct
+   Vector2
+   (x y)
+   #:transparent
+   #:methods
+   gen:preservable
+   ((define/generic *->preserve ->preserve)
+    (define (->preserve preservable)
+      (match
+       preservable
+       ((Vector2 ?x ?y)
+        (record
+         'v
+         (list
+          (exact->inexact (*->preserve ?x))
+          (exact->inexact (*->preserve ?y)))))))))
+  (define (parse-Vector2 input)
+    (match
+     input
+     ((and dest (record 'v (list (and ?x (? flonum?)) (and ?y (? flonum?)))))
+      (Vector2 ?x ?y))
+     (_ eof)))
+  (define parse-Vector2! (parse-success-or-error 'parse-Vector2 parse-Vector2))
+  (struct
+   Vector3
+   (x y z)
+   #:transparent
+   #:methods
+   gen:preservable
+   ((define/generic *->preserve ->preserve)
+    (define (->preserve preservable)
+      (match
+       preservable
+       ((Vector3 ?x ?y ?z)
+        (record
+         'v
+         (list
+          (exact->inexact (*->preserve ?x))
+          (exact->inexact (*->preserve ?y))
+          (exact->inexact (*->preserve ?z)))))))))
+  (define (parse-Vector3 input)
+    (match
+     input
+     ((and dest
+           (record
+            'v
+            (list
+             (and ?x (? flonum?))
+             (and ?y (? flonum?))
+             (and ?z (? flonum?)))))
+      (Vector3 ?x ?y ?z))
+     (_ eof)))
+  (define parse-Vector3!
+    (parse-success-or-error 'parse-Vector3 parse-Vector3)))