diff --git a/syndicate/drivers/gl-2d.rkt b/syndicate/drivers/gl-2d.rkt
new file mode 100644
index 0000000..f3cdccd
--- /dev/null
+++ b/syndicate/drivers/gl-2d.rkt
@@ -0,0 +1,718 @@
+#lang imperative-syndicate
+
+(provide (struct-out window)
+         (struct-out frame-event)
+         (struct-out key-event)
+         (struct-out key-pressed)
+         (struct-out mouse-event)
+         (struct-out mouse-state)
+         (struct-out touching)
+         (struct-out coordinate-map)
+         (struct-out scene)
+         (except-out (struct-out sprite) sprite)
+         (rename-out [sprite <sprite>] [make-sprite sprite])
+         (struct-out gl-control)
+         in-unit-circle?
+         in-unit-square?
+         simple-sprite
+         assert-scene
+         spawn-keyboard-integrator
+         spawn-mouse-integrator
+         spawn-gl-2d-driver)
+
+(require data/order)
+(require data/splay-tree)
+(require data/queue)
+(require sgl/gl)
+(require sgl/gl-vectors)
+
+(require racket/gui/base)
+(require racket/dict)
+(require (only-in racket/class
+                  send is-a? make-object class class* inherit this new super-new init
+                  define/public define/override define/augment))
+(require (only-in racket/math sqr))
+
+(require (prefix-in image: 2htdp/image))
+(require (prefix-in pict: pict))
+
+(require syndicate-gl/texture)
+(require syndicate-gl/affine)
+
+(require/activate imperative-syndicate/drivers/timer)
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+;; Shared state maintained by dataspace. Describes current window dimensions.
+(assertion-struct window (width height))
+
+;; Message sent by dataspace. Describes render time.
+(message-struct frame-event (counter timestamp elapsed-ms target-frame-rate))
+
+;; Message sent by dataspace. Describes a key event. Key is a sealed
+;; key-event%. `press?` is #t when the key is pressed (or
+;; autorepeated!), and #f when it is released.
+(message-struct key-event (code press? key))
+
+;; Assertion. Indicates that the named key is held down. See role
+;; KeyboardIntegrator and spawn-keyboard-integrator.
+(assertion-struct key-pressed (code))
+
+;; Message sent by dataspace. Describes a mouse event. State is a
+;; MouseState.
+(message-struct mouse-event (type state))
+
+;; Assertion. Indicates that the mouse is in a particular state. See
+;; role MouseIntegrator and spawn-mouse-integrator.
+(assertion-struct mouse-state (x y left-down? middle-down? right-down?))
+
+;; Assertion. Indicates that the mouse is touching a particular touchable.
+(assertion-struct touching (id))
+
+;; Assertion. Communicates aggregate device-to-user transformation
+;; requested as part of sprite instruction sequences.
+(assertion-struct coordinate-map (id matrix))
+
+;; Shared state maintained by program. Prelude and postlude are to be
+;; sealed instruction lists. It is an error to have more than exactly
+;; one active such record at a given time.
+(assertion-struct scene (prelude postlude))
+
+;; A SpriteID is an equal?-comparable dataspace-unique value.
+
+;; Shared state maintained by program. `id` is a SpriteID, and
+;; `parent-id` is an (Option SpriteID); #f in `parent-id` means that
+;; this sprite is a child of the root. Z is to be a number, negative
+;; toward camera. Instructions to be a sealed instruction list.
+(assertion-struct sprite (id parent-id z instructions))
+
+;; Message and assertion.
+;;
+;; When sent as a message with `body` of `'stop`, closes the GL window
+;; and terminates the driver.
+;;
+;; When asserted with `body` of `'fullscreen`, causes the window to be
+;; fullscreen; otherwise, it is a normal window.
+;;
+(assertion-struct gl-control (body))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(define-syntax-rule (assert-scene prelude postlude)
+  (assert (scene (seal prelude) (seal postlude))))
+
+(define (make-sprite z instructions #:id [id #f] #:parent [parent-id #f])
+  (sprite (or id (gensym 'sprite)) parent-id z (seal instructions)))
+
+(define (in-unit-circle? x y)
+  (<= (+ (sqr (- x 0.5)) (sqr (- y 0.5))) (sqr 0.5)))
+
+(define (in-unit-square? x y)
+  (and (<= 0 x 1)
+       (<= 0 y 1)))
+
+(define (simple-sprite z x y w h i
+                       #:parent [parent-id #f]
+                       #:rotation [rotation 0]
+                       #:coordinate-map-id [coordinate-map-id #f]
+                       #:touchable-id [touchable-id #f]
+                       #:touchable-predicate [touchable-predicate in-unit-square?])
+  (make-sprite #:id touchable-id
+               #:parent parent-id
+               z
+               `((translate ,x ,y)
+                 ,@(if (zero? rotation) `() `((rotate ,rotation)))
+                 (push-matrix
+                  (scale ,w ,h)
+                  ,@(if touchable-id
+                        `((touchable ,touchable-id ,touchable-predicate))
+                        `())
+                  (texture ,i))
+                 ,@(if coordinate-map-id
+                       `((coordinate-map ,coordinate-map-id))
+                       `())
+                 (render-children))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+;; KeyboardIntegrator. Integrates key-events into key-pressed assertions.
+(define (spawn-keyboard-integrator)
+  (spawn #:name 'gl-2d/keyboard-integratpr
+         (local-require racket/set)
+         (define keys-pressed (mutable-set))
+         ;; TODO: consider adding set-semantics assert!/retract! API for this kind of thing
+         (on (message (key-event $code #t _))
+             (unless (set-member? keys-pressed code)
+               (set-add! keys-pressed code)
+               (assert! (key-pressed code))))
+         (on (message (key-event $code #f _))
+             (when (set-member? keys-pressed code)
+               (set-remove! keys-pressed code)
+               (retract! (key-pressed code))))))
+
+;; MouseIntegrator. Integrates mouse-events into mouse-state assertions.
+(define (spawn-mouse-integrator)
+  (spawn #:name 'gl-2d/mouse-integrator
+         (field [in-bounds? #f] [state #f])
+         (assert #:when (in-bounds?) (state))
+         (on (message (mouse-event $type $new-state))
+             (in-bounds? (not (eq? type 'leave)))
+             (state new-state))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+;; A Touchable is one of
+;;
+;; - (touchable Any TransformationMatrix (Number Number -> Boolean))
+;;   Represents a composed device-to-user transformation, plus a
+;;   predicate on user coordinates, and an ID to use when the
+;;   predicate answers truthily.
+;;
+;; - (touchable-map)
+;;   Represents the location in a sequence of touchables where the
+;;   aggregate partial device-to-user transformation used when mapping
+;;   along parent-child relationship edges in the sprite tree should
+;;   be applied to child sprites.
+;;
+(struct touchable (id transformation predicate) #:transparent)
+(struct touchable-map () #:transparent)
+
+;; A Children is a (SplayTree Sprite CompiledInstructions), ordered
+;; first by sprite-z, then sprite-id hash code, then
+;; sprite-instructions hash-code.
+;;
+;; A ChildMap is a (Hash SpriteID Children), mapping sprite-id to the
+;; children of that sprite.
+
+;; (compiled-instructions (ChildMap SpriteID -> Void)
+;;                        (Listof Touchable)
+;;                        (Listof CoordinateMap)
+;;                        (Listof Resource)
+;;                        (Option TransformationMatrix))
+;; A single compiled sprite. The resources and coordinate-maps aren't
+;; in any particular order, but the touchables are: the leftmost
+;; touchable is the first to check; that is, it is the *topmost*
+;; touchable in this sprite. The child-xform, if present, is the
+;; transformation needed to map between mouse coordinates and child
+;; sprite space; if absent, no (render-children) instruction was found
+;; in this sprite's render code.
+(struct compiled-instructions (render-proc touchables coordinate-maps resources child-xform))
+
+(define-namespace-anchor ns-anchor)
+(define ns (namespace-anchor->namespace ns-anchor))
+
+(define (compile-instructions instrs)
+  (define touchables '())
+  (define coordinate-maps '())
+  (define resources '())
+  (define child-xform #f)
+
+  (define (instructions->racket-code instrs xform)
+    (define-values (code-rev new-xform)
+      (for/fold [(code-rev '()) (xform xform)] [(instr (in-list instrs))]
+        (define-values (new-code new-xform) (instruction->racket-code instr xform))
+        (values (cons new-code code-rev) new-xform)))
+    (let ((code (reverse code-rev)))
+      (values (lambda (CHILDMAP SELF-ID)
+                (for [(p (in-list code))]
+                  (p CHILDMAP SELF-ID)))
+              new-xform)))
+
+  (define (instruction->racket-code instr xform)
+    (match instr
+      [`(rotate ,(? number? deg))
+       (values (lambda (CHILDMAP SELF-ID) (glRotated deg 0 0 -1))
+               (compose-transformation xform (rotation-transformation (- deg))))]
+      [`(scale ,(? number? x) ,(? number? y))
+       (values (lambda (CHILDMAP SELF-ID) (glScaled x y 1))
+               (compose-transformation xform (stretching-transformation x y)))]
+      [`(translate ,(? number? x) ,(? number? y))
+       (values (lambda (CHILDMAP SELF-ID) (glTranslated x y 0))
+               (compose-transformation xform (translation-transformation x y)))]
+      [`(color ,(? color-number? r) ,(? color-number? g) ,(? color-number? b) ,(? color-number? a))
+       (values (lambda (CHILDMAP SELF-ID) (glColor4d r g b a)) xform)]
+      [`(texture ,i)
+       (define entry (image->texture-cache-entry i))
+       (define tex (send entry get-texture))
+       (set! resources (cons entry resources))
+       (values (lambda (CHILDMAP SELF-ID) (draw-gl-face tex)) xform)]
+      [`(texture ,i ,l ,t ,w ,h) #:when (andmap number? (list l t w h))
+       (define entry (image->texture-cache-entry i))
+       (define tex (send entry get-texture))
+       (set! resources (cons entry resources))
+       (values (lambda (CHILDMAP SELF-ID) (draw-gl-face tex l t w h)) xform)]
+      [`(touchable ,id ,predicate)
+       (set! touchables (cons (touchable id xform predicate) touchables))
+       (values void xform)]
+      [`(coordinate-map ,id)
+       (set! coordinate-maps (cons (coordinate-map id xform) coordinate-maps))
+       (values void xform)]
+      [`(push-matrix ,instr ...)
+       (define-values (code _new-xform) (instructions->racket-code instr xform))
+       (values (lambda (CHILDMAP SELF-ID)
+                 (glPushMatrix)
+                 (code CHILDMAP SELF-ID)
+                 (glPopMatrix))
+               xform)]
+      [`(begin ,instr ...)
+       (define-values (code new-xform) (instructions->racket-code instr xform))
+       (values code new-xform)]
+      [`(render-children) ;; we assume that there will only be one of these
+       (set! child-xform xform)
+       (set! touchables (cons (touchable-map) touchables))
+       (values render-sprites! xform)]
+      [other
+       (error 'instruction->racket-code "unknown render instruction: ~v" other)]))
+
+  (define-values (render-proc final-transformation)
+    (instruction->racket-code `(begin ,@instrs) identity-transformation))
+  (compiled-instructions render-proc
+                         touchables
+                         coordinate-maps
+                         resources
+                         child-xform))
+
+;; (define (compile-instructions instrs)
+;;   (define touchables '())
+;;   (define coordinate-maps '())
+;;   (define resources '())
+;;   (define child-xform #f)
+
+;;   (define (instructions->racket-code instrs xform)
+;;     (define-values (code-rev new-xform)
+;;       (for/fold [(code-rev '()) (xform xform)] [(instr (in-list instrs))]
+;;         (define-values (new-code new-xform) (instruction->racket-code instr xform))
+;;         (values (cons new-code code-rev) new-xform)))
+;;     (values (reverse code-rev) new-xform))
+
+;;   (define (instruction->racket-code instr xform)
+;;     (match instr
+;;       [`(rotate ,(? number? deg))
+;;        (values `(glRotated ,deg 0 0 -1)
+;;                (compose-transformation xform (rotation-transformation (- deg))))]
+;;       [`(scale ,(? number? x) ,(? number? y))
+;;        (values `(glScaled ,x ,y 1)
+;;                (compose-transformation xform (stretching-transformation x y)))]
+;;       [`(translate ,(? number? x) ,(? number? y))
+;;        (values `(glTranslated ,x ,y 0)
+;;                (compose-transformation xform (translation-transformation x y)))]
+;;       [`(color ,(? color-number? r) ,(? color-number? g) ,(? color-number? b) ,(? color-number? a))
+;;        (values `(glColor4d ,r ,g ,b ,a) xform)]
+;;       [`(texture ,i)
+;;        (define entry (image->texture-cache-entry i))
+;;        (set! resources (cons entry resources))
+;;        (values `(draw-gl-face ,(send entry get-texture)) xform)]
+;;       [`(texture ,i ,l ,t ,w ,h) #:when (andmap number? (list l t w h))
+;;        (define entry (image->texture-cache-entry i))
+;;        (set! resources (cons entry resources))
+;;        (values `(draw-gl-face ,(send entry get-texture) ,l ,t ,w ,h) xform)]
+;;       [`(touchable ,id ,predicate)
+;;        (set! touchables (cons (touchable id xform predicate) touchables))
+;;        (values `(void) xform)]
+;;       [`(coordinate-map ,id)
+;;        (set! coordinate-maps (cons (coordinate-map id xform) coordinate-maps))
+;;        (values `(void) xform)]
+;;       [`(push-matrix ,instr ...)
+;;        (define-values (code _new-xform) (instructions->racket-code instr xform))
+;;        (values `(begin (glPushMatrix) ,@code (glPopMatrix)) xform)]
+;;       [`(begin ,instr ...)
+;;        (define-values (code new-xform) (instructions->racket-code instr xform))
+;;        (values `(begin ,@code (void)) new-xform)]
+;;       [`(render-children) ;; we assume that there will only be one of these
+;;        (set! child-xform xform)
+;;        (set! touchables (cons (touchable-map) touchables))
+;;        (values `(render-sprites! CHILDMAP SELF-ID) xform)]
+;;       [other
+;;        (error 'instruction->racket-code "unknown render instruction: ~v" other)]))
+
+;;   (define-values (code final-transformation)
+;;     (instruction->racket-code `(begin ,@instrs) identity-transformation))
+;;   (define render-proc (eval `(lambda (CHILDMAP SELF-ID) ,code) ns))
+;;   (compiled-instructions render-proc
+;;                          touchables
+;;                          coordinate-maps
+;;                          resources
+;;                          child-xform))
+
+(define empty-instructions (compile-instructions '()))
+
+(define (compiled-instructions-dispose! i)
+  (when i
+    (for [(resource (in-list (compiled-instructions-resources i)))]
+      (send resource dispose))))
+
+(define (color-number? n)
+  (and (number? n)
+       (<= 0.0 n 1.0)))
+
+(define (image->bitmap i)
+  (cond
+    [(is-a? i bitmap%)
+     i]
+    [(image:image? i)
+     (define w (max 1 (image:image-width i)))
+     (define h (max 1 (image:image-height i)))
+     (define bm (make-object bitmap% w h #f #t))
+     (define dc (send bm make-dc))
+     (send i draw dc
+           0 0
+           0 0
+           w h
+           0 0
+           #f)
+     bm]
+    [(pict:pict? i)
+     (pict:pict->bitmap i)]
+    [else
+     (error 'image->bitmap "unsupported image type ~v" i)]))
+
+(define (image->texture-cache-entry i)
+  (texture-cache-get i image->bitmap))
+
+;; (define (lerp a b v) (+ (* v a) (* (- 1 v) b)))
+
+(define (draw-gl-face texture [left 0] [top 0] [width 1] [height 1])
+  (define bot (+ top height))
+  (define right (+ left width))
+  (send texture bind-texture)
+  (glBegin GL_QUADS)
+  (glNormal3d 0 0 -1)
+  (glTexCoord2d left top)
+  (glVertex3d 0 0 0)
+  (glTexCoord2d right top)
+  (glVertex3d 1 0 0)
+  (glTexCoord2d right bot)
+  (glVertex3d 1 1 0)
+  (glTexCoord2d left bot)
+  (glVertex3d 0 1 0)
+  (glEnd))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(define sprite-order
+  (order 'sprite-order
+         sprite?
+         (lambda (a b) (and (equal? (sprite-id a) (sprite-id b))
+                            (= (sprite-z a) (sprite-z b))
+                            (eq? (sprite-instructions a)
+                                 (sprite-instructions b))))
+         (lambda (a b) (or (> (sprite-z a) (sprite-z b))
+                           (and (= (sprite-z a) (sprite-z b))
+                                (let ((a-id-code (equal-hash-code (sprite-id a)))
+                                      (b-id-code (equal-hash-code (sprite-id b))))
+                                  (or (< a-id-code b-id-code)
+                                      (and (= a-id-code b-id-code)
+                                           (< (eq-hash-code (sprite-instructions a))
+                                              (eq-hash-code (sprite-instructions b)))))))))))
+
+(define (remove-sprite! childmap s)
+  (define sprites (hash-ref childmap (sprite-parent-id s) #f))
+  (when sprites
+    (compiled-instructions-dispose! (splay-tree-ref sprites s #f))
+    (splay-tree-remove! sprites s)
+    (when (dict-empty? sprites) (hash-remove! childmap (sprite-parent-id s)))))
+
+(define (add-sprite! childmap s)
+  (define sprites (hash-ref childmap (sprite-parent-id s)
+                            (lambda ()
+                              (define ss (make-splay-tree sprite-order))
+                              (hash-set! childmap (sprite-parent-id s) ss)
+                              ss)))
+  (define instrs `((color 1 1 1 1)
+                   (push-matrix ,@(seal-contents (sprite-instructions s)))))
+  (define i (compile-instructions instrs))
+  (splay-tree-set! sprites s i))
+
+(define (for-each-child-sprite childmap id f)
+  (define children (hash-ref childmap id #f))
+  (let loop ((iter (and children (splay-tree-iterate-first children))))
+    (when iter
+      (define s (splay-tree-iterate-key children iter))
+      (define ci (splay-tree-iterate-value children iter))
+      (f s ci)
+      (loop (splay-tree-iterate-next children iter)))))
+
+(define (render-sprites! childmap self-id)
+  (for-each-child-sprite childmap self-id
+                         (lambda (s ci)
+                           ((compiled-instructions-render-proc ci) childmap (sprite-id s)))))
+
+(define (render-scene! prelude childmap postlude)
+  ((compiled-instructions-render-proc prelude) childmap #f)
+  (render-sprites! childmap #f)
+  ((compiled-instructions-render-proc postlude) childmap #f))
+
+(define (detect-touch prelude childmap postlude state)
+  (and state
+       (let ()
+         (define x (mouse-state-x state))
+         (define y (mouse-state-y state))
+         (or (detect-touch* childmap #f postlude x y)
+             (detect-sprites-touch childmap #f x y)
+             (detect-touch* childmap #f prelude x y)))))
+
+(define (detect-sprites-touch childmap self-id x y)
+  (define sprites (hash-ref childmap self-id #f))
+  (let loop ((iter (and sprites (splay-tree-iterate-greatest sprites))))
+    (and iter
+         (let ((s (splay-tree-iterate-key sprites iter)))
+           (define ci (splay-tree-iterate-value sprites iter))
+           (or (detect-touch* childmap (sprite-id s) ci x y)
+               (loop (splay-tree-iterate-greatest/<? sprites s)))))))
+
+(define (detect-touch* childmap self-id ci x y)
+  (for/or [(t (in-list (compiled-instructions-touchables ci)))]
+    (match t
+      [(touchable id xform contains?)
+       (define-values (ux uy) (untransform-point* xform x y))
+       (and (contains? ux uy) (touching id))]
+      [(touchable-map)
+       (define xform (compiled-instructions-child-xform ci))
+       (define-values (ux uy) (untransform-point* xform x y))
+       (detect-sprites-touch childmap self-id ux uy)])))
+
+(define (untransform-point* xform x y)
+  (define p (untransform-point xform (make-rectangular x y)))
+  (values (real-part p) (imag-part p)))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(define dataspace-frame%
+  (class* frame% ()
+    (init ground-ch)
+    (super-new)
+    (define (stop!)
+      (parameterize ((current-ground-event-async-channel ground-ch))
+        (ground-send! (gl-control 'stop))))
+    (define/augment (on-close) (stop!))))
+
+(define dataspace-canvas%
+  (class canvas%
+    (inherit refresh with-gl-context swap-gl-buffers)
+
+    (init [(eventspace0 eventspace)])
+    (init ground-ch)
+
+    (define eventspace eventspace0)
+
+    (define (! msg)
+      (parameterize ((current-ground-event-async-channel ground-ch))
+        (ground-send! msg)))
+
+    (define (++ assertion)
+      (parameterize ((current-ground-event-async-channel ground-ch))
+        (ground-assert! assertion)))
+
+    (define (-- assertion)
+      (parameterize ((current-ground-event-async-channel ground-ch))
+        (ground-retract! assertion)))
+
+    ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+    (define initialised? #f)
+
+    (define near-depth 10) ;; 2.5D
+    (define far-depth 15) ;; 2.5D
+
+    (define prelude empty-instructions)
+    (define childmap (make-hash))
+    (define postlude empty-instructions)
+
+    (define current-window-width #f)
+    (define current-window-height #f)
+    (define current-mouse-state #f)
+    (define current-coordinate-maps (hash))
+    (define current-touching #f)
+
+    (define render-needed? #t)
+
+    ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+    (define (mark-dirty!)
+      (when (not render-needed?)
+        (parameterize ((current-eventspace eventspace))
+          (queue-callback (lambda () (refresh)))))
+      (set! render-needed? #t))
+
+    (define/public (replace-scene! new-prelude new-postlude)
+      (with-gl-context
+        (lambda ()
+          (compiled-instructions-dispose! prelude)
+          (compiled-instructions-dispose! postlude)
+          (set! prelude (compile-instructions new-prelude))
+          (set! postlude (compile-instructions new-postlude)))))
+
+    (define/public (alter-sprites! changes)
+      (with-gl-context
+        (lambda ()
+          (for [(change (in-list changes))]
+            (match change
+              [(cons '+ s) (add-sprite! childmap s)]
+              [(cons '- s) (remove-sprite! childmap s)]))
+          (mark-dirty!))))
+
+    (define/public (initialize!)
+      (unless initialised?
+        (with-gl-context
+          (lambda ()
+            (glBlendFunc GL_ONE GL_ONE_MINUS_SRC_ALPHA) ;; premultiplied
+            (glEnable GL_BLEND)
+            (glEnable GL_TEXTURE_2D)
+            (glClearColor 0 0 0 1)
+            (set! initialised? #t)))))
+
+    ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+    (define/override (on-paint)
+      (initialize!)
+
+      (with-gl-context
+        (lambda ()
+          (update-touching!)
+          (update-coordinate-maps!)
+          (flush-texture-cache!)
+
+          (glClear GL_COLOR_BUFFER_BIT)
+          (glLoadIdentity)
+          (glTranslated 0 0 (- near-depth))
+          (render-scene! prelude childmap postlude)
+          (glFlush)
+          (swap-gl-buffers)
+
+          (set! render-needed? #f))))
+
+    (define/override (on-size width height)
+      (with-gl-context
+        (lambda ()
+          (when (not (and (equal? current-window-width width)
+                          (equal? current-window-height height)))
+            (-- (window current-window-width current-window-height))
+            (set! current-window-width width)
+            (set! current-window-height height)
+            (++ (window current-window-width current-window-height)))
+          (glViewport 0 0 width height)
+          (glMatrixMode GL_PROJECTION)
+          (glLoadIdentity)
+          (glOrtho 0 width height 0 0.1 100)
+          (glMatrixMode GL_MODELVIEW)
+          (glLoadIdentity)
+          (mark-dirty!))))
+
+    (define/override (on-char key)
+      (with-gl-context
+        (lambda ()
+          (! (match (send key get-key-code)
+               ['release (key-event (send key get-key-release-code) #f (seal key))]
+               [code     (key-event code                            #t (seal key))])))))
+
+    (define/override (on-event mouse)
+      (with-gl-context
+        (lambda ()
+          (define x (send mouse get-x))
+          (define y (send mouse get-y))
+          (define s (mouse-state x
+                                 y
+                                 (send mouse get-left-down)
+                                 (send mouse get-middle-down)
+                                 (send mouse get-right-down)))
+          (set! current-mouse-state s)
+          (update-touching!)
+          (! (mouse-event (send mouse get-event-type) s)))))
+
+    (define (update-touching!)
+      (define new-touching (detect-touch prelude childmap postlude current-mouse-state))
+      (when (not (equal? current-touching new-touching))
+        (when current-touching (-- current-touching))
+        (set! current-touching new-touching)
+        (when current-touching (++ current-touching))))
+
+    (define (update-coordinate-maps!)
+      (define (update-single-map! cmid cmx)
+        (define existing (hash-ref current-coordinate-maps cmid #f))
+        (define proposed (coordinate-map cmid cmx))
+        (when (not (equal? existing proposed))
+          (set! current-coordinate-maps (hash-set current-coordinate-maps cmid proposed))
+          (-- existing)
+          (++ proposed)))
+
+      (let process-children-of ((id #f) (xform identity-transformation))
+        (for-each-child-sprite childmap id
+                               (lambda (s ci)
+                                 (for [(cm (in-list (compiled-instructions-coordinate-maps ci)))]
+                                   (match-define (coordinate-map cmid cmx) cm)
+                                   (update-single-map! cmid (compose-transformation xform cmx)))
+                                 (define child-xform (compiled-instructions-child-xform ci))
+                                 (when child-xform
+                                   (process-children-of (sprite-id s)
+                                                        (compose-transformation xform
+                                                                                child-xform)))))))
+
+    (super-new (style '(gl no-autoclear)))))
+
+(define (spawn-gl-2d-driver #:label [frame-label "syndicate-gl"]
+                            #:width [width #f]
+                            #:height [height #f])
+  (spawn #:name 'gl-2d/driver
+         (define frame #f) ;; "frame" here refers to *window frame* onscreen, i.e. GUI, not GL
+         (define c #f)
+
+         (parameterize ((current-eventspace (make-eventspace)))
+           (set! frame (new dataspace-frame%
+                            [style '(fullscreen-button)]
+                            [label frame-label]
+                            [width (or width 640)]
+                            [height (or height 480)]
+                            [ground-ch (current-ground-event-async-channel)]))
+           (set! c (new dataspace-canvas%
+                        [parent frame]
+                        [eventspace (current-eventspace)]
+                        [ground-ch (current-ground-event-async-channel)]))
+           (unless (send (send (send c get-dc) get-gl-context) ok?)
+             (error 'gl-2d "OpenGL context failed to initialize"))
+           (send c focus)
+           (send frame show #t))
+
+         (define start-time (current-inexact-milliseconds))
+         (define frame-counter 0)
+         (define target-frame-rate 60)
+         (define changes '())
+         (define dirty? #f)
+
+         (field [sim-time 0])
+
+         (on (asserted (later-than (+ (sim-time) start-time)))
+             (define per-frame-ms (* (/ target-frame-rate) 1000.0))
+             (send! (frame-event frame-counter (sim-time) per-frame-ms target-frame-rate))
+             (set! frame-counter (+ frame-counter 1))
+             (sim-time (* frame-counter per-frame-ms))
+             (when dirty?
+               (send c alter-sprites! (reverse changes))
+               (set! changes '())
+               (set! dirty? #f)))
+
+         ;; TODO: maybe add a means of setting target frame rate?
+         ;; (define/public (set-target-frame-rate! r)
+         ;;   (set! target-frame-rate r))
+
+         (on (asserted (scene $sealed-prelude $sealed-postlude))
+             (send c replace-scene!
+                   (seal-contents sealed-prelude)
+                   (seal-contents sealed-postlude))
+             (set! dirty? #t))
+
+         (on (retracted ($ s (sprite _ _ _ _)))
+             (set! changes (cons (cons '- s) changes))
+             (set! dirty? #t))
+         (on (asserted ($ s (sprite _ _ _ _)))
+             (set! changes (cons (cons '+ s) changes))
+             (set! dirty? #t))
+
+         (on (message (gl-control 'stop))
+             (send frame show #f)
+             (stop-current-facet))
+
+         (during (gl-control 'fullscreen)
+           (on-start (send frame fullscreen #t))
+           (on-stop  (send frame fullscreen #f)))
+
+         ))
diff --git a/syndicate/examples/gl-2d-basic.rkt b/syndicate/examples/gl-2d-basic.rkt
new file mode 100644
index 0000000..990c1f5
--- /dev/null
+++ b/syndicate/examples/gl-2d-basic.rkt
@@ -0,0 +1,133 @@
+#lang imperative-syndicate
+
+(require racket/set)
+(require 2htdp/image)
+(require/activate imperative-syndicate/drivers/gl-2d)
+
+(define (spawn-background)
+  (spawn (during (window $width $height)
+           (assert-scene `((push-matrix (scale ,width ,(* height 2))
+                                        (translate 0 -0.25)
+                                        (texture
+                                         ,(overlay/xy (rectangle 1 1 "solid" "white")
+                                                      0 0
+                                                      (rectangle 1 2 "solid" "black"))))
+                           ;; (rotate -30)
+                           ;; (scale 5 5)
+                           )
+                         `()))))
+
+(define (draggable-mixin touching? x y)
+  (define (idle)
+    (react (stop-when #:when (touching?)
+                      (message (mouse-event 'left-down (mouse-state $mx $my _ _ _)))
+                      (log-info "idle -> dragging; in-script? ~v" (in-script?))
+                      (dragging (- mx (x)) (- my (y))))))
+
+  (define (dragging dx dy)
+    (react (on (message (mouse-event 'motion (mouse-state $mx $my _ _ _)))
+               (x (- mx dx))
+               (y (- my dy)))
+           (stop-when (message (mouse-event 'left-up _)) (idle))
+           (stop-when (message (mouse-event 'leave _)) (idle))))
+
+  (idle))
+
+(define (draggable-shape name orig-x orig-y z plain-image hover-image
+                         #:coordinate-map-id [coordinate-map-id #f]
+                         #:parent [parent-id #f])
+  (spawn (field [x orig-x] [y orig-y])
+         (define/query-value touching? #f (touching name) #t)
+         (assert (simple-sprite #:parent parent-id
+                                #:coordinate-map-id coordinate-map-id
+                                #:touchable-id name
+                                #:touchable-predicate in-unit-circle?
+                                z (x) (y) 50 50
+                                (if (touching?)
+                                    hover-image
+                                    plain-image)))
+         (on-start (draggable-mixin touching? x y))))
+
+(define (tooltip touching? x y w h label-string)
+  (define label-text (text label-string 22 "black"))
+  (define label (overlay label-text (empty-scene (+ (image-width label-text) 10)
+                                                 (+ (image-height label-text) 10))))
+  (define (pos)
+    (define v (- (x) (image-width label) 10))
+    (if (negative? v)
+        (+ (x) w 10)
+        v))
+  (react (assert #:when (touching?)
+                 (simple-sprite -10
+                                (pos)
+                                (+ (y) (* 1/2 h) (- (* 1/2 (image-height label))))
+                                (image-width label)
+                                (image-height label)
+                                label))))
+
+(define (spawn-player-avatar)
+  (local-require 2htdp/planetcute)
+  (define CC character-cat-girl)
+
+  (spawn (field [x 100] [y 100])
+         (assert (simple-sprite #:touchable-id 'player
+                                #:coordinate-map-id 'player
+                                -0.5 (x) (y) (image-width CC) (image-height CC) CC))
+
+         (field [keys-down (set)])
+         (on (asserted (key-pressed $k)) (keys-down (set-add (keys-down) k)))
+         (on (retracted (key-pressed $k)) (keys-down (set-remove (keys-down) k)))
+         (define (key->delta k distance) (if (set-member? (keys-down) k) distance 0))
+
+         (define/query-value touching? #f (touching 'player) #t)
+         (on-start (draggable-mixin touching? x y))
+
+         (on (asserted (coordinate-map 'player $xform))
+             ;; TODO: figure out why this causes lag in frame updates
+             (log-info "Player coordinate map: ~v" xform))
+
+         (on-start (tooltip touching? x y (image-width CC) (image-height CC) "The Player"))
+
+         (on (message (frame-event _ _ $elapsed-ms _))
+             (define-values (old-x old-y) (values (x) (y)))
+             (define distance (* 0.360 elapsed-ms))
+             (define nx (+ old-x (key->delta 'right distance) (key->delta 'left (- distance))))
+             (define ny (+ old-y (key->delta 'down distance) (key->delta 'up (- distance))))
+             (when (not (and (= nx old-x) (= ny old-y)))
+               (x nx)
+               (y ny)))))
+
+(define (spawn-frame-counter)
+  (spawn (field [i empty-image])
+         (assert (simple-sprite -10 300 10 (image-width (i)) (image-height (i)) (i)))
+         (on (message (frame-event $counter $sim-time-ms _ _))
+             (when (> sim-time-ms 0)
+               (define fps (/ counter (/ sim-time-ms 1000.0)))
+               (i (text (format "~a fps" fps) 22 "black"))))))
+
+(spawn-keyboard-integrator)
+(spawn-mouse-integrator)
+(spawn-background)
+;; (spawn-frame-counter)
+(spawn-player-avatar)
+
+(draggable-shape 'orange 50 50 0
+                 (circle 50 "solid" "orange")
+                 (circle 50 "solid" "red"))
+
+(draggable-shape 'yellow 10 -10 0 #:parent 'orange
+                 (circle 50 "solid" "yellow")
+                 (circle 50 "solid" "purple"))
+
+(draggable-shape 'green 60 60 -1
+                 (circle 50 "solid" "green")
+                 (circle 50 "solid" "cyan"))
+
+(spawn* (until (message (key-event #\q #t _)))
+        (assert! (gl-control 'stop)))
+
+(spawn (during (touching $id)
+               (on-start (log-info "Touching ~v" id))
+               (on-stop (log-info "No longer touching ~v" id))))
+
+(spawn-gl-2d-driver)
diff --git a/syndicate/examples/gl-2d-many.rkt b/syndicate/examples/gl-2d-many.rkt
new file mode 100644
index 0000000..e293223
--- /dev/null
+++ b/syndicate/examples/gl-2d-many.rkt
@@ -0,0 +1,84 @@
+#lang imperative-syndicate
+;; Multiple animated sprites.
+;;
+;; 2018-05-01 With the new "imperative" implementation of Syndicate,
+;; the same 2.6GHz laptop mentioned below can animate 135 logos in a
+;; 640x480 window at 60 fps on a single core, with a bit of headroom
+;; to spare.
+;;
+;; 2016-12-12 With the current implementations of (a) Syndicate's
+;; dataspaces and (b) Syndicate's 2D sprite support, my reasonably new
+;; 2.6GHz laptop can animate 20 logos at 256x256 pixels at about 20
+;; frames per second on a single core.
+;;
+;; For comparison, Kay recounts in "The Early History of Smalltalk"
+;; (1993) that "by the Fall of '73 [Steve Purcell] could demo 80
+;; ping-pong balls and 10 flying horses running at 10 frames per
+;; second in 2 1/2 D" in an early Smalltalk (?) on a NOVA.
+
+(require 2htdp/image)
+(require images/logos)
+(require/activate imperative-syndicate/drivers/gl-2d)
+
+(define speed-limit 40)
+(define sprite-count 135)
+
+(define (spawn-background)
+  (spawn
+   (during (window $width $height)
+     (assert-scene `((push-matrix (scale ,width ,height)
+                                  (texture ,(rectangle 1 1 "solid" "white"))))
+                   `()))))
+
+(define i:logo (plt-logo))
+(define i:logo-width (image-width i:logo))
+(define i:logo-height (image-height i:logo))
+
+(define (spawn-logo)
+  (spawn (field [x 100] [y 100])
+         (field [dx (* (- (random) 0.5) speed-limit)]
+                [dy (* (- (random) 0.5) speed-limit)])
+         (define/query-value w #f ($ w (window _ _)) w)
+         (assert (simple-sprite 0
+                                (x)
+                                (y)
+                                i:logo-width
+                                i:logo-height
+                                i:logo))
+         (define (bounce f df limit)
+           (define v (f))
+           (define limit* (- limit i:logo-width))
+           (cond [(< v 0) (f 0) (df (abs (df)))]
+                 [(> v limit*) (f limit*) (df (- (abs (df))))]
+                 [else (void)]))
+         (on (message (frame-event _ _ _ _))
+             (when (w) ;; don't animate until we know the window bounds
+               (x (+ (x) (dx)))
+               (y (+ (y) (dy)))
+               (bounce x dx (window-width (w)))
+               (bounce y dy (window-height (w)))))))
+
+(spawn-background)
+(for [(i sprite-count)]
+  (spawn-logo))
+
+(spawn (define start-time #f)
+       (log-info "Sprite count: ~a" sprite-count)
+       (on (message (frame-event $counter $timestamp _ _))
+           (if (eq? start-time #f)
+               (set! start-time (current-inexact-milliseconds))
+               (let ((delta (- (current-inexact-milliseconds) start-time)))
+                 (when (and (zero? (modulo counter 100)) (positive? delta))
+                   (log-info "~v frames, ~v ms ==> ~v Hz"
+                             counter
+                             delta
+                             (/ counter (/ delta 1000.0))))))))
+
+(spawn-gl-2d-driver)
+
+(spawn (field [fullscreen? #f])
+       (on (message (key-event #\f #t _)) (fullscreen? (not (fullscreen?))))
+       (assert #:when (fullscreen?) (gl-control 'fullscreen))
+
+       (on (message (key-event #\q #t _))
+           (send! (gl-control 'stop))))