Merge branch 'main' into osnr/vulkan-display

12 files changed, 477 insertions, 41 deletions

diff --git a/virtual-programs/apriltags.folk b/virtual-programs/apriltags.folk
index 01377b78..ac2c4f8b 100644
--- a/virtual-programs/apriltags.folk
+++ b/virtual-programs/apriltags.folk
@@ -1,6 +1,7 @@
 if {$::isLaptop} return
 
-On process {
+# Plain detector. Runs on entire camera frame.
+set mainDetectorProcess [On process {
     source pi/AprilTags.tcl
     AprilTags::init
 
@@ -9,29 +10,131 @@ On process {
     Retract /anyone/ wishes $::thisProcess shares all wishes
     Retract /anyone/ wishes $::thisProcess shares all claims
     Wish $::thisProcess receives statements like \
-        [list /someone/ claims the camera frame is /grayFrame/]
+        [list /someone/ claims the camera frame is /grayFrame/ at /timestamp/]
     Wish $::thisProcess shares statements like \
         [list /someone/ wishes /process/ receives statements like /pattern/]
     Wish $::thisProcess shares statements like \
-        [list /someone/ claims tag /tag/ has center /center/ size /size/]
-    Wish $::thisProcess shares statements like \
-        [list /someone/ claims tag /tag/ has corners /corners/]
-    Wish $::thisProcess shares statements like \
-        [list /someone/ claims the AprilTag time is /aprilTime/]
+        [list /someone/ claims /process/ detects tags /tags/ at /timestamp/ in time /aprilTime/]
     Wish $::thisProcess shares statements like \
         [list /someone/ claims $::thisProcess has pid /pid/]
 
-    When the camera frame is /grayFrame/ {
+    When the camera frame is /grayFrame/ at /timestamp/ {
         set aprilTime [time {
             set tags [AprilTags::detect $grayFrame]
         }]
-        Commit {
-            Claim the AprilTag time is $aprilTime
+        Claim $::thisProcess detects tags $tags at $timestamp in time $aprilTime
+    }
+}]
+
+# Incremental detector. Looks at regions where there were tags in the
+# old camera frame.
+On process {
+    source pi/AprilTags.tcl
+    AprilTags::init
 
-            foreach tag $tags {
-                Claim tag [dict get $tag id] has center [dict get $tag center] size [dict get $tag size]
-                Claim tag [dict get $tag id] has corners [dict get $tag corners]
+    # TODO: Clean this up. We retract these so that we don't bounce
+    # statements back to the main Folk process that it sends us.
+    Retract /anyone/ wishes $::thisProcess shares all wishes
+    Retract /anyone/ wishes $::thisProcess shares all claims
+    Wish $::thisProcess receives statements like \
+        [list /someone/ claims the camera frame is /grayFrame/ at /timestamp/]
+    Wish $::thisProcess receives statements like \
+        [list /someone/ claims $mainDetectorProcess detects tags /tags/ at /timestamp/ in time /aprilTime/]
+    Wish $::thisProcess shares statements like \
+        [list /someone/ wishes /process/ receives statements like /pattern/]
+    Wish $::thisProcess shares statements like \
+        [list /someone/ claims $::thisProcess has pid /pid/]
+    Wish $::thisProcess shares statements like \
+        [list /someone/ claims $::thisProcess detects tags /tags/ at /timestamp/ in time /aprilTime/]
+    Wish $::thisProcess shares statements like \
+        [list /someone/ wishes /something/ is labelled /text/]
+    Wish $::thisProcess shares statements like \
+        [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]
+	}
+    }
+
+    When the camera frame is /grayFrame/ at /timestamp/ & \
+         /process/ detects tags /prevTags/ at /something/ in time /something/ {
+
+        if {$process eq $::thisProcess} { return }
+
+        set tags [list]
+        set frameWidth [dict get $grayFrame width]
+        set frameHeight [dict get $grayFrame height]
+        set aprilTime 0
+        foreach prevTag $prevTags {
+            set size [dict get $prevTag size]
+            set corners [dict get $prevTag corners]
+            set x [min {*}[lmap corner $corners {lindex $corner 0}]]
+            set y [min {*}[lmap corner $corners {lindex $corner 1}]]
+            set x1 [max {*}[lmap corner $corners {lindex $corner 0}]]
+            set y1 [max {*}[lmap corner $corners {lindex $corner 1}]]
+            
+            set x [max [- $x $size] 0]
+            set y [max [- $y $size] 0]
+            set x1 [min [+ $x1 $size] $frameWidth]
+            set y1 [min [+ $y1 $size] $frameHeight]
+
+            set subimage [subimage $grayFrame $x $y [- $x1 $x] [- $y1 $y]]
+            set aprilTime [+ $aprilTime [baretime {
+                foreach tag [AprilTags::detect $subimage] {
+                    dict with tag {
+                        set center [vec2 add $center [list $x $y]]
+                        set corners [lmap corner $corners {vec2 add $corner [list $x $y]}]
+                    }
+                    lappend tags $tag
+                }
+            }]]
+        }
+
+        # Wish 6 is labelled "[llength $prevTags] -> [llength $tags] ($aprilTime us)"
+
+        Claim $::thisProcess detects tags $tags at $timestamp in time $aprilTime
+        # Wish 6 is labelled "\n\nStep time $::stepTime\n[join [lmap s [dict values [Statements::all]] {statement short $s}] "\n"]"
+    }
+}
+
+# This cache is used to remember the last seen position of each tag,
+# so that if the incremental detector blinks out, we still use the
+# tag's last-found position from it, instead of the older position
+# from the full detector, so as you move a tag its position doesn't
+# glitch backward.
+set ::tagsCache [dict create]
+# TODO: Garbage-collect this cache.
+
+When the collected matches for [list /someone/ detects tags /tags/ at /timestamp/ in time /aprilTime/] are /matches/ {
+    set tagsSeen [dict create]
+    foreach match $matches {
+        set timestamp [dict get $match timestamp]
+        foreach tag [dict get $match tags] {
+            set id [dict get $tag id]
+            dict set tag timestamp $timestamp
+
+            if {[dict exists $::tagsCache $id] &&
+                [dict get $::tagsCache $id timestamp] > $timestamp} {
+                set tag [dict get $::tagsCache $id]
+            } else {
+                dict set ::tagsCache $id $tag
             }
+            dict set tagsSeen $id $tag
         }
     }
+
+    dict for {id tag} $tagsSeen {
+        Claim tag $id has center [dict get $tag center] size [dict get $tag size]
+        Claim tag $id has corners [dict get $tag corners]
+    }
+    Claim the AprilTag time is [lmap m $matches {dict get $m aprilTime}]
 }
diff --git a/virtual-programs/camera.folk b/virtual-programs/camera.folk
index d9dab784..0a95c8f0 100644
--- a/virtual-programs/camera.folk
+++ b/virtual-programs/camera.folk
@@ -18,15 +18,18 @@ On process {
     source pi/Camera.tcl
     Camera::init $width $height
 
-    puts "Camera tid: [getTid]"
-    
-    forever {
-        set cameraTime [time {
-            set grayFrame [Camera::grayFrame]
-        }]
+    puts "Camera tid: [getTid] booting at [clock milliseconds]"
+
+    When $::thisProcess has step count /c/ {
+        set grayFrame [Camera::grayFrame]
         Commit {
-            Claim the camera time is $cameraTime
-            Claim the camera frame is $grayFrame
+            Claim the camera time is $::stepTime
+            Claim the camera frame is $grayFrame at [clock milliseconds]
         }
     }
 }
+
+# For backward compatibility.
+When the camera frame is /grayFrame/ at /timestamp/ {
+    Claim the camera frame is $grayFrame
+}
diff --git a/virtual-programs/display.folk b/virtual-programs/display.folk
new file mode 100644
index 00000000..d3f6b610
--- /dev/null
+++ b/virtual-programs/display.folk
@@ -0,0 +1,93 @@
+if {$::isLaptop} return
+
+namespace eval ::Display {
+    variable WIDTH
+    variable HEIGHT
+    variable LAYER 0
+    regexp {mode "(\d+)x(\d+)"} [exec fbset] -> WIDTH HEIGHT
+
+    proc drawOnTop {func args} {
+        set ::Display::LAYER 1
+        uplevel [list $func {*}$args]
+        set ::Display::LAYER 0
+    }
+
+    proc stroke {points width color} {
+        uplevel [list Wish display runs [list Display::stroke $points $width $color] 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]
+    }
+
+    proc text args {
+        uplevel [list Wish display runs [list Display::text {*}$args] on layer $::Display::LAYER]
+    }
+
+    proc fillTriangle args {
+        uplevel [list Wish display runs [list Display::fillTriangle {*}$args] on layer $::Display::LAYER]
+    }
+
+    proc fillQuad args {
+        uplevel [list Wish display runs [list Display::fillQuad {*}$args] on layer $::Display::LAYER]
+    }
+
+    proc fillPolygon args {
+        uplevel [list Wish display runs [list Display::fillPolygon {*}$args] on layer $::Display::LAYER]
+    }
+
+    variable displayTime none
+}
+
+On process {
+    source pi/Display.tcl
+    Display::init
+    puts "Display tid: [getTid]"
+
+    # TODO: Clean this up. We retract these so that we don't bounce
+    # statements back to the main Folk process that it sends us.
+    Retract /anyone/ wishes $::thisProcess shares all wishes
+    Retract /anyone/ wishes $::thisProcess shares all claims
+    Wish $::thisProcess shares statements like \
+        [list /someone/ wishes /process/ receives statements like /pattern/]
+    Wish $::thisProcess shares statements like \
+        [list /someone/ claims $::thisProcess has pid /pid/]
+    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/]
+    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 renderTime [baretime [list foreach command $displayCommands { {*}$command }]]
+        set commitTime [baretime commitThenClearStaging]
+
+        Commit { Claim the display time is "render $renderTime us + commit $commitTime us ($::stepTime)" }
+        Step
+    }
+}
+# TODO: remove this compatibility hack
+When the display time is /displayTime/ {
+    set ::Display::displayTime $displayTime
+}
diff --git a/virtual-programs/esc-restart.folk b/virtual-programs/esc-restart.folk
index 01a6dd94..ee8aa847 100644
--- a/virtual-programs/esc-restart.folk
+++ b/virtual-programs/esc-restart.folk
@@ -1,5 +1,3 @@
-When the keyboard character log is /k/ {
-	foreach press $k {
-		if {$press eq "esc"} {exec sudo systemctl restart folk}
-	}
-}
\ No newline at end of file
+When keyboard claims key ESC is down with modifiers alt {
+	exec sudo systemctl restart folk
+}
diff --git a/virtual-programs/images.folk b/virtual-programs/images.folk
index 6846975e..ee3988ea 100644
--- a/virtual-programs/images.folk
+++ b/virtual-programs/images.folk
@@ -32,6 +32,7 @@ namespace eval ::image {
     defineImageType $cc
     $cc include <stdlib.h>
     $cc include <string.h>
+    $cc import ::Heap::cc folkHeapAlloc as folkHeapAlloc
 
     $cc code {
         #undef EXTERN
@@ -40,18 +41,30 @@ namespace eval ::image {
         #include <unistd.h>
 
         void 
-    jpeg(FILE* dest, uint8_t* rgb, uint32_t width, uint32_t height, int quality)
+    jpeg(FILE* dest, uint8_t* data, uint32_t components, uint32_t width, uint32_t height, int quality)
     {
-      JSAMPARRAY image;
-      image = calloc(height, sizeof (JSAMPROW));
-      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] = rgb[(i * width + j)];
-          image[i][j * 3 + 1] = rgb[(i * width + j)];
-          image[i][j * 3 + 2] = rgb[(i * width + j)];
+        JSAMPARRAY image;
+        if (components == 1) {
+            image = calloc(height, sizeof (JSAMPROW));
+            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)];
+                }
+            }
+        } else if (components == 3) {
+            image = calloc(height, sizeof (JSAMPROW));
+            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];
+                }
+            }
         }
