Merge branch 'main' into osnr/multiple-on-process-blocks

5 files changed, 76 insertions, 43 deletions

diff --git a/virtual-programs/display.folk b/virtual-programs/display.folk
index 47ed3d7e..aed9d51d 100644
--- a/virtual-programs/display.folk
+++ b/virtual-programs/display.folk
@@ -112,7 +112,6 @@ On process {
             namespace export *
             namespace ensemble create
         }
-        variable font [font load "PTSans-Regular"]
         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));
@@ -214,8 +213,26 @@ On process {
             Gpu::draw $circle [list $x $y] $radius $thickness [getColor $color] [ne $filled "false"]
         }
 
-        proc textExtent {text scale} {
-            variable font
+        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
@@ -236,8 +253,14 @@ On process {
             }
             return [list $width [+ $y $em]]
         }
-        proc text {x0 y0 scale text radians} {
-            variable font
+        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]] \
@@ -336,7 +359,7 @@ On process {
             return vec4(0.0, 0.0, 0.0, 0.0);
         }]
         variable imCache [dict create]
-        variable IMCACHE_MAX_IMAGES [- $Gpu::ImageManager::GPU_MAX_IMAGES 1]
+        variable IMCACHE_MAX_IMAGES [- $Gpu::ImageManager::GPU_MAX_IMAGES [dict size $::FontCache]]
         proc checkImCacheAndCopyIfNeeded {imDrawSet} {
             variable imCache
             variable IMCACHE_MAX_IMAGES
@@ -446,7 +469,10 @@ On process {
 
         set renderTime [baretime {
             Display::start
-            foreach command $displayCommands { {*}$command }
+            foreach command $displayCommands {
+                try { {*}$command } \
+                    on error e { puts stderr $::errorInfo }
+            }
             Display::end
         }]
 
diff --git a/virtual-programs/images.folk b/virtual-programs/images.folk
index bfa5daef..e748cd11 100644
--- a/virtual-programs/images.folk
+++ b/virtual-programs/images.folk
@@ -48,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) {
@@ -56,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) {
@@ -66,9 +66,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) * 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); }
@@ -96,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);
 
@@ -104,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);
@@ -124,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
diff --git a/virtual-programs/label.folk b/virtual-programs/label.folk
index ad5e406f..18c6e139 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 8bfa067c..f6aeb812 100644
--- a/virtual-programs/tags-and-calibration.folk
+++ b/virtual-programs/tags-and-calibration.folk
@@ -118,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}]
 
@@ -160,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
 }