diff --git a/info.rkt b/info.rkt
new file mode 100644
index 0000000..e177f42
--- /dev/null
+++ b/info.rkt
@@ -0,0 +1,10 @@
+#lang setup/infotab
+(define collection 'multi)
+(define deps '("prospect"
+	       "base"
+	       "data-lib"
+	       "gui-lib"
+	       "htdp-lib"
+	       "pict-lib"
+	       "sgl"
+	       ))
diff --git a/racket/prospect-gl/2d.rkt b/racket/prospect-gl/2d.rkt
new file mode 100644
index 0000000..ce3d661
--- /dev/null
+++ b/racket/prospect-gl/2d.rkt
@@ -0,0 +1,407 @@
+#lang racket/gui
+
+(provide (struct-out window)
+         (struct-out frame-event)
+         (struct-out key-event)
+         (struct-out key-pressed)
+         (struct-out scene)
+         (except-out (struct-out sprite) sprite)
+         (rename-out [sprite <sprite>] [make-sprite sprite])
+         (struct-out request-gc)
+         simple-sprite
+         update-scene
+         update-sprites
+         spawn-keyboard-integrator
+         2d-network)
+
+(require data/order)
+(require data/splay-tree)
+(require data/queue)
+(require sgl/gl)
+(require sgl/gl-vectors)
+
+(require (prefix-in image: 2htdp/image))
+(require (prefix-in pict: pict))
+
+(require prospect)
+(require prospect/trie)
+(require prospect/ground)
+
+(require "texture.rkt")
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+;; Shared state maintained by network. Describes current window dimensions.
+(struct window (width height) #:transparent)
+
+;; Message sent by network. Describes frame about to be rendered.
+(struct frame-event (counter timestamp elapsed-ms target-frame-rate) #:transparent)
+
+;; Message sent by network. 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.
+(struct key-event (code press? key) #:transparent)
+
+;; Assertion. Indicates that the named key is held down. See role
+;; KeyboardIntegrator and spawn-keyboard-integrator.
+(struct key-pressed (code) #:transparent)
+
+;; 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.
+(struct scene (prelude postlude) #:transparent)
+
+;; Shared state maintained by program. Z is to be a number, negative
+;; toward camera. Instructions to be a sealed instruction list.
+(struct sprite (z instructions) #:transparent)
+
+;; Message. Requests that the OpenGL loop perform a major
+;; garbage-collection while *pausing the simulation's real-time
+;; correspondence*. This lets a GC take place without such severe
+;; simulation glitches as happen when doing it in-world.
+(struct request-gc () #:transparent)
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(define (update-scene prelude postlude #:meta-level [meta-level 1])
+  (patch-seq (retract (scene ? ?) #:meta-level meta-level)
+             (assert (scene (seal prelude) (seal postlude)) #:meta-level meta-level)))
+
+(define (make-sprite z instructions)
+  (sprite z (seal instructions)))
+
+(define (simple-sprite z x y w h i)
+  (make-sprite z `((translate ,x ,y)
+                   (scale ,w ,h)
+                   (texture ,i))))
+
+(define (update-sprites #:meta-level [meta-level 1] . ss)
+  (patch-seq* (cons (retract (sprite ? ?) #:meta-level meta-level)
+                    (map (lambda (s) (assert s #:meta-level meta-level)) ss))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+;; KeyboardIntegrator. Integrates key-events into key-pressed assertions.
+(define (spawn-keyboard-integrator #:meta-level [meta-level 1])
+  (spawn (lambda (e s)
+           (match e
+             [(message (at-meta (key-event code press? _)))
+              (transition (void) ((if press? assert retract) (key-pressed code)))]
+             [#f #f]))
+         (void)
+         (sub (key-event ? ? ?) #:meta-level meta-level)))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(struct compiled-instructions (render-thunk resources))
+
+(define-namespace-anchor ns-anchor)
+(define ns (namespace-anchor->namespace ns-anchor))
+
+(define (compile-instructions instrs)
+  (define-values (code resources) (instruction->racket-code `(begin ,@instrs)))
+  (define render-thunk (eval `(lambda () ,code) ns))
+  (compiled-instructions render-thunk resources))
+
+(define (compiled-instructions-dispose! i)
+  (when i
+    (for [(resource (compiled-instructions-resources i))]
+      (send resource dispose))))
+
+(define (instructions->racket-code instrs)
+  (define-values (code-rev resources)
+    (for/fold [(code-rev '()) (resources '())] [(instr (in-list instrs))]
+      (define-values (new-code new-resources) (instruction->racket-code instr))
+      (values (cons new-code code-rev) (append new-resources resources))))
+  (values (reverse code-rev) resources))
+
+(define (color-number? n)
+  (and (number? n)
+       (<= 0.0 n 1.0)))
+
+(define (instruction->racket-code instr)
+  (match instr
+    [`(rotate ,(? number? deg))
+     (values `(glRotated ,deg 0 0 -1) '())]
+    [`(scale ,(? number? x) ,(? number? y))
+     (values `(glScaled ,x ,y 1) '())]
+    [`(translate ,(? number? x) ,(? number? y))
+     (values `(glTranslated ,x ,y 0) '())]
+    [`(color ,(? color-number? r) ,(? color-number? g) ,(? color-number? b) ,(? color-number? a))
+     (values `(glColor4d ,r ,g ,b ,a) '())]
+    [`(texture ,i)
+     (define entry (image->texture-cache-entry i))
+     (values `(draw-gl-face ,(send entry get-texture)) (list entry))]
+    [`(push-matrix ,instr ...)
+     (define-values (code resources) (instructions->racket-code instr))
+     (values `(begin (glPushMatrix) ,@code (glPopMatrix)) resources)]
+    [`(begin ,instr ...)
+     (define-values (code resources) (instructions->racket-code instr))
+     (values `(begin ,@code (void)) resources)]
+    [other
+     (error 'instruction->racket-code "unknown render instruction: ~v" other)]))
+
+(define (image->bitmap i)
+  (cond
+    [(is-a? i bitmap%)
+     i]
+    [(image:image? i)
+     (define w (image:image-width i))
+     (define h (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)
+  (send texture bind-texture)
+  (glBegin GL_QUADS)
+  (glNormal3d 0 0 -1)
+  (glTexCoord2i 0 0)
+  (glVertex3d 0 0 0)
+  (glTexCoord2i 1 0)
+  (glVertex3d 1 0 0)
+  (glTexCoord2i 1 1)
+  (glVertex3d 1 1 0)
+  (glTexCoord2i 0 1)
+  (glVertex3d 0 1 0)
+  (glEnd))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(define empty-instructions (compile-instructions '()))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(define scene-projection (?! (scene ? ?)))
+(define sprite-projection (?! (sprite ? ?)))
+
+(define sprite-order
+  (order 'sprite-order
+         sprite?
+         (lambda (a b) (and (= (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))
+                                (< (eq-hash-code (sprite-instructions a))
+                                   (eq-hash-code (sprite-instructions b))))))))
+
+(define (remove-sprite! sprites s)
+  (compiled-instructions-dispose! (splay-tree-ref sprites s #f))
+  (splay-tree-remove! sprites s))
+
+(define (add-sprite! sprites s)
+  (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 (render-scene! prelude sprites postlude)
+  ((compiled-instructions-render-thunk prelude))
+  (let loop ((iter (splay-tree-iterate-first sprites)))
+    (when iter
+      ((compiled-instructions-render-thunk (splay-tree-iterate-value sprites iter)))
+      (loop (splay-tree-iterate-next sprites iter))))
+  ((compiled-instructions-render-thunk postlude)))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(define network-canvas%
+  (class canvas%
+    (inherit refresh with-gl-context swap-gl-buffers)
+
+    (init boot-actions)
+
+    (define counter 0)
+    (define start-time (current-inexact-milliseconds))
+    (define prev-frame-time start-time)
+    (define/public (sim-time)
+      (- (current-inexact-milliseconds) start-time))
+
+    (define initialised? #f)
+
+    (define near-depth 10) ;; 2.5D
+    (define far-depth 15) ;; 2.5D
+
+    (define prelude empty-instructions)
+    (define sprites (make-splay-tree sprite-order))
+    (define postlude empty-instructions)
+    (define fullscreen? #f)
+
+    (define network (make-network boot-actions))
+    (define event-queue (make-queue))
+
+    (define target-frame-rate 60)
+
+    ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+    (define (sleep-and-refresh)
+      (define target-sim-time (* counter (/ target-frame-rate)))
+      (define sleep-time (- target-sim-time (/ (sim-time) 1000.0)))
+      (when (positive? sleep-time)
+        (sleep/yield sleep-time))
+      (refresh))
+
+    (define/public (set-target-frame-rate! r)
+      (set! target-frame-rate r))
+
+    ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+    (define (inject-event! e)
+      (enqueue! event-queue e))
+
+    (define (deliver-event e)
+      (clean-transition (network-handle-event e network)))
+
+    (define (quiesce!)
+      (let loop ((txn #f) (need-poll? #t))
+        (match txn
+          [#f ;; inert
+           (if (queue-empty? event-queue)
+               (when need-poll? (loop (deliver-event #f) #f))
+               (loop (deliver-event (dequeue! event-queue)) #t))]
+          [(transition new-network actions)
+           (set! network new-network)
+           (for-each process-action! actions)
+           (loop #f #t)])))
+
+    (define (process-action! a)
+      (match a
+        [(? patch? p)
+         (process-scene-updates! p)
+         (process-sprite-updates! p)
+         (process-stop-requests! p)
+         (process-fullscreen-requests! p)]
+        [(message (request-gc))
+         (perform-gc-request!)]
+        [(message _) (void)]))
+
+    (define (process-scene-updates! p)
+      (define-values (added removed) (patch-project/set/single p scene-projection))
+      (when (not (set-empty? removed))
+        (compiled-instructions-dispose! prelude)
+        (compiled-instructions-dispose! postlude)
+        (set! prelude empty-instructions)
+        (set! postlude empty-instructions))
+      (for [(s added)]
+        (match-define (scene (seal pre) (seal post)) s)
+        (set! prelude (compile-instructions pre))
+        (set! postlude (compile-instructions post))))
+
+    (define (process-sprite-updates! p)
+      (define-values (added removed) (patch-project/set/single p sprite-projection))
+      ;; Remove old sprites first, to recycle their texture identifiers (if any)
+      (for [(s removed)] (remove-sprite! sprites s))
+      (for [(s added)] (add-sprite! sprites s))
+      ;; (log-info "~a sprites" (splay-tree-count sprites))
+      (flush-texture-cache!))
+
+    (define (process-stop-requests! p)
+      (when (trie-lookup (patch-added p) 'stop #f)
+        (send (send this get-top-level-window) show #f)))
+
+    (define (process-fullscreen-requests! p)
+      (define changed? #f)
+      (when (trie-lookup (patch-removed p) 'fullscreen #f)
+        (set! changed? #t)
+        (set! fullscreen? #f))
+      (when (trie-lookup (patch-added p) 'fullscreen #f)
+        (set! changed? #t)
+        (set! fullscreen? #t))
+      (when changed?
+        (send (send this get-top-level-window) fullscreen fullscreen?)))
+
+    (define (perform-gc-request!)
+      (define pre-gc (current-inexact-milliseconds))
+      (collect-garbage 'major)
+      (define post-gc (current-inexact-milliseconds))
+      (define delta (- post-gc pre-gc))
+      (log-info "(request-gc) took ~a milliseconds" delta)
+      (set! start-time (+ start-time delta)))
+
+    ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+    (define/override (on-paint)
+      (with-gl-context
+        (lambda ()
+          (let ((this-frame-time (sim-time)))
+            (inject-event! (message (frame-event counter
+                                                 this-frame-time
+                                                 (- this-frame-time prev-frame-time)
+                                                 target-frame-rate)))
+            (set! counter (+ counter 1))
+            (set! prev-frame-time this-frame-time))
+          (quiesce!)
+          (unless initialised?
+            (glBlendFunc GL_ONE GL_ONE_MINUS_SRC_ALPHA) ;; premultiplied
+            (glEnable GL_BLEND)
+            (glEnable GL_TEXTURE_2D)
+            (glClearColor 0 0 0 1)
+            (set! initialised? #t))
+          (glClear GL_COLOR_BUFFER_BIT)
+          (glLoadIdentity)
+          (glTranslated 0 0 (- near-depth))
+          (render-scene! prelude sprites postlude)
+          (glFlush)
+          (swap-gl-buffers)))
+      (queue-callback (lambda () (sleep-and-refresh)) #f))
+
+    (define/override (on-size width height)
+      (with-gl-context
+        (lambda ()
+          (inject-event! (patch-seq (retract (window ? ?))
+                                    (assert (window width height))))
+          (quiesce!)
+          (glViewport 0 0 width height)
+          (glMatrixMode GL_PROJECTION)
+          (glLoadIdentity)
+          (glOrtho 0 width height 0 0.1 100)
+          (glMatrixMode GL_MODELVIEW)
+          (glLoadIdentity)))
+      (refresh))
+
+    (define/override (on-char key)
+      (with-gl-context
+        (lambda ()
+          (inject-event!
+           (message
+            (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))])))
+          (quiesce!))))
+
+    (super-new (style '(gl no-autoclear)))))
+
+(define (2d-network #:width [width #f]
+                    #:height [height #f]
+                    . boot-actions)
+  (collect-garbage 'incremental)
+  (collect-garbage 'major)
+  (define frame (new frame%
+                     [style '(fullscreen-button)]
+                     [label "prospect-gl"]
+                     [width (or width 640)]
+                     [height (or height 480)]))
+  (define c (new network-canvas%
+                 [parent frame]
+                 [boot-actions boot-actions]))
+  (unless (send (send (send c get-dc) get-gl-context) ok?)
+    (error '2d-network "OpenGL context failed to initialize"))
+  (send c focus)
+  (send frame show #t)
+  (yield 'wait))
diff --git a/racket/prospect-gl/TODO.md b/racket/prospect-gl/TODO.md
new file mode 100644
index 0000000..8663c61
--- /dev/null
+++ b/racket/prospect-gl/TODO.md
@@ -0,0 +1,2 @@
+ - Some way of adjusting target frame rate based on whether we're
+   achieving the goal or not; e.g. fall back from 60Hz to 24Hz
diff --git a/racket/prospect-gl/examples/basic.rkt b/racket/prospect-gl/examples/basic.rkt
new file mode 100644
index 0000000..6251183
--- /dev/null
+++ b/racket/prospect-gl/examples/basic.rkt
@@ -0,0 +1,96 @@
+#lang racket
+
+(require prospect)
+(require 2htdp/image)
+(require "../2d.rkt")
+
+(define window-projection (at-meta (?! (window ? ?))))
+(define key-pressed-projection (key-pressed (?!)))
+
+(define (spawn-background)
+  (spawn (lambda (e s)
+           (match e
+             [(? patch? p)
+              (define-values (added removed) (patch-project/set/single p window-projection))
+              (transition s (for/list [(w added)]
+                              (match-define (window width height) w)
+                              (update-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)
+                                              )
+                                            `())))]
+             [_ #f]))
+         (void)
+         (patch-seq
+          (sub (window ? ?) #:meta-level 1)
+          ;; (assert 'fullscreen #:meta-level 1)
+          )))
+
+(define (spawn-player-avatar)
+  (local-require 2htdp/planetcute)
+  (define CC character-cat-girl)
+  (define (move-to x y keys-down)
+    (transition (list x y keys-down)
+                (update-sprites
+                 (simple-sprite 0 x y (image-width CC) (image-height CC) CC))))
+  (spawn (lambda (e s)
+           (match-define (list x y keys-down) s)
+           (match e
+             [(? patch? p)
+              (define-values (added removed)
+                (patch-project/set/single p key-pressed-projection))
+              (define new-keys-down (set-subtract (set-union keys-down added) removed))
+              (transition (list x y new-keys-down) '())]
+             [(message (at-meta (frame-event _ _ elapsed-ms _)))
+              (define-values (old-x old-y) (values x y))
+              (define distance (* 0.360 elapsed-ms))
+              (let* ((x (if (set-member? keys-down 'left) (- x distance) x))
+                     (x (if (set-member? keys-down 'right) (+ x distance) x))
+                     (y (if (set-member? keys-down 'up) (- y distance) y))
+                     (y (if (set-member? keys-down 'down) (+ y distance) y)))
+                (and (not (and (= x old-x) (= y old-y)))
+                     (move-to x y keys-down)))]
+             [_ #f]))
+         (list 100 100 (set))
+         (patch-seq
+          (update-sprites
+           (simple-sprite -0.5 100 100 (image-width CC) (image-height CC) CC))
+          (sub (frame-event ? ? ? ?) #:meta-level 1)
+          (sub (key-pressed ?)))))
+
+(define (spawn-frame-counter)
+  (spawn (lambda (e s)
+           (match e
+             [(message (at-meta (frame-event counter sim-time-ms _ _)))
+              (and (> sim-time-ms 0)
+                   (let ((i (text (format "~a fps" (/ counter (/ sim-time-ms 1000.0))) 22 "black")))
+                     (transition s (update-sprites (simple-sprite -10 300 10
+                                                                  (image-width i)
+                                                                  (image-height i)
+                                                                  i)))))]
+             [_ #f]))
+         (void)
+         (sub (frame-event ? ? ? ?) #:meta-level 1)))
+
+(2d-network (spawn-keyboard-integrator)
+            (spawn-background)
+            ;; (spawn-frame-counter)
+            (spawn-player-avatar)
+            (spawn (lambda (e s) #f)
+                   (void)
+                   (update-sprites (simple-sprite 0 50 50 50 50 (circle 50 "solid" "orange"))
+                                   (simple-sprite -1 60 60 50 50 (circle 50 "solid" "green"))))
+            (spawn (lambda (e s)
+                     (match e
+                       [(message _)
+                        (transition s (assert 'stop #:meta-level 1))]
+                       [_ #f]))
+                   (void)
+                   (sub (key-event #\q #t ?) #:meta-level 1))
+            )
+(exit 0)
diff --git a/racket/prospect-gl/texture.rkt b/racket/prospect-gl/texture.rkt
new file mode 100644
index 0000000..451a7a7
--- /dev/null
+++ b/racket/prospect-gl/texture.rkt
@@ -0,0 +1,111 @@
+#lang racket/gui
+
+(provide texture%
+         texture-cache-get
+         flush-texture-cache!)
+
+(require sgl/gl)
+(require sgl/gl-vectors)
+
+(define texture%
+  (class object%
+    (init [(initial-bitmap bitmap)])
+    (field [width 0]
+           [height 0]
+           [textures #f])
+
+    (define/public (get-width) width)
+    (define/public (get-height) height)
+
+    (define/public (bind-texture)
+      (when (not textures) (error 'bind-texture "Attempt to use disposed texture%"))
+      (glBindTexture GL_TEXTURE_2D (gl-vector-ref textures 0)))
+
+    (define/public (load-from-bitmap! bitmap)
+      (when textures (dispose))
+      (set! textures (glGenTextures 1))
+      (bind-texture)
+      (define image-data
+        (let ()
+          (set! width (send bitmap get-width))
+          (set! height (send bitmap get-height))
+          (define dc (new bitmap-dc% [bitmap bitmap]))
+          (define pixels (* width height))
+          (define vec (make-gl-ubyte-vector (* pixels 4)))
+          (define data (make-bytes (* pixels 4)))
+          (send dc get-argb-pixels 0 0 width height data #f #t) ;; premultiplied
+          (for ((i (in-range pixels)))
+            (for ((j (in-range 4)))
+              (gl-vector-set! vec (+ (* i 4) j) (bytes-ref data (+ (* i 4) (- 3 j))))))
+          vec))
+      (glTexParameteri GL_TEXTURE_2D GL_TEXTURE_MIN_FILTER GL_LINEAR)
+      (glTexParameteri GL_TEXTURE_2D GL_TEXTURE_MAG_FILTER GL_LINEAR)
+      (glTexImage2D GL_TEXTURE_2D 0 4 width height 0 GL_BGRA GL_UNSIGNED_BYTE image-data))
+
+    (define/public (dispose)
+      (when textures
+        (glDeleteTextures textures)
+        (set! textures #f)))
+
+    (super-new)
+    (load-from-bitmap! initial-bitmap)))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(define texture-cache (make-hasheq))
+(define texture-second-chances (make-hasheq))
+(define last-flush 0)
+
+(define entry%
+  (class object%
+    (init-field key
+                texture)
+    (super-new)
+    (define ref-count 0)
+
+    (define/public (get-texture)
+      texture)
+
+    (define/public (inc-ref-count!)
+      (set! ref-count (+ ref-count 1)))
+
+    (define/public (dispose)
+      (set! ref-count (- ref-count 1))
+      (when (zero? ref-count)
+        ;; (log-info "releasing texture cache entry for ~a" key)
+        (hash-remove! texture-cache key)
+        (hash-set! texture-second-chances key this)))
+
+    (define/public (*cleanup)
+      (send texture dispose))))
+
+(define (texture-cache-get key key->bitmap)
+  (define entry
+    (hash-ref texture-cache
+              key
+              (lambda ()
+                (define t (cond
+                            [(hash-has-key? texture-second-chances key)
+                             ;; (log-info "recycling texture cache entry for ~a" key)
+                             (define t (hash-ref texture-second-chances key))
+                             (hash-remove! texture-second-chances key)
+                             t]
+                            [else
+                             (define bm (key->bitmap key))
+                             ;; (log-info "allocating new texture cache entry for ~a" key)
+                             (new entry% [key key] [texture (new texture% [bitmap bm])])]))
+                (hash-set! texture-cache key t)
+                t)))
+  (send entry inc-ref-count!)
+  entry)
+
+(define (flush-texture-cache!)
+  (define now (current-seconds))
+  ;; (log-info "~a cache entries, ~a second-chances"
+  ;;           (hash-count texture-cache)
+  ;;           (hash-count texture-second-chances))
+  (when (> now (+ last-flush 10))
+    ;; (log-info "flushing texture cache (~a entries)" (hash-count texture-second-chances))
+    (for [(entry (in-hash-values texture-second-chances))] (send entry *cleanup))
+    (hash-clear! texture-second-chances)
+    (set! last-flush now)))