display: WIP: Refactor into files; use wishes, not Display::

Expose shader stuff to user programs for the first time. Mostly
works, but display thread and main thread run much slower (28fps
display, 70fps main).

Also introduce dict getwithdefault (helpful for rest options).

20 files changed, 441 insertions, 442 deletions

diff --git a/virtual-programs/archive/calibration-overlays.folk b/virtual-programs/_archive/calibration-overlays.folk
index 6575168d..6575168d 100644
--- a/virtual-programs/archive/calibration-overlays.folk
+++ b/virtual-programs/_archive/calibration-overlays.folk
diff --git a/virtual-programs/archive/hello-name.folk b/virtual-programs/_archive/hello-name.folk
index be31ba5c..be31ba5c 100644
--- a/virtual-programs/archive/hello-name.folk
+++ b/virtual-programs/_archive/hello-name.folk
diff --git a/virtual-programs/archive/highlight.folk b/virtual-programs/_archive/highlight.folk
index 768e4bc9..768e4bc9 100644
--- a/virtual-programs/archive/highlight.folk
+++ b/virtual-programs/_archive/highlight.folk
diff --git a/virtual-programs/archive/log.folk b/virtual-programs/_archive/log.folk
index 872f3fe2..872f3fe2 100644
--- a/virtual-programs/archive/log.folk
+++ b/virtual-programs/_archive/log.folk
diff --git a/virtual-programs/archive/metrics.folk b/virtual-programs/_archive/metrics.folk
index e5389512..e5389512 100644
--- a/virtual-programs/archive/metrics.folk
+++ b/virtual-programs/_archive/metrics.folk
diff --git a/virtual-programs/archive/points-up-test.folk b/virtual-programs/_archive/points-up-test.folk
index c4fcff4d..c4fcff4d 100644
--- a/virtual-programs/archive/points-up-test.folk
+++ b/virtual-programs/_archive/points-up-test.folk
diff --git a/virtual-programs/archive/points-up.folk b/virtual-programs/_archive/points-up.folk
index e5c12126..e5c12126 100644
--- a/virtual-programs/archive/points-up.folk
+++ b/virtual-programs/_archive/points-up.folk
diff --git a/virtual-programs/archive/test.folk b/virtual-programs/_archive/test.folk
index 9b5c75f0..9b5c75f0 100644
--- a/virtual-programs/archive/test.folk
+++ b/virtual-programs/_archive/test.folk
diff --git a/virtual-programs/archive/welcome.folk b/virtual-programs/_archive/welcome.folk
index 6c08ed47..6c08ed47 100644
--- a/virtual-programs/archive/welcome.folk
+++ b/virtual-programs/_archive/welcome.folk
diff --git a/virtual-programs/apriltags.folk b/virtual-programs/apriltags.folk
index b23f2bdc..49b83e5a 100644
--- a/virtual-programs/apriltags.folk
+++ b/virtual-programs/apriltags.folk
@@ -3,7 +3,7 @@ if {$::isLaptop} return
 set tagfamily "tagStandard52h13"
 
 # Plain detector. Runs on entire camera frame.
