Merge branch 'main' into osnr/operation-log

6 files changed, 199 insertions, 52 deletions

diff --git a/virtual-programs/apriltags.folk b/virtual-programs/apriltags.folk
index c7ae25b7..8bdd415a 100644
--- a/virtual-programs/apriltags.folk
+++ b/virtual-programs/apriltags.folk
@@ -138,4 +138,5 @@ When the collected matches for [list /someone/ detects tags /tags/ at /timestamp
         Claim tag $id has corners [dict get $tag corners]
     }
     set ::aprilTime [lmap m $matches {dict get $m aprilTime}]
+    Claim the AprilTag time is $::aprilTime
 }
diff --git a/virtual-programs/display.folk b/virtual-programs/display.folk
index 75ad5cf1..674cf1f7 100644
--- a/virtual-programs/display.folk
+++ b/virtual-programs/display.folk
@@ -86,7 +86,9 @@ On process {
     }
 }
 
+set ::Display::displayTime none
 set ::displayTime none
 When the display time is /displayTime/ {
+    set ::Display::displayTime $displayTime
     set ::displayTime $displayTime
 }
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/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/shapes.folk b/virtual-programs/shapes.folk
index 25c615c5..2864b13c 100644
--- a/virtual-programs/shapes.folk
+++ b/virtual-programs/shapes.folk
@@ -1,41 +1,3 @@
-set sizeDict [dict create small 1 medium 4 large 10]
-
-proc isSizeWord {word} {
-  expr {[lsearch [list small medium large] $word] >= 0}
-}
-
-proc rectangle {x y w h {strokeWeight 5} {color "white"}} {
-  set start [list $x $y]
-  set points [list $start]
-
-  puts [list [expr {$x + $w}] $y]
-
-  lappend points [list [expr {$x + $w}] $y]
-  lappend points [list [expr {$x + $w}] [expr {$y + $h}]]
-  lappend points [list $x [expr {$y + $h}]]
-  lappend points $start
-  Display::stroke $points $strokeWeight $color
-}
-
-proc square {x y w {strokeWeight 5} {color "white"} args} {
-  rectangle $x $y $w $w $strokeWeight $color
-}
-
-proc regionToInnerRect {region} {
-    set vertices [lindex $region 0]
-    lassign $vertices a b c d
-    lassign $a aX aY
-    lassign $c cX cY
-    set shrinkConstant 0.65
-    set width [expr {($cX - $aX) * $shrinkConstant}]
-    set height [expr {($cY - $aY) * $shrinkConstant}]
-    set x [expr {$aX + $width * 0.25}]
-    set y [expr {$aY + $height * 0.25}]
-    return [list $x $y $width $height]
-}
-
-# --- Wish $this has ... ----
-
 # numPoints 2 => line
 # numPoints 3 => triangle
 # numPoints 4 => square
@@ -58,7 +20,9 @@ proc shape {numPoints x y r {color white} {filled false} args} {
 }
 
 When /someone/ wishes /p/ draws a /color/ /shape/ offset /offsetVector/ & /p/ has region /r/ {
-  lassign [regionToInnerRect $r] x y width height
+  lassign [region centroid $r] x y
+  set width [region width $r]
+  set height [region height $r]
   lassign $offsetVector offsetX offsetY
  
   if {$offsetX != 0} {
@@ -68,36 +32,75 @@ When /someone/ wishes /p/ draws a /color/ /shape/ offset /offsetVector/ & /p/ ha
     set y [expr {$y + $offsetY}]
   }
 
-  set adjustedWidth [expr {$width * 0.25}]
-  set x [expr { $x * 1.3}]
-  set y [expr { $y * 1.25}]
+  # puts "drawing a $shape at $x $y with width $width and height $height"
+  set radius 50
   switch -nocase $shape {
     triangle {
-      shape 3 $x $y $adjustedWidth $color
+      shape 3 $x $y $radius $color
     }
     square {
-      shape 4 $x $y $adjustedWidth $color
+      shape 4 $x $y $radius $color
+    }
+    pentagon {
+      shape 5 $x $y $radius $color
+    }
+    hexagon {
+      shape 6 $x $y $radius $color
+    }
+    septagon {
+      shape 7 $x $y $radius $color
+    }
+    octagon {
+      shape 8 $x $y $radius $color
+    }
+    nonagon {
+      shape 9 $x $y $radius $color
     }
-    # TODO: cwervo - fix magic numbers here
     circle {
-      shape 30 [expr {$x * 0.94}] $y [expr {$adjustedWidth * 0.1}] $color
+      Display::circle $x $y $radius 5 $color
     }
     default {
-      shape 5 $x $y $adjustedWidth $color
+      shape 2 $x $y $radius $color
     }
   }
 }
 
+set defaultColor white
+
 When /someone/ wishes /p/ draws a /color/ /shape/ & /p/ has region /r/ {
   Wish $p draws a $color $shape offset {0 0}
 }
 
 When /someone/ wishes /p/ draws a /shape/ & /p/ has region /r/ {
-  Wish $p draws a white $shape
+  Wish $p draws a $defaultColor $shape
 }
 
 When /someone/ wishes /p/ draws a /shape/ offset /offsetVector/ {
-  Wish $p draws a white $shape offset $offsetVector 
+  Wish $p draws a $defaultColor $shape offset $offsetVector 
 }
 
-# --- TODO: Wish table has ... ----
+Claim $this has demo {
+  Wish $this draws a circle
+  Wish $this draws a skyblue triangle
+  Wish $this draws a green triangle offset {280 0}
+  Wish $this draws a gold pentagon offset {200 0}
+  Wish $this draws a red octagon offset {250 80}
+
+  When the clock time is /t/ {
+    set offsetVector [list [sin $t] [cos $t]]
+    set offsetVector [::vec2::scale $offsetVector 105]
+    Wish $this draws a palegoldenrod circle offset $offsetVector
+  }
+
+  # This toggles a square between filled and unfilled
+  # TODO cwervo: Support `Wish $this draws a circle with options /optionsDict/` to make this cleaner
+  # optionsDisct: {size number?: 50, filled boolean?: false, color string?: white, thickness string? white }
+  When $this has region /r/ & the clock time is /t/ {
+    lassign [region centroid $r] x y
+    set fill [expr {round(sin($t) * 2) % 2 == 0 ? true : false}]
+    set y [- $y 150]
+    shape 4 [- $x 100] $y 60 white $fill
+  }
+
+  Wish $this is outlined white
+}
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
+    }
+}