Merge branch 'main' into ac/editor

10 files changed, 621 insertions, 104 deletions

diff --git a/virtual-programs/apriltags.folk b/virtual-programs/apriltags.folk
index 8bdd415a..7e190a5b 100644
--- a/virtual-programs/apriltags.folk
+++ b/virtual-programs/apriltags.folk
@@ -1,9 +1,10 @@
 if {$::isLaptop} return
 
+set tagfamily "tagStandard52h13"
+
 # Plain detector. Runs on entire camera frame.
 set mainDetectorProcess [On process {
     source pi/AprilTags.tcl
-    AprilTags::init
 
     # TODO: Clean this up. We retract these so that we don't bounce
     # statements back to the main Folk process that it sends us.
@@ -18,9 +19,10 @@ set mainDetectorProcess [On process {
     Wish $::thisProcess shares statements like \
         [list /someone/ claims $::thisProcess has pid /pid/]
 
+    set detector [AprilTags new $tagfamily]
     When the camera frame is /grayFrame/ at /timestamp/ {
         set aprilTime [time {
-            set tags [AprilTags::detect $grayFrame]
+            set tags [$detector detect $grayFrame]
         }]
         Claim $::thisProcess detects tags $tags at $timestamp in time $aprilTime
     }
@@ -30,7 +32,6 @@ set mainDetectorProcess [On process {
 # old camera frame.
 On process {
     source pi/AprilTags.tcl
-    AprilTags::init
 
     # TODO: Clean this up. We retract these so that we don't bounce
     # statements back to the main Folk process that it sends us.
@@ -52,19 +53,21 @@ On process {
         [list /someone/ wishes /something/ displays camera slice /slice/]
 
     proc subimage {im x y subwidth subheight} {
-	dict with im {
-	    set x [expr {int($x)}]
-	    set y [expr {int($y)}]
-	    set subdata [expr {$data + ($y*$width + $x) * $components}]
-	    dict create \
-		width [int $subwidth] \
-		height [int $subheight] \
-		components $components \
-		bytesPerRow $bytesPerRow \
-		data [format 0x%x $subdata]
-	}
+        dict with im {
+            set x [expr {int($x)}]
+            set y [expr {int($y)}]
+            set subdata [expr {[lindex $data 1] + ($y*$width + $x) * $components}]
+            dict create \
+                width [int $subwidth] \
+                height [int $subheight] \
+                components $components \
+                bytesPerRow $bytesPerRow \
+                data [format "(uint8_t*) 0x%x" $subdata]
+        }
     }
 
+    set detector [AprilTags new $tagfamily]
+
     When the camera frame is /grayFrame/ at /timestamp/ & \
          /process/ detects tags /prevTags/ at /something/ in time /something/ {
 
@@ -89,7 +92,7 @@ On process {
 
             set subimage [subimage $grayFrame $x $y [- $x1 $x] [- $y1 $y]]
             set aprilTime [+ $aprilTime [baretime {
-                foreach tag [AprilTags::detect $subimage] {
+                foreach tag [$detector detect $subimage] {
                     dict with tag {
                         set center [vec2 add $center [list $x $y]]
                         set corners [lmap corner $corners {vec2 add $corner [list $x $y]}]
diff --git a/virtual-programs/camera.folk b/virtual-programs/camera.folk
index 428c4195..0e1710e7 100644
--- a/virtual-programs/camera.folk
+++ b/virtual-programs/camera.folk
@@ -16,15 +16,22 @@ set height $::Camera::HEIGHT
 
 On process {
     source pi/Camera.tcl
+
     Camera::init $width $height
 
-    puts "Camera tid: [getTid] booting at [clock milliseconds]"
+    puts "Camera tid: [getTid] booted at [clock milliseconds]"
 
+    set ::oldFrames [list]
     When $::thisProcess has step count /c/ {
-        set grayFrame [Camera::grayFrame]
+        set frame [Camera::grayFrame]
         Commit {
             Claim the camera time is $::stepTime
-            Claim the camera frame is $grayFrame at [clock milliseconds]
+            Claim the camera frame is $frame at [clock milliseconds]
+        }
+        lappend ::oldFrames $frame
+        if {[llength $::oldFrames] >= 10} {
+            set ::oldFrames [lassign $::oldFrames oldestFrame]
+            Camera::freeImage $oldestFrame
         }
     }
 }
diff --git a/virtual-programs/connections.folk b/virtual-programs/connections.folk
new file mode 100644
index 00000000..c66fba1d
--- /dev/null
+++ b/virtual-programs/connections.folk
@@ -0,0 +1,56 @@
+# Connection wish fulfillment
+# for wishes of the form:
+# "Wish $tag is connected to $tag2" or "Wish $tag is dynamically connected to $tag2"
+
+When /anyone/ wishes /source/ is connected to /sink/ & \
+  /source/ has region /source_region/ & \
+  /sink/ has region /sink_region/ {
+
+   if {$source == $sink} {return}
+
+   set source [region centroid $source_region]
+   set sink [region centroid $sink_region]
+
+   set direction [vec2 sub $sink $source]
+
+   set c [vec2 scale [vec2 add $source $sink] 0.5]
+   set angle [expr {atan2(-[lindex $direction 1], [lindex $direction 0]) - 3.14159/2}]
+
+   set color grey
+   Display::stroke [list $source $sink ] 2 $color
+   shape 3 $c 30 $angle $color true
+}
+
+set speed 75
+set spacing 50
+set maxsize 25
+
+When /anyone/ wishes /source/ is dynamically connected to /sink/ & \
+  /source/ has region /source_region/ & \
+  /sink/ has region /sink_region/ {
+
+   if {$source == $sink} {return}
+
+   set source [region centroid $source_region]
+   set sink [region centroid $sink_region]
+
+   set direction [vec2 normalize [vec2 sub $sink $source]]
+   set distance [vec2 distance $sink $source]
+   set angle [expr {atan2(-[lindex $direction 1], [lindex $direction 0]) - 3.14159/2}] 
+
+   lassign [vec2 scale [vec2 add $source $sink] 0.5] cx cy
+
+   Display::stroke [list $source $sink ] 1 white
+   
+   
+   When the clock time is /t/ {
+     set offset [expr {round($t*$speed) % $spacing}]
+     set count [expr {round($distance / $spacing)}]
+
+     for {set p $offset} {$p < $distance} {incr p $spacing} {
+        set c [vec2 add $source [vec2 scale $direction $p]]
+        set s [expr {min($maxsize, 0.20*min($p, $distance - $p))}]
+        shape 3 $c $s $angle white true
+      }
+    }
+}
diff --git a/virtual-programs/display.folk b/virtual-programs/display.folk
index 674cf1f7..da12bc83 100644
--- a/virtual-programs/display.folk
+++ b/virtual-programs/display.folk
@@ -1,10 +1,12 @@
-if {$::isLaptop} return
-
 namespace eval ::Display {
     variable WIDTH
     variable HEIGHT
     variable LAYER 0
-    regexp {mode "(\d+)x(\d+)"} [exec fbset] -> WIDTH HEIGHT
+    if {$::isLaptop} {
+        set WIDTH 640; set HEIGHT 480
+    } else {
+        regexp {mode "(\d+)x(\d+)"} [exec fbset] -> WIDTH HEIGHT
+    }
 
     proc drawOnTop {func args} {
         set ::Display::LAYER 1
@@ -12,35 +14,453 @@ namespace eval ::Display {
         set ::Display::LAYER 0
     }
 
-    proc stroke {points width color} {
-        uplevel [list Wish display runs [list Display::stroke $points $width $color] on layer $::Display::LAYER]
+    # Create proxy versions of drawing primitives for the main Folk
+    # process (that will forward those draw commands to the display
+    # subprocess).
+    foreach func {stroke circle text fillTriangle fillQuad fillPolygon} {
+        proc $func args {
+            set func [lindex [info level 0] 0]
+            uplevel [list Wish display runs [list $func {*}$args] on layer $::Display::LAYER]
+        }
     }
 
-    proc circle {x y radius thickness color} {
-        uplevel [list Wish display runs [list Display::circle $x $y $radius $thickness $color] on layer $::Display::LAYER]
-    }
+    Claim the display Display has width $::Display::WIDTH height $::Display::HEIGHT
+}
 
-    proc text args {
-        uplevel [list Wish display runs [list Display::text {*}$args] on layer $::Display::LAYER]
-    }
+On process {
+    puts "Display pid: [pid]"
 
-    proc fillTriangle args {
-        uplevel [list Wish display runs [list Display::fillTriangle {*}$args] on layer $::Display::LAYER]
-    }
+    source pi/Gpu.tcl
+    Gpu::init
+    Gpu::ImageManager::imageManagerInit
 
-    proc fillQuad args {
-        uplevel [list Wish display runs [list Display::fillQuad {*}$args] on layer $::Display::LAYER]
-    }
+    namespace eval Display {
+        namespace eval Colors { source "pi/Colors.tcl" }
 
-    proc fillPolygon args {
-        uplevel [list Wish display runs [list Display::fillPolygon {*}$args] on layer $::Display::LAYER]
-    }
-}
+        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);
 
-On process {
-    source pi/Display.tcl
-    Display::init
-    puts "Display tid: [getTid]"
+            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 )
+                {
+                    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]
+            }
+        }
+
+        variable arc [Gpu::pipeline {vec2 center float start float arclen float radius float thickness vec4 color} {
+            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];
+        } {
+            #define M_TWO_PI 6.283185307179586
+            start = clamp(start, 0, M_TWO_PI);
+            arclen = clamp(arclen, 0, M_TWO_PI);
+
+            float dist = length(gl_FragCoord.xy - center) - radius;
+            float angle = atan(-(gl_FragCoord.y - center.y), gl_FragCoord.x - center.x);
+
+            // Shift angle from [-pi, pi) to [0, 2*pi]
+            angle = (angle < 0) ? (angle + M_TWO_PI) : angle;
+            float end = start + arclen;
+
+            return ((dist < thickness && dist > 0.0) &&
+                    ((end < M_TWO_PI && angle > start && angle < end) || 
+                    (end >= M_TWO_PI && (angle > start || angle < end-M_TWO_PI)))) ? color : vec4(0, 0, 0, 0);
+
+        }]
+
+        proc arc {x y start arclen radius thickness color} {
+            variable arc
+            Gpu::draw $arc [list $x $y] $start $arclen $radius $thickness [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
+            }
+        }
+
+        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 }
+    }
 
     # TODO: Clean this up. We retract these so that we don't bounce
     # statements back to the main Folk process that it sends us.
@@ -78,10 +498,25 @@ On process {
 
         set displayCommands [lmap sublist [lsort -command lcomp $displayList] {lindex $sublist 1}]
 
-        set renderTime [baretime [list foreach command $displayCommands { {*}$command }]]
-        set commitTime [baretime commitThenClearStaging]
+        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
+
+        set renderTime [baretime {
+            Display::start
+            foreach command $displayCommands {
+                try { {*}$command } \
+                    on error e { puts stderr $::errorInfo }
+            }
+            Display::end
+        }]
 
-        Commit { Claim the display time is "render $renderTime us + commit $commitTime us ($::stepTime)" }
+        Commit { Claim the display time is "render $renderTime us ($::stepTime)" }
         Step
     }
 }
diff --git a/virtual-programs/errors.folk b/virtual-programs/errors.folk
index 555b45bb..28028710 100644
--- a/virtual-programs/errors.folk
+++ b/virtual-programs/errors.folk
@@ -7,5 +7,5 @@ When /p/ has error /err/ with info /info/ {
         }
     }
 
-    Wish $p has title $err
-}
\ No newline at end of file
+    Wish $p is titled $err
+}
diff --git a/virtual-programs/images.folk b/virtual-programs/images.folk
index 927b2da7..e748cd11 100644
--- a/virtual-programs/images.folk
+++ b/virtual-programs/images.folk
@@ -1,40 +1,44 @@
-
 # Example program, i.e the public API
 #
 # When $this has camera slice /slice/ {
 #     Wish $this displays camera slice $slice
 # }
 
-if {$::isLaptop} { return }
-
 # Generic image class for sub-image manipulations
 namespace eval ::image {
     proc width {im} { dict get $im width }
     proc height {im} { dict get $im height }
     proc subimage {im x y subwidth subheight} {
-	dict with im {
-	    set x [expr {int($x)}]
-	    set y [expr {int($y)}]
-	    set subdata [expr {$data + ($y*$width + $x) * $components}]
-	    dict create \
-		width $subwidth \
-		height $subheight \
-		components $components \
-		bytesPerRow $bytesPerRow \
-		data [format 0x%x $subdata]
-	}
+        dict with im {
+            set x [expr {int($x)}]
+            set y [expr {int($y)}]
+            set subdata [expr {[lindex $data 1] + ($y*$width + $x) * $components}]
+            dict create \
+                width $subwidth \
+                height $subheight \
+                components $components \
+                bytesPerRow $bytesPerRow \
+                data [format "(uint8_t*) 0x%x" $subdata]
+        }
     }
 
     set cc [c create]
     c loadlib [expr {$tcl_platform(os) eq "Darwin" ? "/opt/homebrew/lib/libjpeg.dylib" : [lindex [exec /usr/sbin/ldconfig -p | grep libjpeg] end]}]
     c loadlib [expr {$tcl_platform(os) eq "Darwin" ? "/opt/homebrew/lib/libpng.dylib" : [lindex [exec /usr/sbin/ldconfig -p | grep libpng] end]}]
+    if {$tcl_platform(os) eq "Darwin"} {
+        $cc cflags -I/opt/homebrew/include -L/opt/homebrew/lib
+    }
 
-    $cc cflags -ljpeg
+    $cc cflags -ljpeg -lpng
     source "pi/cUtils.tcl"
     defineImageType $cc
     $cc include <stdlib.h>
     $cc include <string.h>
-    $cc import ::Heap::cc folkHeapAlloc as folkHeapAlloc
+    if {[namespace exists ::Heap]} {
+        $cc import ::Heap::cc folkHeapAlloc as folkHeapAlloc
+    } else {
+        $cc code { #define folkHeapAlloc malloc }
+    }
 
     $cc code {
         #undef EXTERN
@@ -44,7 +48,7 @@ namespace eval ::image {
         #include <unistd.h>
 
         void 
-    jpeg(FILE* dest, uint8_t* data, uint32_t components, uint32_t width, uint32_t height, int quality)
+    jpeg(FILE* dest, uint8_t* data, uint32_t components, uint32_t bytesPerRow, uint32_t width, uint32_t height, int quality)
     {
         JSAMPARRAY image;
         if (components == 1) {
@@ -52,9 +56,9 @@ namespace eval ::image {
             for (size_t i = 0; i < height; i++) {
                 image[i] = calloc(width * 3, sizeof (JSAMPLE));
                 for (size_t j = 0; j < width; j++) {
-                    image[i][j * 3 + 0] = data[(i * width + j)];
-                    image[i][j * 3 + 1] = data[(i * width + j)];
-                    image[i][j * 3 + 2] = data[(i * width + j)];
+                    image[i][j * 3 + 0] = data[(i*bytesPerRow + j)];
+                    image[i][j * 3 + 1] = data[(i*bytesPerRow + j)];
+                    image[i][j * 3 + 2] = data[(i*bytesPerRow + j)];
                 }
             }
         } else if (components == 3) {
@@ -62,12 +66,12 @@ namespace eval ::image {
             for (size_t i = 0; i < height; i++) {
                 image[i] = calloc(width * 3, sizeof (JSAMPLE));
                 for (size_t j = 0; j < width; j++) {
-                    image[i][j * 3 + 0] = data[(i * width + j) * 3];
-                    image[i][j * 3 + 1] = data[(i * width + j) * 3 + 1];
-                    image[i][j * 3 + 2] = data[(i * width + j) * 3 + 2];
+                    image[i][j * 3 + 0] = data[i*bytesPerRow + j*3];
+                    image[i][j * 3 + 1] = data[i*bytesPerRow + j*3 + 1];
+                    image[i][j * 3 + 2] = data[i*bytesPerRow + j*3 + 2];
                 }
             }
-        }
+        } else { exit(1); }
 
       struct jpeg_compress_struct compress;
       struct jpeg_error_mgr error;
@@ -92,7 +96,7 @@ namespace eval ::image {
       free(image);
     }
 
-    void png(FILE* dest, uint8_t* data, uint32_t components, uint32_t width, uint32_t height) {
+    void png(FILE* dest, uint8_t* data, uint32_t components, uint32_t bytesPerRow, uint32_t width, uint32_t height) {
         png_structp png_w = png_create_write_struct(PNG_LIBPNG_VER_STRING, NULL, NULL, NULL);
         png_infop info_w = png_create_info_struct(png_w);
 
@@ -100,14 +104,15 @@ namespace eval ::image {
             png_set_IHDR(png_w, info_w, width, height, 8, PNG_COLOR_TYPE_RGB,
                 PNG_INTERLACE_NONE, PNG_COMPRESSION_TYPE_DEFAULT,
                 PNG_FILTER_TYPE_DEFAULT);
-        else
+        else if (components == 1)
             png_set_IHDR(png_w, info_w, width, height, 8, PNG_COLOR_TYPE_GRAY,
                 PNG_INTERLACE_NONE, PNG_COMPRESSION_TYPE_DEFAULT,
                 PNG_FILTER_TYPE_DEFAULT);
+        else exit(1);
 
         png_bytep* row_pointers = (png_bytep *)malloc(sizeof(png_bytep) * height);
         for (int i = 0; i < height; i++) {
-            row_pointers[i] = data + i * width * components;
+            row_pointers[i] = data + i * bytesPerRow;
         }
 
         png_init_io(png_w, dest);
@@ -120,12 +125,12 @@ namespace eval ::image {
     }
     $cc proc saveAsJpeg {image_t im char* filename} void {
         FILE* out = fopen(filename, "w");
-        jpeg(out, im.data, im.components, im.width, im.height, 100);
+        jpeg(out, im.data, im.components, im.bytesPerRow, im.width, im.height, 100);
         fclose(out);
     }
     $cc proc saveAsPng {image_t im char* filename} void {
         FILE* out = fopen(filename, "wb");
-        png(out, im.data, im.components, im.width, im.height);
+        png(out, im.data, im.components, im.bytesPerRow, im.width, im.height);
         fclose(out);
     }
     # Given the four corners of a region in an image, warp it to a new image of a given width and height
@@ -260,6 +265,7 @@ namespace eval ::image {
     $cc proc freePng {image_t im} void {
         // TODO: Free the PNG.
     }
+
     $cc compile
 
     variable imagesCache [dict create]
diff --git a/virtual-programs/label.folk b/virtual-programs/label.folk
index 624ae8ad..440bbf48 100644
--- a/virtual-programs/label.folk
+++ b/virtual-programs/label.folk
@@ -4,15 +4,20 @@ When /thing/ has region /region/ {
     # set height [region height $region]
     set radians [region angle $region]
 
-    When the collected matches for [list /someone/ wishes $thing is labelled /text/] are /matches/ {
+    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
+        Display::text $x $y $scale $text $radians [dict get $match font]
     }
 }
 
+When /someone/ wishes /thing/ is labelled /text/ {
+  # Set the default font
+  Wish $thing is labelled $text with font "PTSans-Regular"
+}
+
 fn text {coords text angle} {
   Display::text [lindex $coords 0] [lindex $coords 1] 2 $text $angle
 }
diff --git a/virtual-programs/programs.folk b/virtual-programs/programs.folk
new file mode 100644
index 00000000..f42e1360
--- /dev/null
+++ b/virtual-programs/programs.folk
@@ -0,0 +1,22 @@
+
+
+When (non-capturing) /type/ /obj/ has a program {
+    puts "Added $type $obj"
+    On unmatch { puts "Removed $type $obj" }
+
+    try {
+    set tempPath "$::env(HOME)/folk-printed-programs/$obj.folk.temp"
+
+    if {[file exists $tempPath]} {
+      set path [open "$::env(HOME)/folk-printed-programs/$obj.folk.temp" r]
+    } else {
+      set path [open "$::env(HOME)/folk-printed-programs/$obj.folk" r]
+    }
+     set code [read $path]
+     close $path
+
+     Claim $obj has program code $code
+     } on error error {
+      puts stderr "No code for $type $obj"
+     }
+}
diff --git a/virtual-programs/tags-and-calibration.folk b/virtual-programs/tags-and-calibration.folk
index b219b541..f6aeb812 100644
--- a/virtual-programs/tags-and-calibration.folk
+++ b/virtual-programs/tags-and-calibration.folk
@@ -33,6 +33,10 @@ When camera /camera/ has width /cameraWidth/ height /cameraHeight/ {
                                 [expr {double($dy)/$generatedCalibration::displayHeight*$Display::HEIGHT}]]
         }
     }
+    if {[llength $points] < 4} {
+        puts stderr "tags-and-calibration: Calibration isn't valid (not enough points). Stopping Folk."
+        exit 1
+    }
     for {set i 0} {$i < [llength $points]} {incr i} {
         lassign [lindex $points $i] x$i y$i u$i v$i
     }
@@ -114,28 +118,6 @@ When camera /camera/ has width /cameraWidth/ height /cameraHeight/ {
     }
 }
 
-When (non-capturing) tag /tag/ has center /c/ size /size/ {
-     Claim tag $tag is a tag
-}
-
-When (non-capturing) tag /tag/ is a tag {
-    puts "Added tag $tag"
-    On unmatch { puts "Removed tag $tag" }
-
-    set tempPath "$::env(HOME)/folk-printed-programs/$tag.folk.temp"
-
-    if {[file exists $tempPath]} {
-      set path [open "$::env(HOME)/folk-printed-programs/$tag.folk.temp" r]
-    } else {
-      set path [open "$::env(HOME)/folk-printed-programs/$tag.folk" r]
-    }
-     set code [read $path]
-     close $path
-
-     # Wish $tag is outlined green
-     Claim $tag has program code $code
-}
-
 When (non-capturing) tag /tag/ has corners /corners/ {
     set tagCorners [lmap p $corners {::cameraToProjector $p}]
 
@@ -156,4 +138,5 @@ When (non-capturing) tag /tag/ has corners /corners/ {
     set region [region create $corners $edges $angle]
 
     Claim $tag has region $region
+    Claim tag $tag has a program
 }
diff --git a/virtual-programs/title.folk b/virtual-programs/title.folk
index e17d9d75..fccacc17 100644
--- a/virtual-programs/title.folk
+++ b/virtual-programs/title.folk
@@ -1,6 +1,6 @@
 # Title/footnote wish fulfillment
 # for wishes of the form:
-# "Wish $tag has title "This is a tag"" or "Wish $tag has footnote "This is a footnote""
+# "Wish $tag is titled "This is a tag"" or "Wish $tag is footnoted "This is a footnote""
 
 
 When /thing/ has region /region/ {
@@ -9,7 +9,7 @@ When /thing/ has region /region/ {
     set top [vec2 add [region top $region] [vec2 rotate [list 0 -12] $radians]]
     set bot [vec2 add [region bottom $region] [vec2 rotate [list 0 16] $radians]]
 
-    When the collected matches for [list /someone/ wishes $thing has title /text/] are /matches/ {
+    When the collected matches for [list /someone/ wishes $thing is titled /text/] are /matches/ {
         set text [join [lmap match $matches {dict get $match text}] "\n"]
         if {$text eq ""} { return }
     
@@ -17,7 +17,7 @@ When /thing/ has region /region/ {
         Display::text {*}$top $scale $text $radians
     }
 
-    When the collected matches for [list /someone/ wishes $thing has footnote /text/] are /matches/ {
+    When the collected matches for [list /someone/ wishes $thing is footnoted /text/] are /matches/ {
         set text [join [lmap match $matches {dict get $match text}] "\n"]
         if {$text eq ""} { return }