-set mainDetectorProcess [On process {
+set mainDetectorProcess [Start process {
     source pi/AprilTags.tcl
 
     Wish $::thisProcess receives statements like \
@@ -22,7 +22,7 @@ set mainDetectorProcess [On process {
 
 # Incremental detector. Looks at regions where there were tags in the
 # old camera frame.
-On process {
+Start process {
     source pi/AprilTags.tcl
 
     Wish $::thisProcess receives statements like \
diff --git a/virtual-programs/camera.folk b/virtual-programs/camera.folk
index 46daa52e..f997d419 100644
--- a/virtual-programs/camera.folk
+++ b/virtual-programs/camera.folk
@@ -14,7 +14,7 @@ if {$::thisNode eq "folk-interact"} {
 set width $::Camera::WIDTH
 set height $::Camera::HEIGHT
 
-On process {
+Start process "camera" {
     Wish $::thisProcess shares statements like \
         [list /someone/ claims the camera /...anything/]
 
diff --git a/virtual-programs/display.folk b/virtual-programs/display.folk
index aed9d51d..0cfc63b2 100644
--- a/virtual-programs/display.folk
+++ b/virtual-programs/display.folk
@@ -25,459 +25,102 @@ namespace eval ::Display {
     }
 }
 
-On process {
+
+namespace eval Colors { source "pi/Colors.tcl" }
+proc ::getColor {color} {
+    if {[info exists Colors::$color]} { return [set Colors::$color] } \
+        else { return $Colors::white }
+}
+
+Start process "display" {
     puts "Display pid: [pid]"
 
     source pi/Gpu.tcl
     Gpu::init
     Gpu::ImageManager::imageManagerInit
 
-    namespace eval Display {
-        namespace eval Colors { source "pi/Colors.tcl" }
-
-        variable rotate [Gpu::fn {vec2 v float a} vec2 {
-            float s = sin(a);
-            float c = cos(a);
-            mat2 m = mat2(c, s, -s, c);
-            return m * v;
-        }]
-        variable cross2d [Gpu::fn {vec2 a vec2 b} float {
-            return a.x*b.y - a.y*b.x;
-        }]
-        # See https://www.shadertoy.com/view/lsBSDm
-        variable invBilinear [Gpu::fn {vec2 p vec2 a vec2 b vec2 c vec2 d fn cross2d} vec2 {
-            vec2 res = vec2(-1.0);
-
-            vec2 e = b-a;
-            vec2 f = d-a;
-            vec2 g = a-b+c-d;
-            vec2 h = p-a;
-            
-            float k2 = cross2d( g, f );
-            float k1 = cross2d( e, f ) + cross2d( h, g );
-            float k0 = cross2d( h, e );
-
-            // if edges are parallel, this is a linear equation
-            k2 /= k0; k1 /= k0; k0 = 1.0;
-            if(  abs(k2)<0.001*abs(k0) )
+    # TODO: Share these functions through the database somehow,
+    # instead of keeping them in globals.
+
+    set ::rotate [Gpu::fn {vec2 v float a} vec2 {
+        float s = sin(a);
+        float c = cos(a);
+        mat2 m = mat2(c, s, -s, c);
+        return m * v;
+    }]
+    set ::cross2d [Gpu::fn {vec2 a vec2 b} float {
+        return a.x*b.y - a.y*b.x;
+    }]
+    # See https://www.shadertoy.com/view/lsBSDm
+    set ::invBilinear [Gpu::fn {vec2 p vec2 a vec2 b vec2 c vec2 d fn ::cross2d} vec2 {
+        vec2 res = vec2(-1.0);
+
+        vec2 e = b-a;
+        vec2 f = d-a;
+        vec2 g = a-b+c-d;
+        vec2 h = p-a;
+
+        float k2 = cross2d( g, f );
+        float k1 = cross2d( e, f ) + cross2d( h, g );
+        float k0 = cross2d( h, e );
+
+        // if edges are parallel, this is a linear equation
+        k2 /= k0; k1 /= k0; k0 = 1.0;
+        if(  abs(k2)<0.001*abs(k0) )
+        {
+            res = vec2( (h.x*k1+f.x*k0)/(e.x*k1-g.x*k0), -k0/k1 );
+        }
+        // otherwise, it's a quadratic
+        else
+        {
+            float w = k1*k1 - 4.0*k0*k2;
+            if( w<0.0 ) return vec2(-1.0);
+            w = sqrt( w );
+
+            float ik2 = 0.5/k2;
+            float v = (-k1 - w)*ik2;
+            float u = (h.x - f.x*v)/(e.x + g.x*v);
+
+            if( u<0.0 || u>1.0 || v<0.0 || v>1.0 )
             {
-                res = vec2( (h.x*k1+f.x*k0)/(e.x*k1-g.x*k0), -k0/k1 );
-            }
-            // otherwise, it's a quadratic
-            else
-            {
-                float w = k1*k1 - 4.0*k0*k2;
-                if( w<0.0 ) return vec2(-1.0);
-                w = sqrt( w );
-
-                float ik2 = 0.5/k2;
-                float v = (-k1 - w)*ik2;
-                float u = (h.x - f.x*v)/(e.x + g.x*v);
-                
-                if( u<0.0 || u>1.0 || v<0.0 || v>1.0 )
-                {
-                    v = (-k1 + w)*ik2;
-                    u = (h.x - f.x*v)/(e.x + g.x*v);
-                }
-                res = vec2( u, v );
-            }
-            return res;
-        }]
-
-        namespace eval font {
-            proc load {name} {
-                set csvFd [open "vendor/fonts/$name.csv" r]; set csv [read $csvFd]; close $csvFd
-                set glyphInfos [dict create]
-                foreach line [split $csv "\n"] {
-                set info [lassign [split $line ,] glyph]
-                lassign $info advance \
-                    planeLeft planeBottom planeRight planeTop \
-                    atlasLeft atlasBottom atlasRight atlasTop
-                dict set glyphInfos $glyph \
-                    [list $advance \
-                         [list $planeLeft $planeBottom $planeRight $planeTop] \
-                         [list $atlasLeft $atlasBottom $atlasRight $atlasTop]]
-                }
-
-                set im [image load "[pwd]/vendor/fonts/$name.png"]
-                set gim [Gpu::ImageManager::copyImageToGpu $im]
-
-                return [list $glyphInfos $im $gim]
-            }
-            proc hasGlyphInfo {font charCode} { dict exists [lindex $font 0] $charCode }
-            proc glyphInfo {font charCode} { dict get [lindex $font 0] $charCode }
-            proc atlasImage {font} { lindex $font 1 }
-            proc gpuAtlasImage {font} { lindex $font 2 }
-
-            namespace export *
-            namespace ensemble create
-        }
-        variable glyphMsd [Gpu::fn {sampler2D atlas vec4 atlasGlyphBounds vec2 glyphUv} vec4 {
-            vec2 atlasUv = mix(atlasGlyphBounds.xw, atlasGlyphBounds.zy, glyphUv);
-            return texture(atlas, vec2(atlasUv.x, 1.0-atlasUv.y));
-        }]
-        variable median [Gpu::fn {float r float g float b} float {
-            return max(min(r, g), min(max(r, g), b));
-        }]
-        variable glyph [Gpu::pipeline {sampler2D atlas vec2 atlasSize
-                                       vec4 atlasGlyphBounds
-                                       vec4 planeGlyphBounds
-                                       vec2 pos float radians float em
-                                       fn rotate} {
-            float left = planeGlyphBounds[0] * em;
-            float bottom = planeGlyphBounds[1] * em;
-            float right = planeGlyphBounds[2] * em;
-            float top = planeGlyphBounds[3] * em;
-            vec2 a = pos + rotate(vec2(left, -top), -radians);
-            vec2 b = pos + rotate(vec2(right, -top), -radians);
-            vec2 c = pos + rotate(vec2(right, -bottom), -radians);
-            vec2 d = pos + rotate(vec2(left, -bottom), -radians);
-
-            vec2 vertices[4] = vec2[4](a, b, d, c);
-            return vertices[gl_VertexIndex];
-        } {fn rotate fn invBilinear fn glyphMsd fn median} {
-            float left = planeGlyphBounds[0] * em;
-            float bottom = planeGlyphBounds[1] * em;
-            float right = planeGlyphBounds[2] * em;
-            float top = planeGlyphBounds[3] * em;
-            vec2 a = pos + rotate(vec2(left, -top), -radians);
-            vec2 b = pos + rotate(vec2(right, -top), -radians);
-            vec2 c = pos + rotate(vec2(right, -bottom), -radians);
-            vec2 d = pos + rotate(vec2(left, -bottom), -radians);
-
-            vec2 glyphUv = invBilinear(gl_FragCoord.xy, a, b, c, d);
-            if( max( abs(glyphUv.x-0.5), abs(glyphUv.y-0.5))>=0.5 ) {
-                return vec4(0, 0, 0, 0);
-            }
-            vec3 msd = glyphMsd(atlas, atlasGlyphBounds/atlasSize.xyxy, glyphUv).rgb;
-            float sd = median(msd.r, msd.g, msd.b);
-            float screenPxDistance = 4.5*(sd - 0.5);
-            float opacity = clamp(screenPxDistance + 0.5, 0.0, 1.0);
-            return mix(vec4(0, 0, 0, 0), vec4(1, 1, 1, 1), opacity);
-        }]
-
-        proc start {} { Gpu::drawStart }
-
-        proc getColor {color} {
-            if {[info exists Colors::$color]} { return [set Colors::$color] } \
-                else { return $Colors::white }
-        }
-
-        variable line [Gpu::pipeline {vec2 from vec2 to float thickness vec4 color} {
-            vec2 vertices[4] = vec2[4](
-                 min(from, to) - thickness,
-                 vec2(max(from.x, to.x) + thickness, min(from.y, to.y) - thickness),
-                 vec2(min(from.x, to.x) - thickness, max(from.y, to.y) + thickness),
-                 max(from, to) + thickness
-            );
-            return vertices[gl_VertexIndex];
-        } {
-            float l = length(to - from);
-            vec2 d = (to - from) / l;
-            vec2 q = (gl_FragCoord.xy - (from + to)*0.5);
-            q = mat2(d.x, -d.y, d.y, d.x) * q;
-            q = abs(q) - vec2(l, thickness)*0.5;
-            float dist = length(max(q, 0.0)) + min(max(q.x, q.y), 0.0);
-
-            return dist < 0.0 ? color : vec4(0, 0, 0, 0);
-        }]
-        proc stroke {points width color} {
-            variable line
-            for {set i 0} {$i < [expr {[llength $points] - 1}]} {incr i} {
-                set from [lindex $points $i]
-                set to [lindex $points [expr $i+1]]
-                Gpu::draw $line $from $to $width [getColor $color]
-            }
-        }
-
-        # TODO: Fix bool support.
-        variable circle [Gpu::pipeline {vec2 center float radius float thickness vec4 color int filled} {
-            float r = radius + thickness;
-            vec2 vertices[4] = vec2[4](
-                 center - r,
-                 vec2(center.x + r, center.y - r),
-                 vec2(center.x - r, center.y + r),
-                 center + r
-            );
-            return vertices[gl_VertexIndex];
-        } {
-            float dist = length(gl_FragCoord.xy - center) - radius;
-            if (filled == 1) {
-                return (dist < thickness) ? color : vec4(0, 0, 0, 0);
-            } else {
-                return (dist < thickness && dist > 0.0) ? color : vec4(0, 0, 0, 0);
-            }
-        }]
-        proc circle {x y radius thickness color {filled false}} {
-            variable circle
-            Gpu::draw $circle [list $x $y] $radius $thickness [getColor $color] [ne $filled "false"]
-        }
-
-        set ::FontCache [dict create]
-
-        # load all fonts into the fontCache
-        foreach fontPath [list {*}[glob {*}vendor/fonts/*.png]] {
-            set fontName ""
-            regexp {vendor/fonts/(.*).png} $fontPath whole_match fontName
-            if {!($fontName eq "")} {
-                puts "Loaded $fontName into font cache"
-                set fontdata [font load $fontName]
-                dict set ::FontCache $fontName $fontdata
+                v = (-k1 + w)*ik2;
+                u = (h.x - f.x*v)/(e.x + g.x*v);
             }
+            res = vec2( u, v );
         }
+        return res;
+    }]
 
-        proc textExtent {text scale {font "PTSans-Regular"}} {
-            if {!([dict exists $::FontCache $font])} {
-                throw {DISPLAY FONT {font doesn't exist}} "$font doesn't exist"
-                return
-            }
-            set font [dict get $::FontCache $font]
-
-            set em [* $scale 25.0]
-            set x 0; set y 0
-            set width 0
-            for {set i 0} {$i < [string length $text]} {incr i} {
-                set char [string index $text $i]
-                if {$char eq "\n"} {
-                    set y [+ $y $em]; set x 0; continue
-                }
-                set charCode [scan $char %c]
-                if {[font hasGlyphInfo $font $charCode]} {
-                    set glyphInfo [font glyphInfo $font $charCode]
-                } else {
-                    set glyphInfo [font glyphInfo $font [scan ? %c]]
-                }
-                lassign $glyphInfo advance planeBounds atlasBounds
-                set x [+ $x [* $advance $em]]
-                if {$x > $width} { set width $x }
-            }
-            return [list $width [+ $y $em]]
-        }
-        proc text {x0 y0 scale text radians {font "PTSans-Regular"}} {
-            if {!([dict exists $::FontCache $font])} {
-                throw {DISPLAY FONT {font doesn't exist}} "$font doesn't exist"
-                return
-            }
-            set font [dict get $::FontCache $font]
-        
-
-            variable glyph
-            set fontAtlas [font gpuAtlasImage $font]
-            set fontAtlasSize [list [::image width [font atlasImage $font]] \
-                                   [::image height [font atlasImage $font]]]
-
-            set extent [vec2 rotate [textExtent $text $scale] $radians]
-
-            set em [* $scale 25.0]
-
-            # TODO: Add text alignment/anchor options (right now, this
-            # setup centers the text).
-            set x0 [expr {$x0 - [lindex $extent 0]/2}]
-            set y0 [expr {$y0 - [lindex $extent 1]/2}]
-            set x $x0; set y $y0
-
-            set lineNum 0
-            for {set i 0} {$i < [string length $text]} {incr i} {
-                set char [string index $text $i]
-                if {$char eq "\n"} {
-                    incr lineNum
-                    lassign [vec2 add [list $x0 $y0] \
-                                 [vec2 rotate [list 0 [* $lineNum $em]] $radians]] x y
-                    continue
-                }
-                set charCode [scan $char %c]
-                if {[font hasGlyphInfo $font $charCode]} {
-                    set glyphInfo [font glyphInfo $font $charCode]
-                } else {
-                    set glyphInfo [font glyphInfo $font [scan ? %c]]
-                }
-                lassign $glyphInfo advance planeBounds atlasBounds
-                if {$char ne " "} {
-                    Gpu::draw $glyph $fontAtlas $fontAtlasSize \
-                        $atlasBounds $planeBounds [list $x $y] $radians $em 
-                }
-                lassign [vec2 add [list $x $y] \
-                             [vec2 rotate [list [* $advance $em] 0] $radians]] x y
-            }
-        }
-
-        variable fillTriangle [Gpu::pipeline {vec2 p0 vec2 p1 vec2 p2 vec4 color} {
-            vec2 vertices[4] = vec2[4](p0, p1, p2, p0);
-            return vertices[gl_VertexIndex];
-        } {
-            return color;
-        }]
-        proc fillTriangle {p0 p1 p2 color} {
-            variable fillTriangle
-            Gpu::draw $fillTriangle $p0 $p1 $p2 [getColor $color]
-        }
-        
-        proc fillQuad {p0 p1 p2 p3 color} {
-            fillTriangle $p1 $p2 $p3 $color
-            fillTriangle $p0 $p1 $p3 $color
-        }
-
-        proc fillPolygon {points color} {
-            set num_points [llength $points]
-            if {$num_points < 3} {
-                error "At least 3 points are required to form a polygon."
-            } elseif {$num_points == 3} {
-                eval fillTriangle $points $color
-            } elseif {$num_points == 4} {
-                eval fillQuad $points $color
-            } else {
-                # Get the first point in the list as the "base" point of the triangles
-                set p0 [lindex $points 0]
-
-                for {set i 1} {$i < $num_points - 1} {incr i} {
-                    set p1 [lindex $points $i]
-                    set p2 [lindex $points [expr {$i+1}]]
-                    fillTriangle $p0 $p1 $p2 $color
-                }
-            }
-        }
-
-        variable image [Gpu::pipeline {sampler2D image vec2 imageSize
-                                       vec2 pos float radians float scale
-                                       fn rotate} {
-            vec2 a = pos + rotate(-imageSize/2, -radians);
-            vec2 b = pos + rotate(vec2(imageSize.x, -imageSize.y)/2, -radians);
-            vec2 c = pos + rotate(imageSize/2, -radians);
-            vec2 d = pos + rotate(vec2(-imageSize.x, imageSize.y)/2, -radians);
-            vec2 vertices[4] = vec2[4](a, b, d, c);
-            return vertices[gl_VertexIndex];
-        } {fn invBilinear fn rotate} {
-            vec2 a = pos + rotate(-imageSize/2, -radians);
-            vec2 b = pos + rotate(vec2(imageSize.x, -imageSize.y)/2, -radians);
-            vec2 c = pos + rotate(imageSize/2, -radians);
-            vec2 d = pos + rotate(vec2(-imageSize.x, imageSize.y)/2, -radians);
-            vec2 p = gl_FragCoord.xy;
-            vec2 uv = invBilinear(p, a, b, c, d);
-            if( max( abs(uv.x-0.5), abs(uv.y-0.5))<0.5 ) {
-                return texture(image, uv);
-            }
-            return vec4(0.0, 0.0, 0.0, 0.0);
-        }]
-        variable imCache [dict create]
-        variable IMCACHE_MAX_IMAGES [- $Gpu::ImageManager::GPU_MAX_IMAGES [dict size $::FontCache]]
-        proc checkImCacheAndCopyIfNeeded {imDrawSet} {
-            variable imCache
-            variable IMCACHE_MAX_IMAGES
-
-            dict for {im v} $imDrawSet {
-                if {![dict exists $imCache $im]} { continue }
-                # Check for staleness and remove from cache if so.
-                lassign [dict get $imCache $im] gim expectedVersion
-                set version [Heap::folkHeapGetVersion [string map {uint8_t void} [::image_t data_ptr $im]]]
-                if {$expectedVersion != $version} {
-                    Gpu::ImageManager::freeGpuImage $gim
-                    dict unset imCache $im
-                }
-            }
-
-            set notInCache [dictset difference $imDrawSet $imCache]
-            set notInDrawSet [dictset difference $imCache $imDrawSet]
-
-            set numImagesToCopy [dictset size $notInCache]
-            if {$numImagesToCopy > 0} {
-                if {[dictset size $imCache] + $numImagesToCopy > $IMCACHE_MAX_IMAGES} {
-                    set numImagesToEvict \
-                        [expr {[dictset size $imCache] + $numImagesToCopy - $IMCACHE_MAX_IMAGES}]
-
-                    # What can we safely evict?
-                    # - Anything that's stale
-                    # - Anything that's not in use
-                    set numImagesEvicted 0
-                    dict for {im v} $imCache {
-                        if {$numImagesEvicted == $numImagesToEvict} { break }
-
-                        lassign $v gim expectedVersion
-                        set version [Heap::folkHeapGetVersion [string map {uint8_t void} [::image_t data_ptr $im]]]
-                        if {$expectedVersion != $version} {
-                            Gpu::ImageManager::freeGpuImage $gim
-                            dict unset imCache $im
-                            incr numImagesEvicted
-                            continue
-                        }
-                        if {![dict exists $imDrawSet $im]} {
-                            Gpu::ImageManager::freeGpuImage $gim
-                            dict unset imCache $im
-                            incr numImagesEvicted
-                        }
-                    }
-                }
-
-                dict for {im _} $notInCache {
-                    # TODO: This is unsafe (has a race condition) -- we're
-                    # not locking the image, so version and gim may diverge.
-                    set version [Heap::folkHeapGetVersion [string map {uint8_t void} [::image_t data_ptr $im]]]
-                    set gim [Gpu::ImageManager::copyImageToGpu $im]
-                    dict set imCache $im [list $gim $version]
-                }
-            }
-        }
-        proc image {x y im radians {scale 1.0}} {
-            # TODO: Implement scale.
-            variable image
-            variable imCache
-            lassign [dict get $imCache $im] gim
-            Gpu::draw $image $gim [list [::image width $im] [::image height $im]] \
-                [list $x $y] $radians $scale
-        }
-
-        proc end {} { Gpu::drawEnd; Gpu::poll }
+    namespace eval Colors { source "pi/Colors.tcl" }
+    proc ::getColor {color} {
+        if {[info exists Colors::$color]} { return [set Colors::$color] } \
+            else { return $Colors::white }
     }
 
     Wish $::thisProcess receives statements like \
-        [list /someone/ wishes display runs /command/ on layer /layer/]
-    Wish $::thisProcess receives statements like \
-        [list /someone/ wishes display runs /command/]
+        [list /someone/ wishes the GPU compiles pipeline /name/ /source/]
     Wish $::thisProcess receives statements like \
-        [list /someone/ wishes display runs program /program/]
+        [list /someone/ wishes the GPU draws pipeline /name/ with arguments /args/]
     Wish $::thisProcess shares statements like \
         [list /someone/ claims the display time is /displayTime/]
 
-    while true {
-        set displayList [list]
-        foreach match [Statements::findMatches {/someone/ wishes display runs /command/ on layer /layer/}] {
-            lappend displayList [list [dict get $match layer] [dict get $match command]]
-        }
-        foreach match [Statements::findMatches {/someone/ wishes display runs /command/}] {
-            lappend displayList [list 0 [dict get $match command]]
-        }
-
-        proc lcomp {a b} {
-            set layerA [lindex $a 0]
-            set layerB [lindex $b 0]
-            if {$layerA == $layerB} {
-                expr {[lindex $a 1 0] == "Display::text"}
-            } else {
-                expr {$layerA - $layerB}
-            }
-        }
-
-        set displayCommands [lmap sublist [lsort -command lcomp $displayList] {lindex $sublist 1}]
+    set ::pipelines [dict create]
+    When /someone/ wishes the GPU compiles pipeline /name/ /source/ {
+        dict set ::pipelines $name [Gpu::pipeline {*}$source]
+    }
 
-        set imDrawSet [dictset create]
-        foreach command $displayCommands {
-            if {[lindex $command 0] eq "Display::image"} {
-                set im [lindex $command 3]
-                dictset add imDrawSet $im
-            }
-        }
-        Display::checkImCacheAndCopyIfNeeded $imDrawSet
+    while true {
+        Step
 
         set renderTime [baretime {
-            Display::start
-            foreach command $displayCommands {
-                try { {*}$command } \
-                    on error e { puts stderr $::errorInfo }
+            Gpu::drawStart
+            foreach match [Statements::findMatches {/someone/ wishes the GPU draws pipeline /name/ with arguments /args/}] {
+                Gpu::draw [dict get $::pipelines [dict get $match name]] {*}[dict get $match args]
             }
-            Display::end
+            Gpu::drawEnd
         }]
 
         Commit { Claim the display time is "render $renderTime us ($::stepTime)" }
-        Step
     }
 }
 
diff --git a/virtual-programs/display/circle.folk b/virtual-programs/display/circle.folk
new file mode 100644
index 00000000..f50813eb
--- /dev/null
+++ b/virtual-programs/display/circle.folk
@@ -0,0 +1,31 @@
+Wish the GPU compiles pipeline "circle" {
+    {vec2 center float radius float thickness vec4 color int filled} {
+        float r = radius + thickness;
+        vec2 vertices[4] = vec2[4](
+            center - r,
+            vec2(center.x + r, center.y - r),
+            vec2(center.x - r, center.y + r),
+            center + r
+        );
+        return vertices[gl_VertexIndex];
+    } {
+        float dist = length(gl_FragCoord.xy - center) - radius;
+        if (filled == 1) {
+            return (dist < thickness) ? color : vec4(0, 0, 0, 0);
+        } else {
+            return (dist < thickness && dist > 0.0) ? color : vec4(0, 0, 0, 0);
+        }
+    }
+}
+
+When /someone/ wishes to draw a circle with /...options/ {
+    set center [dict getdef $options center ""]
+    if {center eq ""} { set center [list [dict get $options x] [dict get $options y]] }
+    set radius [dict get $options radius]
+    set thickness [dict get $options thickness]
+    set color [getColor [dict get $options color]]
+    set filled [dict getdef $options filled false]
+
+    Wish the GPU draws pipeline "circle" with arguments \
+        [list $center $radius $thickness $color $filled]
+}
diff --git a/virtual-programs/display/fill.folk b/virtual-programs/display/fill.folk
new file mode 100644
index 00000000..dd9e199d
--- /dev/null
+++ b/virtual-programs/display/fill.folk
@@ -0,0 +1,46 @@
+Wish the GPU compiles pipeline "fillTriangle" {
+    {vec2 p0 vec2 p1 vec2 p2 vec4 color} {
+        vec2 vertices[4] = vec2[4](p0, p1, p2, p0);
+        return vertices[gl_VertexIndex];
+    } {
+        return color;
+    }
+}
+
+When /someone/ wishes to draw a triangle with /...options/ {
+    dict with options {
+        Wish the GPU draws pipeline "fillTriangle" with arguments \
+            [list $p0 $p1 $p2 [getColor $color]]
+    }
+}
+When /someone/ wishes to draw a quad with /...options/ {
+    dict with options {
+        Wish the GPU draws pipeline "fillTriangle" with arguments \
+            [list $p0 $p1 $p2 [getColor $color]]
+        Wish the GPU draws pipeline "fillTriangle" with arguments \
+            [list $p0 $p1 $p3 [getColor $color]]
+    }
+}
+When /someone/ wishes to draw a polygon with /...options/ {
+    set points [dict get $options points]
+    set color [dict get $options color]
+
+    set num_points [llength $points]
+    if {$num_points < 3} {
+        error "At least 3 points are required to form a polygon."
+    } elseif {$num_points == 3} {
+        eval fillTriangle $points $color
+    } elseif {$num_points == 4} {
+        eval fillQuad $points $color
+    } else {
+        # Get the first point in the list as the "base" point of the triangles
+        set p0 [lindex $points 0]
+
+        for {set i 1} {$i < $num_points - 1} {incr i} {
+            set p1 [lindex $points $i]
+            set p2 [lindex $points [expr {$i+1}]]
+            Wish the GPU draws pipeline "fillTriangle" with arguments \
+                [list $p0 $p1 $p2 $color]
+        }
+    }
+}
diff --git a/virtual-programs/display/fns.folk b/virtual-programs/display/fns.folk
new file mode 100644
index 00000000..e69de29b
--- /dev/null
+++ b/virtual-programs/display/fns.folk
diff --git a/virtual-programs/display/image.folk b/virtual-programs/display/image.folk
new file mode 100644
index 00000000..4665a236
--- /dev/null
+++ b/virtual-programs/display/image.folk
@@ -0,0 +1,99 @@
+On process "display" {
+    set invBilinear $::invBilinear
+    set rotate $::rotate
+    set image [Gpu::pipeline {sampler2D image vec2 imageSize
+                              vec2 pos float radians float scale
+                              fn rotate} {
+        vec2 a = pos + rotate(-imageSize/2, -radians);
+        vec2 b = pos + rotate(vec2(imageSize.x, -imageSize.y)/2, -radians);
+        vec2 c = pos + rotate(imageSize/2, -radians);
+        vec2 d = pos + rotate(vec2(-imageSize.x, imageSize.y)/2, -radians);
+        vec2 vertices[4] = vec2[4](a, b, d, c);
+        return vertices[gl_VertexIndex];
+    } {fn invBilinear fn rotate} {
+        vec2 a = pos + rotate(-imageSize/2, -radians);
+        vec2 b = pos + rotate(vec2(imageSize.x, -imageSize.y)/2, -radians);
+        vec2 c = pos + rotate(imageSize/2, -radians);
+        vec2 d = pos + rotate(vec2(-imageSize.x, imageSize.y)/2, -radians);
+        vec2 p = gl_FragCoord.xy;
+        vec2 uv = invBilinear(p, a, b, c, d);
+        if( max( abs(uv.x-0.5), abs(uv.y-0.5))<0.5 ) {
+            return texture(image, uv);
+        }
+        return vec4(0.0, 0.0, 0.0, 0.0);
+    }]
+
+    set ::ImCache [dict create]
+    variable IMCACHE_MAX_IMAGES [- $Gpu::ImageManager::GPU_MAX_IMAGES 1]
+    proc checkImCacheAndCopyIfNeeded {imDrawSet} {
+        variable ::ImCache
+        variable IMCACHE_MAX_IMAGES
+
+        dict for {im v} $imDrawSet {
+            if {![dict exists $::ImCache $im]} { continue }
+            # Check for staleness and remove from cache if so.
+            lassign [dict get $::ImCache $im] gim expectedVersion
+            set version [Heap::folkHeapGetVersion [string map {uint8_t void} [::image_t data_ptr $im]]]
+            if {$expectedVersion != $version} {
+                Gpu::ImageManager::freeGpuImage $gim
+                dict unset ::ImCache $im
+            }
+        }
+
+        set notInCache [dictset difference $imDrawSet $::ImCache]
+        set notInDrawSet [dictset difference $::ImCache $imDrawSet]
+
+        set numImagesToCopy [dictset size $notInCache]
+        if {$numImagesToCopy > 0} {
+            if {[dictset size $::ImCache] + $numImagesToCopy > $IMCACHE_MAX_IMAGES} {
+                set numImagesToEvict \
+                    [expr {[dictset size $::ImCache] + $numImagesToCopy - $IMCACHE_MAX_IMAGES}]
+
+                # What can we safely evict?
+                # - Anything that's stale
+                # - Anything that's not in use
+                set numImagesEvicted 0
+                dict for {im v} $::ImCache {
+                    if {$numImagesEvicted == $numImagesToEvict} { break }
+
+                    lassign $v gim expectedVersion
+                    set version [Heap::folkHeapGetVersion [string map {uint8_t void} [::image_t data_ptr $im]]]
+                    if {$expectedVersion != $version} {
+                        Gpu::ImageManager::freeGpuImage $gim
+                        dict unset ::ImCache $im
+                        incr numImagesEvicted
+                        continue
+                    }
+                    if {![dict exists $imDrawSet $im]} {
+                        Gpu::ImageManager::freeGpuImage $gim
+                        dict unset ::ImCache $im
+                        incr numImagesEvicted
+                    }
+                }
+            }
+
+            dict for {im _} $notInCache {
+                # TODO: This is unsafe (has a race condition) -- we're
+                # not locking the image, so version and gim may diverge.
+                set version [Heap::folkHeapGetVersion [string map {uint8_t void} [::image_t data_ptr $im]]]
+                set gim [Gpu::ImageManager::copyImageToGpu $im]
+                dict set ::ImCache $im [list $gim $version]
+            }
+        }
+    }
+
+    Wish $::thisProcess receives statements like \
+        [list /someone/ wishes to draw an image with /...options/]
+    When /someone/ wishes to draw an image with /...options/ {
+        set x [dict get $options x]
+        set y [dict get $options y]
+        set im [dict get $options image]
+        set radians [dict get $options radians]
+        set scale [dict getdef $options scale 1.0]
+
+        lassign [dict get $::ImCache $im] gim
+
+        Wish the GPU draws pipeline "image" with arguments \
+            [list $x $y $im $radians $scale]
+    }
+}
diff --git a/virtual-programs/display/stroke.folk b/virtual-programs/display/stroke.folk
new file mode 100644
index 00000000..98eec038
--- /dev/null
+++ b/virtual-programs/display/stroke.folk
@@ -0,0 +1,33 @@
+Wish the GPU compiles pipeline "line" {
+    {vec2 from vec2 to float thickness vec4 color} {
+        vec2 vertices[4] = vec2[4](
+             min(from, to) - thickness,
+             vec2(max(from.x, to.x) + thickness, min(from.y, to.y) - thickness),
+             vec2(min(from.x, to.x) - thickness, max(from.y, to.y) + thickness),
+             max(from, to) + thickness
+        );
+        return vertices[gl_VertexIndex];
+    } {
+        float l = length(to - from);
+        vec2 d = (to - from) / l;
+        vec2 q = (gl_FragCoord.xy - (from + to)*0.5);
+        q = mat2(d.x, -d.y, d.y, d.x) * q;
+        q = abs(q) - vec2(l, thickness)*0.5;
+        float dist = length(max(q, 0.0)) + min(max(q.x, q.y), 0.0);
+
+        return dist < 0.0 ? color : vec4(0, 0, 0, 0);
+    }
+}
+
+When /someone/ wishes to draw a stroke with /...options/ {
+    set points [dict get $options points]
+    set width [dict get $options width]
+    set color [getColor [dict get $options color]]
+
+    for {set i 0} {$i < [expr {[llength $points] - 1}]} {incr i} {
+        set from [lindex $points $i]
+        set to [lindex $points [expr $i+1]]
+        Wish the GPU draws pipeline "line" with arguments \
+            [list $from $to $width $color]
+    }
+}
diff --git a/virtual-programs/display/text.folk b/virtual-programs/display/text.folk
new file mode 100644
index 00000000..3f2b4b5c
--- /dev/null
+++ b/virtual-programs/display/text.folk
@@ -0,0 +1,150 @@
+On process "display" {
+    namespace eval font {
+        proc load {name} {
+            set csvFd [open "vendor/fonts/$name.csv" r]; set csv [read $csvFd]; close $csvFd
+            set glyphInfos [dict create]
+            foreach line [split $csv "\n"] {
+                set info [lassign [split $line ,] glyph]
+                lassign $info advance \
+                    planeLeft planeBottom planeRight planeTop \
+                    atlasLeft atlasBottom atlasRight atlasTop
+                dict set glyphInfos $glyph \
+                    [list $advance \
+                         [list $planeLeft $planeBottom $planeRight $planeTop] \
+                         [list $atlasLeft $atlasBottom $atlasRight $atlasTop]]
+            }
+
+            set im [image load "[pwd]/vendor/fonts/$name.png"]
+            set gim [Gpu::ImageManager::copyImageToGpu $im]
+
+            return [list $glyphInfos $im $gim]
+        }
+        proc hasGlyphInfo {font charCode} { dict exists [lindex $font 0] $charCode }
+        proc glyphInfo {font charCode} { dict get [lindex $font 0] $charCode }
+        proc atlasImage {font} { lindex $font 1 }
+        proc gpuAtlasImage {font} { lindex $font 2 }
+
+        namespace export *
+        namespace ensemble create
+    }
+    set font [font load "PTSans-Regular"]
+
+    set rotate $::rotate
+    set invBilinear $::invBilinear
+    set glyphMsd [Gpu::fn {sampler2D atlas vec4 atlasGlyphBounds vec2 glyphUv} vec4 {
+        vec2 atlasUv = mix(atlasGlyphBounds.xw, atlasGlyphBounds.zy, glyphUv);
+        return texture(atlas, vec2(atlasUv.x, 1.0-atlasUv.y));
+    }]
+    set median [Gpu::fn {float r float g float b} float {
+        return max(min(r, g), min(max(r, g), b));
+    }]
+    dict set ::pipelines "glyph" [Gpu::pipeline \
+                                      {sampler2D atlas vec2 atlasSize
+                                       vec4 atlasGlyphBounds
+                                       vec4 planeGlyphBounds
+                                       vec2 pos float radians float em
+                                       fn rotate} {
+         float left = planeGlyphBounds[0] * em;
+         float bottom = planeGlyphBounds[1] * em;
+         float right = planeGlyphBounds[2] * em;
+         float top = planeGlyphBounds[3] * em;
+         vec2 a = pos + rotate(vec2(left, -top), -radians);
+         vec2 b = pos + rotate(vec2(right, -top), -radians);
+         vec2 c = pos + rotate(vec2(right, -bottom), -radians);
+         vec2 d = pos + rotate(vec2(left, -bottom), -radians);
+
+         vec2 vertices[4] = vec2[4](a, b, d, c);
+         return vertices[gl_VertexIndex];
+    } {fn rotate fn invBilinear fn glyphMsd fn median} {
+        float left = planeGlyphBounds[0] * em;
+        float bottom = planeGlyphBounds[1] * em;
+        float right = planeGlyphBounds[2] * em;
+        float top = planeGlyphBounds[3] * em;
+        vec2 a = pos + rotate(vec2(left, -top), -radians);
+        vec2 b = pos + rotate(vec2(right, -top), -radians);
+        vec2 c = pos + rotate(vec2(right, -bottom), -radians);
+        vec2 d = pos + rotate(vec2(left, -bottom), -radians);
+
+        vec2 glyphUv = invBilinear(gl_FragCoord.xy, a, b, c, d);
+        if( max( abs(glyphUv.x-0.5), abs(glyphUv.y-0.5))>=0.5 ) {
+            return vec4(0, 0, 0, 0);
+        }
+        vec3 msd = glyphMsd(atlas, atlasGlyphBounds/atlasSize.xyxy, glyphUv).rgb;
+        float sd = median(msd.r, msd.g, msd.b);
+        float screenPxDistance = 4.5*(sd - 0.5);
+        float opacity = clamp(screenPxDistance + 0.5, 0.0, 1.0);
+        return mix(vec4(0, 0, 0, 0), vec4(1, 1, 1, 1), opacity);
+    }]    
+
+    fn textExtent {text scale} {
+        set em [* $scale 25.0]
+        set x 0; set y 0
+        set width 0
+        for {set i 0} {$i < [string length $text]} {incr i} {
+            set char [string index $text $i]
+            if {$char eq "\n"} {
+                set y [+ $y $em]; set x 0; continue
+            }
+            set charCode [scan $char %c]
+            if {[font hasGlyphInfo $font $charCode]} {
+                set glyphInfo [font glyphInfo $font $charCode]
+            } else {
+                set glyphInfo [font glyphInfo $font [scan ? %c]]
+            }
+            lassign $glyphInfo advance planeBounds atlasBounds
+            set x [+ $x [* $advance $em]]
+            if {$x > $width} { set width $x }
+        }
+        return [list $width [+ $y $em]]
+    }
+
+    Wish $::thisProcess receives statements like \
+        [list /someone/ wishes to draw text with /...options/]
+
+    When /someone/ wishes to draw text with /...options/ {
+        set x0 [dict get $options x]
+        set y0 [dict get $options y]
+        set scale [dict getdef $options scale 1.0]
+        set text [dict get $options text]
+        set radians [dict get $options radians]
+
+        set fontAtlas [font gpuAtlasImage $font]
+        set fontAtlasSize [list [::image width [font atlasImage $font]] \
+                               [::image height [font atlasImage $font]]]
+
+        set extent [vec2 rotate [textExtent $text $scale] $radians]
+
+        set em [* $scale 25.0]
+
+        # TODO: Add text alignment/anchor options (right now, this
+        # setup centers the text).
+        set x0 [expr {$x0 - [lindex $extent 0]/2}]
+        set y0 [expr {$y0 - [lindex $extent 1]/2}]
+        set x $x0; set y $y0
+
+        set lineNum 0
+        for {set i 0} {$i < [string length $text]} {incr i} {
+            set char [string index $text $i]
+            if {$char eq "\n"} {
+                incr lineNum
+                lassign [vec2 add [list $x0 $y0] \
+                             [vec2 rotate [list 0 [* $lineNum $em]] $radians]] x y
+                continue
+            }
+            set charCode [scan $char %c]
+            if {[font hasGlyphInfo $font $charCode]} {
+                set glyphInfo [font glyphInfo $font $charCode]
+            } else {
+                set glyphInfo [font glyphInfo $font [scan ? %c]]
+            }
+            lassign $glyphInfo advance planeBounds atlasBounds
+            if {$char ne " "} {
+                Wish the GPU draws pipeline "glyph" with arguments \
+                    [list $fontAtlas $fontAtlasSize \
+                         $atlasBounds $planeBounds [list $x $y] $radians $em]
+            }
+            lassign [vec2 add [list $x $y] \
+                         [vec2 rotate [list [* $advance $em] 0] $radians]] x y
+        }
+    }
+}
diff --git a/virtual-programs/label.folk b/virtual-programs/label.folk
index 18c6e139..2a4458ad 100644
--- a/virtual-programs/label.folk
+++ b/virtual-programs/label.folk
@@ -1,15 +1,12 @@
 When /thing/ has region /region/ {
     lassign [region centroid $region] x y
-    # set width [region width $region]
-    # set height [region height $region]
     set radians [region angle $region]
 
     When the collected matches for [list /someone/ wishes $thing is labelled /text/ with font /font/] are /matches/ {
         set text [join [lmap match $matches {dict get $match text}] "\n"]
         if {$text eq ""} { return }
 
-        set scale 1
-        Display::text $x $y $scale $text $radians [dict get $match font]
+        Wish to draw text with x $x y $y text $text radians $radians font [dict get $match font]
     }
 }
 
diff --git a/virtual-programs/outline.folk b/virtual-programs/outline.folk
index f62ab0ba..cdfe6fbd 100644
--- a/virtual-programs/outline.folk
+++ b/virtual-programs/outline.folk
@@ -1,9 +1,9 @@
 proc loopRegion {edges vertices weight color} {
-	foreach edge $edges {
-		set from [lindex $vertices [lindex $edge 0]]
-		set to [lindex $vertices [lindex $edge 1]]
-		Display::stroke [list $from $to] $weight $color
-	}
+    foreach edge $edges {
+        set from [lindex $vertices [lindex $edge 0]]
+        set to [lindex $vertices [lindex $edge 1]]
+        Wish to draw a stroke with points [list $from $to] width $weight color $color
+    }
 }
 
 When the collected matches for [list /someone/ wishes /thing/ is outlined /color/] are /matches/ {
@@ -27,4 +27,4 @@ When /someone/ wishes /thing/ is outlined thick /color/ & /thing/ has region /re
 	# FIXME: assumes path
 	lassign $region vertices edges
 	loopRegion $edges $vertices 6 $color
-}
\ No newline at end of file
+}