Merge remote-tracking branch 'origin/main' into ac/better-shapes-sept-2023

7 files changed, 223 insertions, 39 deletions

diff --git a/virtual-programs/camera.folk b/virtual-programs/camera.folk
index 225a5880..0a95c8f0 100644
--- a/virtual-programs/camera.folk
+++ b/virtual-programs/camera.folk
@@ -20,15 +20,12 @@ On process {
 
     puts "Camera tid: [getTid] booting at [clock milliseconds]"
 
-    while true {
-        set cameraTime [time {
-            set grayFrame [Camera::grayFrame]
-        }]
+    When $::thisProcess has step count /c/ {
+        set grayFrame [Camera::grayFrame]
         Commit {
-            Claim the camera time is $cameraTime
+            Claim the camera time is $::stepTime
             Claim the camera frame is $grayFrame at [clock milliseconds]
         }
-        Step
     }
 }
 
diff --git a/virtual-programs/display.folk b/virtual-programs/display.folk
index c73b354c..d3f6b610 100644
--- a/virtual-programs/display.folk
+++ b/virtual-programs/display.folk
@@ -59,7 +59,6 @@ On process {
     Wish $::thisProcess shares statements like \
         [list /someone/ claims the display time is /displayTime/]
 
-    set ::frames [list]
     while true {
         set displayList [list]
         foreach match [Statements::findMatches {/someone/ wishes display runs /command/ on layer /layer/}] {
@@ -84,17 +83,7 @@ On process {
         set renderTime [baretime [list foreach command $displayCommands { {*}$command }]]
         set commitTime [baretime commitThenClearStaging]
 
-        set framesInLastSecond 0
-        set now [clock milliseconds]
-        lappend frames $now
-        foreach frame $frames {
-            if {$frame > $now - 1000} {
-                incr framesInLastSecond
-            }
-        }
-        set frames [lreplace $frames 0 end-$framesInLastSecond]
-
-        Commit { Claim the display time is "render $renderTime us + commit $commitTime us ($::stepTime) ($framesInLastSecond fps)" }
+        Commit { Claim the display time is "render $renderTime us + commit $commitTime us ($::stepTime)" }
         Step
     }
 }
diff --git a/virtual-programs/errors.folk b/virtual-programs/errors.folk
new file mode 100644
index 00000000..555b45bb
--- /dev/null
+++ b/virtual-programs/errors.folk
@@ -0,0 +1,11 @@
+When /p/ has error /err/ with info /info/ {
+    When the clock time is /t/ {
+        if {[expr {(int($t * 5)) % 2}] == 1} {
+            Wish $p is outlined white
+        } else {
+            Wish $p is outlined red
+        }
+    }
+
+    Wish $p has title $err
+}
\ No newline at end of file
diff --git a/virtual-programs/esc-restart.folk b/virtual-programs/esc-restart.folk
index 02d66f63..ee8aa847 100644
--- a/virtual-programs/esc-restart.folk
+++ b/virtual-programs/esc-restart.folk
@@ -1,3 +1,3 @@
-When keyboard claims key /key/ is /t/ with modifiers /m/ {
-	if {[string tolower $key] == "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 ee3988ea..927b2da7 100644
--- a/virtual-programs/images.folk
+++ b/virtual-programs/images.folk
@@ -27,6 +27,8 @@ namespace eval ::image {
 
     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]}]
+
     $cc cflags -ljpeg
     source "pi/cUtils.tcl"
     defineImageType $cc
@@ -37,6 +39,7 @@ namespace eval ::image {
     $cc code {
         #undef EXTERN
         #include <jpeglib.h>
+        #include <png.h>
         #include <stdint.h>
         #include <unistd.h>
 
@@ -89,12 +92,42 @@ namespace eval ::image {
       free(image);
     }
 
+    void png(FILE* dest, uint8_t* data, uint32_t components, 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);
+
+        if (components == 3)
+            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
+            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);
+
+        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;
+        }
+
+        png_init_io(png_w, dest);
+        png_set_rows(png_w, info_w, row_pointers);
+        png_write_png(png_w, info_w, PNG_TRANSFORM_IDENTITY, NULL);
+
+        free(row_pointers);
+    }
+
     }
     $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);
         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);
+        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;
@@ -121,6 +154,7 @@ namespace eval ::image {
         }
         return ret;
     }