-      }
 
       struct jpeg_compress_struct compress;
       struct jpeg_error_mgr error;
@@ -79,11 +92,103 @@ namespace eval ::image {
     }
     $cc proc saveAsJpeg {image_t im char* filename} void {
         FILE* out = fopen(filename, "w");
-        jpeg(out, im.data, im.width, im.height, 100);
+        jpeg(out, im.data, im.components, im.width, im.height, 100);
         fclose(out);
     }
+    # Given the four corners of a region in an image, warp it to a new image of a given width and height
+    $cc proc warp {image_t im uint32_t tl_x uint32_t tl_y uint32_t tr_x uint32_t tr_y uint32_t br_x uint32_t br_y uint32_t bl_x uint32_t bl_y uint32_t output_width uint32_t output_height} image_t {
+        image_t ret;
+        ret.width = output_width;
+        ret.height = output_height;
+        ret.components = im.components;
+        ret.bytesPerRow = ret.width * ret.components;
+        ret.data = folkHeapAlloc(ret.bytesPerRow * ret.height);
+
+        for (int y = 0; y < output_height; y++) {
+            for (int x = 0; x < output_width; x++) {
+                // calculate the position in the input image
+                float u = (float)x / (float)(output_width - 1);
+                float v = (float)y / (float)(output_height - 1);
+                int input_x = tl_x + u * (int)(tr_x - tl_x) + v * (int)(bl_x - tl_x);
+                int input_y = tl_y + u * (int)(tr_y - tl_y) + v * (int)(bl_y - tl_y);
+
+                if (input_x >= 0 && input_x < im.width && input_y >= 0 && input_y < im.height) {
+                    memcpy(&ret.data[y * ret.bytesPerRow + x * ret.components],
+                        &im.data[input_y * im.bytesPerRow + input_x * im.components],
+                        im.components);
+                }
+            }
+        }
+        return ret;
+    }
+    $cc proc loadJpeg {char* filename} image_t {
+        FILE* file = fopen(filename, "rb");
+        if (!file) {
+            fprintf(stderr, "Error opening file: %s\n", filename);
+            exit(1);
+        }
+        
+        struct jpeg_decompress_struct cinfo;
+        struct jpeg_error_mgr jerr;
+        
+        cinfo.err = jpeg_std_error(&jerr);
+        jpeg_create_decompress(&cinfo);
+        jpeg_stdio_src(&cinfo, file);
+        jpeg_read_header(&cinfo, TRUE);
+        jpeg_start_decompress(&cinfo);
+        
+        image_t ret;
+        ret.width = cinfo.output_width;
+        ret.height = cinfo.output_height;
+        ret.components = cinfo.output_components;
+        ret.bytesPerRow = ret.width * ret.components;
+        ret.data = folkHeapAlloc(ret.bytesPerRow * ret.height);
+        
+        JSAMPROW row_pointer[1];
+        while (cinfo.output_scanline < cinfo.output_height) {
+            row_pointer[0] = (JSAMPLE*)ret.data + cinfo.output_scanline * ret.bytesPerRow;
+            jpeg_read_scanlines(&cinfo, row_pointer, 1);
+        }
+        
+        jpeg_finish_decompress(&cinfo);
+        jpeg_destroy_decompress(&cinfo);
+        fclose(file);
+        
+        return ret;
+    }
+    $cc proc freeJpeg {image_t im} void {
+        // TODO: Free the JPEG.
+        // ckfree(im.data);
+    }
     $cc compile
 
