Merge branch 'main' into ac/editor

12 files changed, 180 insertions, 63 deletions

diff --git a/virtual-programs/display.folk b/virtual-programs/display.folk
index 2853c065..e4ab2acd 100644
--- a/virtual-programs/display.folk
+++ b/virtual-programs/display.folk
@@ -140,7 +140,7 @@ namespace eval ::Display {
     if {$::isLaptop} {
         set WIDTH 640; set HEIGHT 480
     } else {
-        regexp {mode "(\d+)x(\d+)"} [exec fbset] -> WIDTH HEIGHT
+        regexp {mode "(\d+)x(\d+)(?:-\d+)?"} [exec fbset] -> WIDTH HEIGHT
     }
 
     # TODO: Remove these / expel them to a shim page; these are only
diff --git a/virtual-programs/display/image.folk b/virtual-programs/display/image.folk
index 23246d45..b654f846 100644
--- a/virtual-programs/display/image.folk
+++ b/virtual-programs/display/image.folk
@@ -3,19 +3,19 @@ On process "display" {
     set rotate $::rotate
     # TODO: Do this with a wish, instead of hard-coding the global dict.
     dict set ::pipelines "image" [Gpu::pipeline {sampler2D image vec2 imageSize
-                              vec2 pos float radians float scale
+                              vec2 pos float radians vec2 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 a = pos + rotate(scale*-imageSize/2, -radians);
+        vec2 b = pos + rotate(scale*vec2(imageSize.x, -imageSize.y)/2, -radians);
+        vec2 c = pos + rotate(scale*imageSize/2, -radians);
+        vec2 d = pos + rotate(scale*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 a = pos + rotate(scale*-imageSize/2, -radians);
+        vec2 b = pos + rotate(scale*vec2(imageSize.x, -imageSize.y)/2, -radians);
+        vec2 c = pos + rotate(scale*imageSize/2, -radians);
+        vec2 d = pos + rotate(scale*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 ) {
@@ -108,6 +108,9 @@ On process "display" {
         set im [dict get $options image]
         set radians [dict get $options radians]
         set scale [dict_getdef $options scale 1.0]
+        if {[llength $scale] == 1} {
+          set scale [list $scale $scale] 
+        }
 
         set gim [ImageCache::getOrInsert $im]
 
diff --git a/virtual-programs/display/text.folk b/virtual-programs/display/text.folk
index 858a9dc7..b55cfeea 100644
--- a/virtual-programs/display/text.folk
+++ b/virtual-programs/display/text.folk
@@ -65,16 +65,43 @@ On process "display" {
                 x = x + advance * em;
                 if (x > width) { width = x; }
             }
-            return (vec2f) { width, y + em };
+            return (vec2f) { width, y };
         }
         $cc proc textShape {Font* font char* text
-                            float x0 float y0 float scale float radians} Tcl_Obj* {
+                            float x0 float y0 float scale int halign int valign float radians Tcl_Obj* color} Tcl_Obj* {
             Tcl_Obj* gpuAtlasImageSize = Tcl_ObjPrintf("%d %d", font->atlasImage.width, font->atlasImage.height);
 
-            vec2f extent = vec2f_rotate(textExtent(font, text, scale), radians);
+            vec2f extent = textExtent(font, text, scale);
             float em = scale * 25.0;
 
-            vec2f p0 = { x0 - extent.x/2.0, y0 - extent.y/2.0 };
+            float x = 0;
+            float y = 0;
+            switch (halign) {
+                case -1: // left align
+                    x = 0;
+                    break;
+                case 0: // center
+                    x = extent.x/2.0;
+                    break;
+                case 1: // right align
+                    x = extent.x;
+                    break;
+            }
+
+            switch (valign) {
+                case -1: // top align
+                    y = -em;
+                    break;
+                case 0: // center
+                    y = extent.y/2.0;
+                    break;
+                case 1: // bottom align
+                    y = extent.y;
+                    break;
+            }
+
+            vec2f offset = vec2f_rotate((vec2f){x, y}, radians);
+            vec2f p0 = (vec2f) { x0 - offset.x, y0 - offset.y };
             vec2f p = p0;
 
             int lineNum = 0;
@@ -103,7 +130,7 @@ On process "display" {
                         gpuAtlasImageSize,
                         atlasBounds,
                         planeBounds,
-                        pObj, Tcl_NewDoubleObj(radians), Tcl_NewDoubleObj(em)
+                        pObj, Tcl_NewDoubleObj(radians), Tcl_NewDoubleObj(em), color
                     };
                     Tcl_Obj* instance = Tcl_NewListObj(sizeof(args)/sizeof(args[0]), args);
                     Tcl_ListObjAppendElement(NULL, instances, instance);
@@ -145,6 +172,7 @@ On process "display" {
                        vec4 atlasGlyphBounds
                        vec4 planeGlyphBounds
                        vec2 pos float radians float em
+                       vec4 color
                        fn rotate} {
          float left = planeGlyphBounds[0] * em;
          float bottom = planeGlyphBounds[1] * em;
@@ -172,10 +200,12 @@ On process "display" {
             return vec4(0, 0, 0, 0);
         }
         vec3 msd = glyphMsd(atlas, atlasGlyphBounds/atlasSize.xyxy, glyphUv).rgb;
+        // https://blog.mapbox.com/drawing-text-with-signed-distance-fields-in-mapbox-gl-b0933af6f817
         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);
+        float uBuffer = 0.2;
+        float uGamma = 0.2;
+        float opacity = smoothstep(uBuffer - uGamma, uBuffer + uGamma, sd);
+        return vec4(color.rgb, opacity * color.a);
     }]
 
     Wish $::thisProcess receives statements like \
@@ -183,7 +213,10 @@ On process "display" {
 
     When (non-capturing) /someone/ wishes to draw text with /...options/ {
         if {[dict exists $options center]} {
+            # This is deprecated
             lassign [dict get $options center] x0 y0
+        } elseif {[dict exists $options position]} {
+            lassign [dict get $options position] x0 y0
         } else {
             set x0 [dict get $options x]
             set y0 [dict get $options y]
@@ -191,14 +224,36 @@ On process "display" {
         set scale [dict_getdef $options scale 1.0]
         set font [dict_getdef $options font "PTSans-Regular"]
         set text [dict get $options text]
+        set anchor [dict_getdef $options anchor "center"]
         set radians [dict get $options radians]
+        set color [getColor [dict_getdef $options color white]]
+
+        if {$anchor == "topleft"} {
+            set align [list -1 -1]
+        } elseif {$anchor == "top"} {
+            set align [list 0 -1]
+        } elseif {$anchor == "topright"} {
+            set align [list 1 -1]
+        } elseif {$anchor == "left"} {
+            set align [list -1 0]
+        } elseif {$anchor == "center"} {
+            set align [list 0 0]
+        } elseif {$anchor == "right"} {
+            set align [list 1 0]
+        } elseif {$anchor == "bottomleft"} {
+            set align [list -1 1]
+        } elseif {$anchor == "bottom"} {
+            set align [list 0 1]
+        } elseif {$anchor == "bottomright"} {
+            set align [list 1 1]
+        }
 
         if {!([dict exists $::FontCache $font])} {
             throw {DISPLAY FONT {font doesn't exist}} "$font doesn't exist"
         }
         set font [dict get $::FontCache $font]
 
-        set instances [font textShape $font $text $x0 $y0 $scale $radians]
+        set instances [font textShape $font $text $x0 $y0 $scale {*}$align $radians $color]
 
         # We need to batch into one wish so we don't deal with n^2
         # checks for existing statements for n glyphs.
diff --git a/virtual-programs/images.folk b/virtual-programs/images.folk
index d8bcaf55..1be51424 100644
--- a/virtual-programs/images.folk
+++ b/virtual-programs/images.folk
@@ -343,7 +343,7 @@ When /someone/ wishes /p/ displays camera slice /slice/ & /p/ has region /r/ {
     Wish to draw an image with center $center image $slice radians 0 scale 1
 }
 
-When /someone/ wishes /p/ displays image /im/ {
+When /someone/ wishes /p/ displays image /im/ with scale /s/ {
     set im [image load $im]
     When $p has region /r/ {
         # Compute a scale for im that will fit in the region width/height
@@ -354,10 +354,14 @@ When /someone/ wishes /p/ displays image /im/ {
         # set scale [expr {min($width / [image width $im],
         #                      $height / [image height $im])}]
         # Wish $p is labelled $im
-        Wish to draw an image with center $center image $im radians [region angle $r]
+        Wish to draw an image with center $center image $im radians [region angle $r] scale $s
     }
     # On unmatch {
     #     # HACK: Leaves time for the display to finish trying to display this.
     #     after 5000 [list image freeJpeg $im]
     # }
 }
+
+When /someone/ wishes /p/ displays image /im/ {
+    Wish $p displays image $im with scale 1
+}
diff --git a/virtual-programs/intersect.folk b/virtual-programs/intersect.folk
index 7755acbd..1aea9695 100644
--- a/virtual-programs/intersect.folk
+++ b/virtual-programs/intersect.folk
@@ -25,4 +25,8 @@ When /someone/ wishes /p/ has neighbors & /p/ has region /r/ & /p2/ has region /
     #Display::stroke [list [list $b2MaxX $b2MaxY] {500 500}] 3 white
     #Display::stroke [list [list $b2MinX $b2MinY] [list $b2MaxX $b2MaxY]] 10 blue
   }
-}
\ No newline at end of file
+}
+
+When when /p/ has neighbor /n/ /lambda/ with environment /e/ {
+  Wish $p has neighbors
+}
diff --git a/virtual-programs/music.folk b/virtual-programs/music.folk
index f3574c64..726a3294 100644
--- a/virtual-programs/music.folk
+++ b/virtual-programs/music.folk
@@ -107,12 +107,14 @@ proc ::Music::exec {args} {
 proc ::Music::finishSetup {} {
   variable musicDir
 
-  exec jack_control start
-  exec jack_control ds alsa
-  exec jack_control dps device hw:HDMI,10
-  exec jack_control dps rate 48000
-  exec jack_control dps nperiods 2
-  exec jack_control dps period 64
+  if {$::thisNode ne "folk-beads"} {
+    exec jack_control start
+    exec jack_control ds alsa
+    exec jack_control dps device hw:HDMI,10
+    exec jack_control dps rate 48000
+    exec jack_control dps nperiods 2
+    exec jack_control dps period 64
+  }
 
   catch {exec pkill ghci}
   catch {exec pkill sclang}
diff --git a/virtual-programs/outline.folk b/virtual-programs/outline.folk
index 1d6411cb..13f060b1 100644
--- a/virtual-programs/outline.folk
+++ b/virtual-programs/outline.folk
@@ -9,21 +9,9 @@ proc loopRegion {edges vertices width color} {
     Wish the GPU draws pipeline "line" with instances $instances
 }
 
-When the collected matches for [list /someone/ wishes /thing/ is outlined /color/] are /matches/ {
-    set thingColors [dict create]
-    foreach match $matches {
-        dict lappend thingColors [dict get $match thing] [dict get $match color]
-    }
-    foreach thing [dict keys $thingColors] {
-        When $thing has region /region/ {
-            set thickness 0
-            foreach color [dict get $thingColors $thing] {
-                    # FIXME: assumes path
-                    lassign $region vertices edges
-                    loopRegion $edges $vertices [incr thickness 3] $color
-            }
-        }
-    }
+When /someone/ wishes /thing/ is outlined /color/ & /thing/ has region /region/ {
+    lassign $region vertices edges
+    loopRegion $edges $vertices 3 $color
 }
 
 When /someone/ wishes /thing/ is outlined thick /color/ & /thing/ has region /region/ {
diff --git a/virtual-programs/points-at.folk b/virtual-programs/points-at.folk
index a037f98f..ed3fb8eb 100644
--- a/virtual-programs/points-at.folk
+++ b/virtual-programs/points-at.folk
@@ -1,8 +1,10 @@
 When when /rect/ points /direction/ with length /l/ at /someone/ /lambda/ with environment /e/ {
+  if {[string match "/*" $rect]} { return }
   Wish $rect points $direction with length $l
 }
 
 When when /rect/ points /direction/ at /someone/ /lambda/ with environment /e/ {
+  if {[string match "/*" $rect]} { return }
   Wish $rect points $direction with length 1
 }
 
diff --git a/virtual-programs/print.folk b/virtual-programs/print.folk
index 44a7d433..6197bdd1 100644
--- a/virtual-programs/print.folk
+++ b/virtual-programs/print.folk
@@ -174,8 +174,27 @@ proc nextId {} {
     set id
 }
 
+proc remotePrintRequest {remoteNode clause} {
+    ::websocket::open "ws://$remoteNode.local:4273/ws" [list apply {{clause sock type msg} {
+        if {$type eq "connect"} {
+            ::websocket::send $sock text [list apply {{clause} {
+                Assert {*}$clause
+                after 5000 [list Retract {*}$clause]
+                Step
+            }} $clause]
+            after 10000 [list ::websocket::close $sock]
+        }
+    }} $clause]
+}
+
 if {![info exists ::printjobs]} {set ::printjobs [dict create]}
 When /someone/ wishes to print /code/ with job id /jobid/ {
+    if {$::thisNode eq "folk-beads" || $::thisNode eq "folk-convivial"} {
+        # HACK: Forward the print request to folk0.
+        remotePrintRequest "folk0" [list $::thisNode wishes to print $code with job id $jobid]
+        return
+    }
+
     puts "Wish to print jobid $jobid"
     if {[dict exists $::printjobs $jobid]} {return}
 
@@ -205,6 +224,12 @@ When /someone/ wishes to print /code/ with job id /jobid/ {
     exec lpr $::env(HOME)/folk-printed-programs/$id.pdf
 }
 When /someone/ wishes to print program /id/ with code /code/ with job id /jobid/ {
+    if {$::thisNode eq "folk-beads" || $::thisNode eq "folk-convivial"} {
+        # HACK: Forward the print request to folk0.
+        remotePrintRequest "folk0" [list $::thisNode wishes to print program $id with code $code with job id $jobid]
+        return
+    }
+
     puts "Wish to print jobid $jobid"
     if {[dict exists $::printjobs $jobid]} {return}
 
diff --git a/virtual-programs/programs.folk b/virtual-programs/programs.folk
index f42e1360..7c98632b 100644
--- a/virtual-programs/programs.folk
+++ b/virtual-programs/programs.folk
@@ -5,18 +5,26 @@ When (non-capturing) /type/ /obj/ has a program {
     On unmatch { puts "Removed $type $obj" }
 
     try {
-    set tempPath "$::env(HOME)/folk-printed-programs/$obj.folk.temp"
+        if {[file exists "$::env(HOME)/folk-printed-programs/$obj.folk.temp"]} {
+            set fd [open "$::env(HOME)/folk-printed-programs/$obj.folk.temp" r]
+        } else {
+            if {![file exists "$::env(HOME)/folk-printed-programs/$obj.folk"] &&
+                ($::thisNode eq "folk-beads" || $::thisNode eq "folk-convivial")} {
+                # HACK: 'Page fault' to folk0, try getting page from
+                # there. Ideally we would have some general (Avahi?)
+                # way of finding the 'authoritative' node on the local
+                # network, or broadcasting out, and getting pages from
+                # there.
+                exec curl --output "$::env(HOME)/folk-printed-programs/$obj.folk" \
+                    "http://folk0.local:4273/printed-programs/$obj.folk"
+            }
+            set fd [open "$::env(HOME)/folk-printed-programs/$obj.folk" r]
+        }
+        set code [read $fd]
+        close $fd
 
-    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]
+        Claim $obj has program code $code
+    } on error error {
+        puts stderr "No code for $type $obj"
     }
-     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/title.folk b/virtual-programs/title.folk
index 3187ed3c..a430cc16 100644
--- a/virtual-programs/title.folk
+++ b/virtual-programs/title.folk
@@ -2,26 +2,43 @@
 # for wishes of the form:
 # "Wish $tag is titled "This is a tag"" or "Wish $tag is footnoted "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 is titled /text/] are /matches/ {
         set text [join [lmap match $matches {dict get $match text}] "\n"]
         if {$text eq ""} { return }
     
-        set scale 1
-        Wish to draw text with center $top scale $scale text $text radians $radians
+        set scale [dict_getdef $match scale 1.0]
+        set pos [region top [region move $region up 10px]]
+        Wish to draw text with position $pos scale $scale text $text radians $radians anchor bottom
     }
 
     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 }
 
-        set scale 1
-        Wish to draw text with center $bot scale $scale text $text radians $radians
+        set scale [dict_getdef $match scale 0.75]
+        set pos [region bottomleft [region move $region down 20px]]
+        Wish to draw text with position $pos scale $scale text $text radians $radians anchor topleft
+    }
+    
+    When the collected matches for [list /someone/ wishes $thing is right-margined /text/] are /matches/ {
+        set text [join [lmap match $matches {dict get $match text}] "\n"]
+        if {$text eq ""} { return }
+    
+        set scale [dict_getdef $match scale 0.75]
+        set pos [region right [region move $region right 10px]]
+        Wish to draw text with position $pos scale $scale text $text radians $radians anchor left
+    }
+
+    When the collected matches for [list /someone/ wishes $thing is left-margined /text/] are /matches/ {
+        set text [join [lmap match $matches {dict get $match text}] "\n"]
+        if {$text eq ""} { return }
+    
+        set scale [dict_getdef $match scale 0.75]
+        set pos [region left [region move $region left 10px]]
+        Wish to draw text with position $pos scale $scale text $text radians $radians anchor right
     }
 }
+
diff --git a/virtual-programs/web-printed-programs.folk b/virtual-programs/web-printed-programs.folk
new file mode 100644
index 00000000..8c90db73
--- /dev/null
+++ b/virtual-programs/web-printed-programs.folk
@@ -0,0 +1,9 @@
+Wish the web server handles route {/printed-programs/(\d+)\.folk$} with handler {
+    regexp {/printed-programs/(\d+)\.folk$} $path -> id
+    set filename "../folk-printed-programs/$id.folk" 
+    set fp [open $filename r]
+    set data [read $fp]
+    close $fp
+
+    dict create statusAndHeaders "HTTP/1.1 200 OK\nConnection: close\nContent-Type: text/plain; charset=utf-8\n\n" body $data
+}