+
     $cc proc loadJpeg {char* filename} image_t {
         FILE* file = fopen(filename, "rb");
         if (!file) {
@@ -156,10 +190,76 @@ namespace eval ::image {
         
         return ret;
     }
+
+    $cc proc loadPng {char* filename} image_t {
+        FILE* file = fopen(filename, "rb");
+        if (!file) {
+            fprintf(stderr, "Error opening file: %s\n", filename);
+            exit(1);
+        }
+
+        png_structp png = png_create_read_struct(PNG_LIBPNG_VER_STRING, NULL, NULL, NULL);
+        if(!png) {
+            fprintf(stderr, "Error reading png from file: %s it's not a png\n", filename);
+            exit(1);
+        }
+
+        png_infop info = png_create_info_struct(png);
+        if(!info) {
+            fprintf(stderr, "Error reading png from file: %s no info?\n", filename);
+            exit(1);
+        }
+
+        if(setjmp(png_jmpbuf(png))) {
+            fprintf(stderr, "Error reading png from file: %s setjmp error?\n", filename);
+            exit(1);
+        }
+
+        png_init_io(png, file);
+        png_read_info(png, info);
+
+        image_t ret;
+        ret.width = png_get_image_width(png, info);
+        ret.height = png_get_image_height(png, info);
+        int bytes_per_pixel =  png_get_channels(png, info);
+        ret.components = png_get_channels(png, info);
+        ret.bytesPerRow = ret.width * bytes_per_pixel;
+        ret.data = folkHeapAlloc(ret.bytesPerRow * ret.height);
+
+        // Iterate over the rows and read the image data into the buffer.
+        for (int i = 0; i < ret.height; i++) {
+            png_read_row(png, ret.data + (i * ret.bytesPerRow), NULL);
+        }
+
+        // Close the PNG file.
+        png_destroy_read_struct(&png, &info, NULL);
+
+        if (ret.components == 4) {
+            // Transcode from RGBA to RGB (we don't support RGBA yet.)
+            for(int i=0; i < ret.width*ret.height; i++) {
+                int r = ret.data[i*4+0],
+                    g = ret.data[i*4+1], 
+                    b = ret.data[i*4+2], 
+                    a = ret.data[i*4+3];
+
+                ret.data[i*3+0] = r * a / 255;
+                ret.data[i*3+1] = g * a / 255;
+                ret.data[i*3+2] = b * a / 255;
+            }
+            ret.components = 3;
+            ret.bytesPerRow = ret.width * ret.components;
+        }
+
+        return ret;
+    }
+
     $cc proc freeJpeg {image_t im} void {
         // TODO: Free the JPEG.
         // ckfree(im.data);
     }
+    $cc proc freePng {image_t im} void {
+        // TODO: Free the PNG.
+    }
     $cc compile
 
     variable imagesCache [dict create]
@@ -178,11 +278,14 @@ namespace eval ::image {
             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]
+                if {[string match "*jpg" $im] || [string match "*jpeg" $im]} {
+                    set im [image loadJpeg $path]
+                } else {
+                    set im [image loadPng $path]
+                }
                 dict set imagesCache $impath $im
             }
         }
diff --git a/virtual-programs/terminal.folk b/virtual-programs/terminal.folk
index 4cbf6339..3fb335b5 100644
--- a/virtual-programs/terminal.folk
+++ b/virtual-programs/terminal.folk
@@ -1,29 +1,86 @@
 # Terminal
 #
-# Wish $this is a terminal
-# Claim $this has keyboard input
+# 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
 
-When /anyone/ wishes /thing/ is a terminal {
-  # Create a new terminal instance for this $thing only once
-  When /nobody/ claims $thing has terminal instance /term/ {
-    Assert terminal claims $thing has terminal instance [Terminal::create]
+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
+}
 
-  When terminal claims $thing has terminal instance /term/ {
-    When $thing has region /r/ & /node/ has step count /c/ {
-      set display [region move $r up 180px]
-      Wish region $display is labelled [Terminal::read $term]
+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
-      }
+  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/title.folk b/virtual-programs/title.folk
new file mode 100644
index 00000000..e17d9d75
--- /dev/null
+++ b/virtual-programs/title.folk
@@ -0,0 +1,27 @@
+# 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""
+
+
+When /thing/ has region /region/ {
+    set radians [region angle $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/ {
+        set text [join [lmap match $matches {dict get $match text}] "\n"]
+        if {$text eq ""} { return }
+    
+        set scale 1
+        Display::text {*}$top $scale $text $radians
+    }
+
+    When the collected matches for [list /someone/ wishes $thing has footnote /text/] are /matches/ {
+        set text [join [lmap match $matches {dict get $match text}] "\n"]
+        if {$text eq ""} { return }
+
+        set scale 1
+        Display::text {*}$bot $scale $text $radians
+    }
+}