+    variable imagesCache [dict create]
+    # Loads a URL or file path if passed. If passed a valid image_t,
+    # just returns that image_t.
+    proc load {im} {
+        variable imagesCache
+        if {[dict exists $imagesCache $im]} {
+            set im [dict get $imagesCache $im]
+        } else {
+            set impath $im
+            if {[string match "http*://*" $impath]} {
+                set im /tmp/[regsub -all {\W+} $impath "_"]
+                exec -ignorestderr curl -o$im $impath
+            }
+            if {[string match "*jpg" $im] ||
+                [string match "*jpeg" $im] ||
+                [string match "*png" $im]} {
+                # TODO: Support .png
+                set path [expr {[file pathtype $im] eq "relative" ?
+                                "$::env(HOME)/folk-images/$im" :
+                                $im}]
+                set im [image loadJpeg $path]
+                dict set imagesCache $impath $im
+            }
+        }
+        set im
+    }
+
     namespace export *
     namespace ensemble create
 }
@@ -116,9 +221,28 @@ When when /p/ has camera slice /slice/ /lambda/ with environment /e/ {
 
 # Display a camera slice
 When /someone/ wishes /p/ displays camera slice /slice/ & /p/ has region /r/ {
-  set origin [lindex $r 0 0]
+  set center [region centroid $r]
   # set scale [expr {$Display::WIDTH / $Camera::WIDTH}]
   # Use 1x scale instead of $scale so the projected tag doesn't redetect.
   # TODO: Mask the tag out?
-  Wish display runs [list Display::image {*}$origin $slice 1]
+    Wish display runs [list Display::image {*}$center $slice 0 1]
+}
+
+When /someone/ wishes /p/ displays image /im/ {
+    set im [image load $im]
+    When $p has region /r/ {
+        # Compute a scale for im that will fit in the region width/height
+        # Draw im with scale and rotation
+        set center [region centroid $r]
+        # set width [region width $r]
+        # set height [region height $r]
+        # set scale [expr {min($width / [image width $im],
+        #                      $height / [image height $im])}]
+        # Wish $p is labelled $im
+        Wish display runs [list Display::image {*}$center $im [region angle $r] 1]
+    }
+    # On unmatch {
+    #     # HACK: Leaves time for the display to finish trying to display this.
+    #     after 5000 [list image freeJpeg $im]
+    # }
 }
diff --git a/virtual-programs/mask-tags.folk b/virtual-programs/mask-tags.folk
new file mode 100644
index 00000000..4f0ae4b2
--- /dev/null
+++ b/virtual-programs/mask-tags.folk
@@ -0,0 +1,16 @@
+When tag /something/ has corners /corners/ {
+    set tagCorners [lmap p $corners {::cameraToProjector $p}]
+
+    set vecBottom [sub [lindex $tagCorners 1] [lindex $tagCorners 0]]
+    set vecRight [sub [lindex $tagCorners 2] [lindex $tagCorners 1]]
+
+    set offsets {{-0.5 -0.5} {0.5 -0.5} {0.5 0.5} {-0.5 0.5}}
+    set scales [matmul $offsets [list $vecBottom $vecRight]]
+    set corners [add $tagCorners $scales]
+
+    set p0 [lindex $corners 0]
+    set p1 [lindex $corners 1]
+    set p2 [lindex $corners 2]
+    set p3 [lindex $corners 3]
+    Display::drawOnTop Display::fillQuad $p0 $p1 $p2 $p3 black
+}
\ No newline at end of file
diff --git a/virtual-programs/points-at.folk b/virtual-programs/points-at.folk
index 1472b379..a037f98f 100644
--- a/virtual-programs/points-at.folk
+++ b/virtual-programs/points-at.folk
@@ -19,7 +19,7 @@ When /someone/ wishes /rect/ points /direction/ with length /l/ & /rect/ has reg
         set whiskerRegion [region scale $region height 0.01px width $scale]
         set whiskerRegion [region move $whiskerRegion left \
                                [vec2 distance [region right $whiskerRegion] [region left $region]]px]
-        set color red
+        set color gold
     } elseif {$direction eq "right"} {
         set whiskerRegion [region scale $region height 0.01px width $scale]
         set whiskerRegion [region move $whiskerRegion right \
diff --git a/virtual-programs/print.folk b/virtual-programs/print.folk
index badd191f..44a7d433 100644
--- a/virtual-programs/print.folk
+++ b/virtual-programs/print.folk
@@ -163,6 +163,10 @@ proc nextId {} {
         set id 0
     }
 
+    while {[file exists "$::env(HOME)/folk-printed-programs/$id.folk"]} {
+        incr id
+    }
+
     set fp [open "$::env(HOME)/folk-printed-programs/next-id.txt" w]
     puts $fp [expr {$id + 1}]
     close $fp
diff --git a/virtual-programs/regions.folk b/virtual-programs/regions.folk
index 5de19b98..945fcd20 100644
--- a/virtual-programs/regions.folk
+++ b/virtual-programs/regions.folk
@@ -1,3 +1,8 @@
 When when the distance between /p1/ and /p2/ is /distanceVar/ /body/ with environment /e/ & /p1/ has region /r1/ & /p2/ has region /r2/ {
     Claim the distance between $p1 and $p2 is [region distance $r1 $r2]
 }
+
+When /someone/ wishes region /r/ is /verbed/ /x/ {
+  Claim $r has region $r
+  Wish $r is $verbed $x
+}
diff --git a/virtual-programs/tags-and-calibration.folk b/virtual-programs/tags-and-calibration.folk
index afb4aef4..b219b541 100644
--- a/virtual-programs/tags-and-calibration.folk
+++ b/virtual-programs/tags-and-calibration.folk
@@ -119,7 +119,8 @@ When (non-capturing) tag /tag/ has center /c/ size /size/ {
 }
 
 When (non-capturing) tag /tag/ is a tag {
-     puts "Added tag $tag"
+    puts "Added tag $tag"
+    On unmatch { puts "Removed tag $tag" }
 
     set tempPath "$::env(HOME)/folk-printed-programs/$tag.folk.temp"
 
diff --git a/virtual-programs/terminal.folk b/virtual-programs/terminal.folk
new file mode 100644
index 00000000..3fb335b5
--- /dev/null
+++ b/virtual-programs/terminal.folk
@@ -0,0 +1,86 @@
+# Terminal
+#
+# Spawn terminals with any command (default "bash"):
+#   Wish $this is a terminal
+#   Wish $this is a terminal spawning "any command"
+#
+# Send keyboard events to the terminal:
+#   Claim $thing has keyboard input
+#
+# Optionally, draw the terminal on an arbitrary region:
+#   Claim $thing has terminal region $region
+#
+#
+# Example program: Tie it all together with a simple vim editor...
+#
+#   When $this points up at /target/ & /target/ has program /anything/ {
+#     Wish $this is a terminal spawning "vim ~/folk-printed-programs/$target.folk"
+#     When $this has region /r/ {
+#       Claim $this has terminal region [region move $r right 350px]
+#     }
+#     Claim $this has keyboard input
+#   }
+#
+#
+# Note: Terminals are killed after ::termExpireMs of being unmatched.
+#
+
+source lib/terminal.tcl
+
+set ::termExpireMs [expr {10*60*1000}] ;# 10 minutes
+set ::termInstances [dict create]
+set ::termTimeouts [dict create]
+
+proc ::matchTerminal {id cmd} {
+  set termKey "$id $cmd"
+  if {$termKey ni $::termInstances} {
+    dict set ::termInstances $termKey [Terminal::create 12 43 $cmd]
+  }
+  if {$termKey in $::termTimeouts} {
+    after cancel [dict get $::termTimeouts $termKey]
+    dict unset ::termTimeouts $termKey
+  }
+  dict get $::termInstances $termKey
+}
+
+proc ::unmatchTerminal {id cmd} {
+  set termKey "$id $cmd"
+  dict set ::termTimeouts $termKey [
+    after $::termExpireMs "::destroyTerminal [list $termKey]"
+  ]
+}
+
+proc ::destroyTerminal {termKey} {
+  Terminal::destroy [dict get $::termInstances $termKey]
+  dict unset ::termInstances $termKey
+  dict unset ::termTimeouts $termKey
+}
+
+When /anyone/ wishes /thing/ is a terminal {
+  Wish $thing is a terminal spawning bash
+}
+
+When /thing/ has terminal region /r/ & /r/ has keyboard input {
+  Claim $thing has keyboard input
+}
+
+When /anyone/ wishes /thing/ is a terminal spawning /cmd/ {
+  set term [::matchTerminal $thing $cmd]
+  On unmatch { ::unmatchTerminal $thing $cmd }
+
+  When $::thisProcess has step count /c/ {
+    set body {
+      Wish region $region is labelled [Terminal::read $term]
+    }
+    When $thing has terminal region /region/ $body
+    When /nobody/ claims $thing has terminal region /x/ & $thing has region /region/ $body
+  }
+
+  When /anyone/ claims $thing has keyboard input \
+    & /anyone/ claims key /key/ is /direction/ with modifiers /modifiers/ {
+    if {$direction != "up"} {
+      set ctrlPressed [expr {"ctrl" in $modifiers}]
+      Terminal::write $term $key $ctrlPressed
+    }
+  }
+}
diff --git a/virtual-programs/time.folk b/virtual-programs/time.folk
new file mode 100644
index 00000000..1dff734d
--- /dev/null
+++ b/virtual-programs/time.folk
@@ -0,0 +1,3 @@
+When $::thisProcess has step count /t/ {
+    Claim the clock time is [/ [clock milliseconds] 1000.0]
+}