From 7b7d12633e89652d23c998ff08149205f5bafbaf Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andr=C3=A9s=20Cuervo?= Date: Wed, 6 May 2026 19:10:48 -0400 Subject: [PATCH 1/6] build: make remote sync work from git worktrees Use git rev-parse --git-path to choose the temporary ignore file for make sync/remote instead of assuming .git is a directory. Worktrees store .git as a file, so writing .git/ignores.tmp breaks remote deployment from branches checked out in a git worktree. --- Makefile | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/Makefile b/Makefile index 68d5a937..fa8c4981 100644 --- a/Makefile +++ b/Makefile @@ -115,16 +115,17 @@ kill-folk: fi FOLK_REMOTE_NODE ?= folk-live +FOLK_SYNC_IGNORES_TMP := $(shell git rev-parse --git-path ignores.tmp 2>/dev/null || echo .git/ignores.tmp) sync: ssh $(FOLK_REMOTE_NODE) -t \ 'cd ~/folk && git init > /dev/null && git ls-files --exclude-standard -oi --directory' \ - > .git/ignores.tmp || true - git ls-files --exclude-standard -oi --directory >> .git/ignores.tmp + > $(FOLK_SYNC_IGNORES_TMP) || true + git ls-files --exclude-standard -oi --directory >> $(FOLK_SYNC_IGNORES_TMP) rsync --timeout=15 -e "ssh -o StrictHostKeyChecking=no" \ --archive --delete --itemize-changes \ --exclude='/.git' \ - --exclude-from='.git/ignores.tmp' \ + --exclude-from='$(FOLK_SYNC_IGNORES_TMP)' \ --exclude='vendor/tracy/public/TracyClient.o' \ --include='vendor/tracy/public/***' \ --exclude='vendor/tracy/*' \ From 374ae6dbf14c836b143dec95f4af51a24b2527b9 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andr=C3=A9s=20Cuervo?= Date: Wed, 6 May 2026 19:11:36 -0400 Subject: [PATCH 2/6] draw: move primitives into the draw program space Move the remaining drawing primitive implementations out of the legacy display/root locations and into builtin-programs/draw. This keeps arc, curve, fill, and shape drawing alongside the rest of the new draw APIs.\n\nUpdate fill drawing to target a canvas explicitly, add has-demo-code snippets for the primitive programs, and adjust the README/demo examples to use meter-scale draw-shape values. Add focused draw primitive coverage for the moved APIs. --- README.md | 2 +- builtin-programs/demos.folk | 4 +- builtin-programs/display/arc.folk | 39 --- builtin-programs/display/curve.folk | 135 ---------- builtin-programs/draw/apriltags.folk | 15 ++ builtin-programs/draw/arc.folk | 91 +++++++ builtin-programs/draw/circle.folk | 16 ++ builtin-programs/draw/curve.folk | 92 +++++++ builtin-programs/draw/dashed-line.folk | 13 + builtin-programs/draw/fill.folk | 67 ++++- builtin-programs/draw/image.folk | 14 + builtin-programs/draw/line.folk | 14 + builtin-programs/draw/shapes.folk | 341 +++++++++++++++++++++++ builtin-programs/draw/text.folk | 15 ++ builtin-programs/shapes.folk | 357 ------------------------- test/draw-primitives.folk | 45 ++++ 16 files changed, 713 insertions(+), 547 deletions(-) delete mode 100644 builtin-programs/display/arc.folk delete mode 100644 builtin-programs/display/curve.folk create mode 100644 builtin-programs/draw/arc.folk create mode 100644 builtin-programs/draw/curve.folk create mode 100644 builtin-programs/draw/shapes.folk delete mode 100644 builtin-programs/shapes.folk create mode 100644 test/draw-primitives.folk diff --git a/README.md b/README.md index 4eadf883..002e660c 100644 --- a/README.md +++ b/README.md @@ -514,7 +514,7 @@ Use it in an animation: ``` When the clock time is /t/ { - Wish $this draws a circle with offset [list [expr {sin($t) * 50}] 0] + Wish $this draws a circle with offset [list [expr {sin($t) * 0.05}] 0] radius 0.012 } ``` diff --git a/builtin-programs/demos.folk b/builtin-programs/demos.folk index 192afd23..92d787a3 100644 --- a/builtin-programs/demos.folk +++ b/builtin-programs/demos.folk @@ -10,7 +10,7 @@ Claim 45001 has demo code { Claim 45002 has demo code { When /actor/ is cool { Wish $this is labelled "$actor is pretty cool" - Wish $actor is outlined red + Wish $actor is outlined red } } Claim 45003 has demo code { @@ -24,7 +24,7 @@ Claim 45004 has demo code { } Claim 45005 has demo code { When the clock time is /t/ { - Wish $this draws a circle offset [list expr {sin($t) * 50} 0] + Wish $this draws a circle with offset [list [expr {sin($t) * 0.05}] 0] radius 0.012 } } Claim 45006 has demo code { diff --git a/builtin-programs/display/arc.folk b/builtin-programs/display/arc.folk deleted file mode 100644 index f6a0c678..00000000 --- a/builtin-programs/display/arc.folk +++ /dev/null @@ -1,39 +0,0 @@ -# Example: -# When $this has region /r/ { -# lassign [region centroid $r] x y -# Wish to draw an arc with x $x y $y start 0 arclen 1 thickness 3 radius 100 color green -# } - -Wish the GPU compiles pipeline "arc" {{vec2 center float start float arclen float radius float thickness vec4 color} { - float r = radius + thickness; - vec2 vertices[4] = vec2[4]( - center - r, - vec2(center.x + r, center.y - r), - vec2(center.x - r, center.y + r), - center + r - ); - return vec4(vertices[gl_VertexIndex], 0.0, 1.0); -} { - #define M_TWO_PI 6.283185307179586 - start = clamp(start, 0, M_TWO_PI); - arclen = clamp(arclen, 0, M_TWO_PI); - - float dist = length(gl_FragCoord.xy - center) - radius; - float angle = atan(-(gl_FragCoord.y - center.y), gl_FragCoord.x - center.x); - - // Shift angle from [-pi, pi) to [0, 2*pi] - angle = (angle < 0) ? (angle + M_TWO_PI) : angle; - float end = start + arclen; - - return ((dist < thickness && dist > 0.0) && - ((end < M_TWO_PI && angle > start && angle < end) || - (end >= M_TWO_PI && (angle > start || angle < end-M_TWO_PI)))) ? color : vec4(0, 0, 0, 0); - -}} - -When /someone/ wishes to draw an arc with /...options/ { - dict with options { - Wish the GPU draws pipeline "arc" with arguments \ - [list [list $x $y] $start $arclen $radius $thickness [getColor $color]] - } -} diff --git a/builtin-programs/display/curve.folk b/builtin-programs/display/curve.folk deleted file mode 100644 index 9082d117..00000000 --- a/builtin-programs/display/curve.folk +++ /dev/null @@ -1,135 +0,0 @@ - -# Bezier implementation from https://www.shadertoy.com/view/XdVBWd - -Wish the GPU compiles function "bboxBezier" {{vec2 p0 vec2 p1 vec2 p2 vec2 p3} vec4 { - // Exact BBox to a quadratic bezier - // extremes - vec2 mi = min(p0,p3); - vec2 ma = max(p0,p3); - - vec2 k0 = -1.0*p0 + 1.0*p1; - vec2 k1 = 1.0*p0 - 2.0*p1 + 1.0*p2; - vec2 k2 = -1.0*p0 + 3.0*p1 - 3.0*p2 + 1.0*p3; - - vec2 h = k1*k1 - k0*k2; - - if( h.x>0.0 ) - { - h.x = sqrt(h.x); - //float t = (-k1.x - h.x)/k2.x; - float t = k0.x/(-k1.x-h.x); - if( t>0.0 && t<1.0 ) - { - float s = 1.0-t; - float q = s*s*s*p0.x + 3.0*s*s*t*p1.x + 3.0*s*t*t*p2.x + t*t*t*p3.x; - mi.x = min(mi.x,q); - ma.x = max(ma.x,q); - } - //t = (-k1.x + h.x)/k2.x; - t = k0.x/(-k1.x+h.x); - if( t>0.0 && t<1.0 ) - { - float s = 1.0-t; - float q = s*s*s*p0.x + 3.0*s*s*t*p1.x + 3.0*s*t*t*p2.x + t*t*t*p3.x; - mi.x = min(mi.x,q); - ma.x = max(ma.x,q); - } - } - - if( h.y>0.0) - { - h.y = sqrt(h.y); - //float t = (-k1.y - h.y)/k2.y; - float t = k0.y/(-k1.y-h.y); - if( t>0.0 && t<1.0 ) - { - float s = 1.0-t; - float q = s*s*s*p0.y + 3.0*s*s*t*p1.y + 3.0*s*t*t*p2.y + t*t*t*p3.y; - mi.y = min(mi.y,q); - ma.y = max(ma.y,q); - } - //t = (-k1.y + h.y)/k2.y; - t = k0.y/(-k1.y+h.y); - if( t>0.0 && t<1.0 ) - { - float s = 1.0-t; - float q = s*s*s*p0.y + 3.0*s*s*t*p1.y + 3.0*s*t*t*p2.y + t*t*t*p3.y; - mi.y = min(mi.y,q); - ma.y = max(ma.y,q); - } - } - - return vec4( mi, ma ); -}} - -Wish the GPU compiles function sdSegmentSq {{vec2 p vec2 a vec2 b} float { - vec2 pa = p-a, ba = b-a; - float h = clamp( dot(pa,ba)/dot(ba,ba), 0.0, 1.0 ); - vec2 d = pa - ba*h; - return dot(d, d); -}} - -Wish the GPU compiles function udBezier {{vec2 p0 vec2 p1 vec2 p2 vec2 p3 vec2 pos} vec2 { - const int kNum = 50; - vec2 res = vec2(1e10,0.0); - vec2 a = p0; - for( int i=1; i 0.0) { + if ((end < M_TWO_PI && angle > c_start && angle < end) || + (end >= M_TWO_PI && (angle > c_start || angle < end - M_TWO_PI))) { + return color; + } + } + + return vec4(0.0); + } +} + +When the color map is /colorMap/ &\ + /p/ has canvas /id/ with /...wiOptions/ &\ + /p/ has canvas projection /surfaceToClip/ &\ + /someone/ wishes to draw an arc onto /p/ with /...options/ { + + set center [dict getdef $options center ""] + if {$center eq ""} { set center [list [dict get $options x] [dict get $options y]] } + + set radius [dict get $options radius] + set thickness [dict get $options thickness] + set start [dict get $options start] + set arclen [dict get $options arclen] + + set color [dict get $options color] + set color [dict getdef $colorMap $color $color] + set layer [dict getdef $options layer 0] + + set wiResolution [list [dict get $wiOptions width] [dict get $wiOptions height]] + + Wish the GPU draws pipeline "arc" onto canvas $id with arguments \ + [list $wiResolution $surfaceToClip \ + $center $radius $thickness $start $arclen $color] \ + layer $layer +} + +Claim $this has demo code { + When $this has resolved geometry /geom/ { + set w [dict get $geom width] + set h [dict get $geom height] + Wish to draw an arc onto $this with \ + center [list [expr {$w * 0.50}] [expr {$h * 0.52}]] \ + radius [expr {$h * 0.24}] thickness [expr {$h * 0.018}] \ + start 0.25 arclen 4.7 color hotpink layer 5 + } +} diff --git a/builtin-programs/draw/circle.folk b/builtin-programs/draw/circle.folk index a67b3e4e..97636e27 100644 --- a/builtin-programs/draw/circle.folk +++ b/builtin-programs/draw/circle.folk @@ -45,3 +45,19 @@ When the color map is /colorMap/ &\ [list $wiResolution $surfaceToClip \ $center $radius $thickness $color [expr {$filled eq false ? 0 : 1}]] } + +Claim $this has demo code { + When $this has resolved geometry /geom/ { + set w [dict get $geom width] + set h [dict get $geom height] + set r [expr {$h * 0.16}] + Wish to draw a circle onto $this with \ + center [list [expr {$w * 0.38}] [expr {$h * 0.50}]] \ + radius $r thickness [expr {$h * 0.018}] \ + color cyan filled false layer 4 + Wish to draw a circle onto $this with \ + center [list [expr {$w * 0.62}] [expr {$h * 0.50}]] \ + radius [expr {$r * 0.72}] thickness [expr {$h * 0.010}] \ + color mediumspringgreen filled true layer 5 + } +} diff --git a/builtin-programs/draw/curve.folk b/builtin-programs/draw/curve.folk new file mode 100644 index 00000000..5f1edf9f --- /dev/null +++ b/builtin-programs/draw/curve.folk @@ -0,0 +1,92 @@ +# Bezier implementation adapted from https://www.shadertoy.com/view/XdVBWd + +Wish the GPU compiles function "curveSegmentDistance" {{vec2 p vec2 a vec2 b} float { + vec2 pa = p - a; + vec2 ba = b - a; + float h = clamp(dot(pa, ba) / dot(ba, ba), 0.0, 1.0); + vec2 d = pa - ba * h; + return dot(d, d); +}} + +Wish the GPU compiles function "curveBezierDistance" {{vec2 p0 vec2 p1 vec2 p2 vec2 p3 vec2 pos fn curveSegmentDistance} float { + const int kNumSamples = 50; + float distance = 1e10; + vec2 a = p0; + for (int i = 1; i < kNumSamples; i++) { + float t = float(i) / float(kNumSamples - 1); + float s = 1.0 - t; + vec2 b = p0 * s * s * s + + p1 * 3.0 * s * s * t + + p2 * 3.0 * s * t * t + + p3 * t * t * t; + distance = min(distance, curveSegmentDistance(pos, a, b)); + a = b; + } + return sqrt(distance); +}} + +Wish the GPU compiles pipeline "curve" { + {vec2 viewport mat3 surfaceToClip + vec2 p0 vec2 p1 vec2 p2 vec2 p3 float thickness vec4 color} { + vec2 from = min(min(p0, p1), min(p2, p3)) - thickness; + vec2 to = max(max(p0, p1), max(p2, p3)) + thickness; + + vec2 vertices[6] = vec2[6]( + from, + vec2(to.x, from.y), + vec2(from.x, to.y), + vec2(to.x, from.y), + to, + vec2(from.x, to.y) + ); + + vec3 v = surfaceToClip * vec3(vertices[gl_VertexIndex], 1.0); + return vec4(v.xy / v.z, 0.0, 1.0); + } {fn curveBezierDistance} { + vec2 clipXy = (gl_FragCoord.xy / viewport) * 2.0 - 1.0; + vec3 surfaceXy = inverse(surfaceToClip) * vec3(clipXy, 1.0); + surfaceXy /= surfaceXy.z; + + float distance = curveBezierDistance(p0, p1, p2, p3, surfaceXy.xy); + float edge = max(fwidth(distance), thickness * 0.05); + float alpha = 1.0 - smoothstep(thickness, thickness + edge, distance); + + return (alpha < 0.01) ? vec4(0.0) : vec4(color.rgb, color.a * alpha); + } +} + +When the color map is /colorMap/ &\ + /p/ has canvas /id/ with /...wiOptions/ &\ + /p/ has canvas projection /surfaceToClip/ &\ + /someone/ wishes to draw a curve onto /p/ with /...options/ { + + set p0 [dict get $options p0] + set p1 [dict get $options p1] + set p2 [dict get $options p2] + set p3 [dict get $options p3] + set thickness [dict get $options thickness] + + set color [dict get $options color] + set color [dict getdef $colorMap $color $color] + set layer [dict getdef $options layer 0] + + set wiResolution [list [dict get $wiOptions width] [dict get $wiOptions height]] + + Wish the GPU draws pipeline "curve" onto canvas $id with arguments \ + [list $wiResolution $surfaceToClip \ + $p0 $p1 $p2 $p3 $thickness $color] \ + layer $layer +} + +Claim $this has demo code { + When $this has resolved geometry /geom/ { + set w [dict get $geom width] + set h [dict get $geom height] + Wish to draw a curve onto $this with \ + p0 [list [expr {$w * 0.16}] [expr {$h * 0.72}]] \ + p1 [list [expr {$w * 0.26}] [expr {$h * 0.16}]] \ + p2 [list [expr {$w * 0.74}] [expr {$h * 0.88}]] \ + p3 [list [expr {$w * 0.86}] [expr {$h * 0.30}]] \ + thickness [expr {$h * 0.015}] color lightskyblue layer 5 + } +} diff --git a/builtin-programs/draw/dashed-line.folk b/builtin-programs/draw/dashed-line.folk index c6fd2ad2..b35d25bc 100644 --- a/builtin-programs/draw/dashed-line.folk +++ b/builtin-programs/draw/dashed-line.folk @@ -61,3 +61,16 @@ When the color map is /colorMap/ &\ Wish the GPU draws pipeline "dashed-line" onto canvas $id \ with instances $instances layer $layer } + +Claim $this has demo code { + When $this has resolved geometry /geom/ { + set w [dict get $geom width] + set h [dict get $geom height] + Wish to draw a dashed line onto $this with \ + points [list \ + [list [expr {$w * 0.15}] [expr {$h * 0.32}]] \ + [list [expr {$w * 0.86}] [expr {$h * 0.70}]]] \ + width [expr {$h * 0.012}] color gold \ + dashlength [expr {$w * 0.045}] dashoffset 0 layer 4 + } +} diff --git a/builtin-programs/draw/fill.folk b/builtin-programs/draw/fill.folk index 4e977c1e..a7c0ec60 100644 --- a/builtin-programs/draw/fill.folk +++ b/builtin-programs/draw/fill.folk @@ -10,14 +10,17 @@ Wish the GPU compiles pipeline "fillTriangle" { When the color map is /colorMap/ { -When /someone/ wishes to draw a triangle with /...options/ { +When /someone/ wishes to draw a triangle onto /p/ with /...options/ &\ + /p/ has canvas /id/ with /...wiOptions/ &\ + /p/ has canvas projection /surfaceToClip/ { dict with options { if {![info exists layer]} { set layer 0 } set color [dict getdef $colorMap $color $color] - Wish the GPU draws pipeline "fillTriangle" with arguments \ - [list $p0 $p1 $p2 $color] layer $layer + Wish the GPU draws pipeline "fillTriangle" onto canvas $id with arguments \ + [list $surfaceToClip $p0 $p1 $p2 $color] layer $layer } } + When /someone/ wishes to draw a quad onto /p/ with /...options/ &\ /p/ has canvas /id/ with /...wiOptions/ &\ /p/ has canvas projection /surfaceToClip/ { @@ -30,7 +33,11 @@ When /someone/ wishes to draw a quad onto /p/ with /...options/ &\ [list $surfaceToClip $p0 $p1 $p3 $color] layer $layer } } -When /someone/ wishes to draw a polygon with /...options/ { + +When /someone/ wishes to draw a polygon onto /p/ with /...options/ &\ + /p/ has canvas /id/ with /...wiOptions/ &\ + /p/ has canvas projection /surfaceToClip/ { + set points [dict get $options points] set color [dict get $options color] set layer [dict getdef $options layer 0] @@ -39,31 +46,65 @@ When /someone/ wishes to draw a polygon with /...options/ { if {$num_points < 3} { error "At least 3 points are required to form a polygon." } elseif {$num_points == 3} { - Wish to draw a triangle with \ + Wish to draw a triangle onto $p with \ p0 [lindex $points 0] p1 [lindex $points 1] p2 [lindex $points 2] \ color $color layer $layer } elseif {$num_points == 4} { - Wish to draw a quad with \ + Wish to draw a quad onto $p with \ p0 [lindex $points 0] p1 [lindex $points 1] p2 [lindex $points 2] p3 [lindex $points 3] \ color $color layer $layer } else { # Get the first point in the list as the "base" point of the triangles set p0 [lindex $points 0] - set color [dict getdef $colorMap $color $color] + + # Batch the fanned-out triangles into a single GPU instance list + set instances [list] for {set i 1} {$i < $num_points - 1} {incr i} { set p1 [lindex $points $i] set p2 [lindex $points [expr {$i+1}]] - Wish the GPU draws pipeline "fillTriangle" with arguments \ - [list $p0 $p1 $p2 $color] layer $layer + lappend instances [list $surfaceToClip $p0 $p1 $p2 $color] } + Wish the GPU draws pipeline "fillTriangle" onto canvas $id \ + with instances $instances layer $layer + } +} + +When /someone/ wishes /page/ is filled with /...options/ &\ + /page/ has resolved geometry /geom/ { + dict with geom { + set points [list [list 0 0] \ + [list $width 0] \ + [list $width $height] \ + [list 0 $height]] } + Wish to draw a polygon onto $page with points $points {*}$options } } -When /someone/ wishes /page/ is filled with /...options/ &\ - /page/ has region /region/ { - set points [region vertices $region] - Wish to draw a polygon with points $points {*}$options +Claim $this has demo code { + When $this has resolved geometry /geom/ { + set w [dict get $geom width] + set h [dict get $geom height] + Wish to draw a triangle onto $this with \ + p0 [list [expr {$w * 0.18}] [expr {$h * 0.72}]] \ + p1 [list [expr {$w * 0.32}] [expr {$h * 0.28}]] \ + p2 [list [expr {$w * 0.48}] [expr {$h * 0.72}]] \ + color magenta layer 4 + Wish to draw a quad onto $this with \ + p0 [list [expr {$w * 0.55}] [expr {$h * 0.32}]] \ + p1 [list [expr {$w * 0.84}] [expr {$h * 0.26}]] \ + p2 [list [expr {$w * 0.78}] [expr {$h * 0.70}]] \ + p3 [list [expr {$w * 0.50}] [expr {$h * 0.62}]] \ + color orange layer 4 + Wish to draw a polygon onto $this with \ + points [list \ + [list [expr {$w * 0.22}] [expr {$h * 0.18}]] \ + [list [expr {$w * 0.36}] [expr {$h * 0.12}]] \ + [list [expr {$w * 0.50}] [expr {$h * 0.18}]] \ + [list [expr {$w * 0.45}] [expr {$h * 0.32}]] \ + [list [expr {$w * 0.28}] [expr {$h * 0.32}]]] \ + color greenyellow layer 5 + } } diff --git a/builtin-programs/draw/image.folk b/builtin-programs/draw/image.folk index c159c006..6f932b60 100644 --- a/builtin-programs/draw/image.folk +++ b/builtin-programs/draw/image.folk @@ -183,3 +183,17 @@ When the image library is /imageLib/ &\ When /someone/ wishes /p/ displays image /im/ { Wish $p displays image $im with scale 1.0 } + +Claim $this has demo code { + When the print library is /printLib/ &\ + $this has resolved geometry /geom/ { + set w [dict get $geom width] + set h [dict get $geom height] + Wish to draw an image onto $this with \ + image [$printLib tagImageForId 45009] \ + position [list [expr {$w * 0.50}] [expr {$h * 0.46}]] \ + anchor center \ + width [expr {$h * 0.36}] height [expr {$h * 0.36}] \ + layer 6 + } +} diff --git a/builtin-programs/draw/line.folk b/builtin-programs/draw/line.folk index 96215309..5d190f3e 100644 --- a/builtin-programs/draw/line.folk +++ b/builtin-programs/draw/line.folk @@ -53,3 +53,17 @@ When the color map is /colorMap/ &\ Wish the GPU draws pipeline "line" onto canvas $id \ with instances $instances layer $layer } + +Claim $this has demo code { + When $this has resolved geometry /geom/ { + set w [dict get $geom width] + set h [dict get $geom height] + Wish to draw a line onto $this with \ + points [list \ + [list [expr {$w * 0.16}] [expr {$h * 0.70}]] \ + [list [expr {$w * 0.40}] [expr {$h * 0.35}]] \ + [list [expr {$w * 0.68}] [expr {$h * 0.62}]] \ + [list [expr {$w * 0.86}] [expr {$h * 0.28}]]] \ + width [expr {$h * 0.012}] color deepskyblue layer 4 + } +} diff --git a/builtin-programs/draw/shapes.folk b/builtin-programs/draw/shapes.folk new file mode 100644 index 00000000..17a775aa --- /dev/null +++ b/builtin-programs/draw/shapes.folk @@ -0,0 +1,341 @@ +set drawShapeSides [dict create \ + triangle 3 square 4 pentagon 5 hexagon 6 septagon 7 octagon 8 nonagon 9] + +fn drawShapeTruthy {value} { + expr {$value in {1 true yes on}} +} + +fn drawShapeCanonical {shape options} { + if {[dict exists $options type]} { + set shape [dict get $options type] + } + if {[dict exists $options shape]} { + set shape [dict get $options shape] + } + switch -- $shape { + rectangle - box { return rect } + default { return $shape } + } +} + +fn drawShapeScalar {value extent} { + if {[string match *% $value]} { + set pct [string range $value 0 end-1] + return [expr {double($pct) / 100.0 * $extent}] + } + return $value +} + +fn drawShapePageCenter {geom} { + list [expr {[dict get $geom width] / 2.0}] \ + [expr {[dict get $geom height] / 2.0}] +} + +fn drawShapePoint {point geom} { + if {$point eq "" || $point eq "center"} { + return [drawShapePageCenter $geom] + } + if {[llength $point] != 2} { + error "draw/shapes: expected a 2D point, got $point" + } + list [drawShapeScalar [lindex $point 0] [dict get $geom width]] \ + [drawShapeScalar [lindex $point 1] [dict get $geom height]] +} + +fn drawShapeOffset {offset geom} { + if {$offset eq "" || $offset eq "center"} { + return {0 0} + } + + set width [dict get $geom width] + set height [dict get $geom height] + + if {[llength $offset] == 1} { + set token [lindex $offset 0] + switch -- $token { + right { return [list [expr {$width / 2.0}] 0] } + left { return [list [expr {-$width / 2.0}] 0] } + down { return [list 0 [expr {$height / 2.0}]] } + up { return [list 0 [expr {-$height / 2.0}]] } + default { + return [list [drawShapeScalar $token $width] 0] + } + } + } + + if {[llength $offset] == 2} { + set dir [lindex $offset 0] + set amount [lindex $offset 1] + switch -- $dir { + right { return [list [drawShapeScalar $amount $width] 0] } + left { + set value [drawShapeScalar $amount $width] + return [list [expr {-$value}] 0] + } + down { return [list 0 [drawShapeScalar $amount $height]] } + up { + set value [drawShapeScalar $amount $height] + return [list 0 [expr {-$value}]] + } + default { + return [list [drawShapeScalar $dir $width] \ + [drawShapeScalar $amount $height]] + } + } + } + + error "draw/shapes: expected offset like {x y} or {right 50%}, got $offset" +} + +fn drawShapePosition {options geom} { + if {[dict exists $options position]} { + return [drawShapePoint [dict get $options position] $geom] + } + if {[dict exists $options center]} { + return [drawShapePoint [dict get $options center] $geom] + } + if {[dict exists $options x] || [dict exists $options y]} { + set x [drawShapeScalar [dict getdef $options x 50%] [dict get $geom width]] + set y [drawShapeScalar [dict getdef $options y 50%] [dict get $geom height]] + return [list $x $y] + } + + set pos [drawShapePageCenter $geom] + if {[dict exists $options offset]} { + set pos [vec2 add $pos [drawShapeOffset [dict get $options offset] $geom]] + } + return $pos +} + +fn drawShapeRadians {options} { + dict getdef $options radians [dict getdef $options angle 0] +} + +fn drawShapeRadius {options default} { + if {[dict exists $options diameter]} { + return [expr {[dict get $options diameter] / 2.0}] + } + dict getdef $options radius $default +} + +fn drawShapeRegularPolygon {center radius sides radians} { + lassign $center cx cy + set points [list] + for {set i 0} {$i < $sides} {incr i} { + set theta [expr {$radians + $i * 2.0 * 3.141592653589793 / $sides - 1.5707963267948966}] + lappend points [list [expr {$cx + $radius * cos($theta)}] \ + [expr {$cy + $radius * sin($theta)}]] + } + return $points +} + +fn drawShapeRectPoints {center width height radians} { + set hw [expr {$width / 2.0}] + set hh [expr {$height / 2.0}] + set points [list \ + [list [expr {-$hw}] [expr {-$hh}]] \ + [list $hw [expr {-$hh}]] \ + [list $hw $hh] \ + [list [expr {-$hw}] $hh]] + lmap point $points { + vec2 add $center [vec2 rotate $point $radians] + } +} + +fn drawShapePathPoints {points geom options} { + set radians [drawShapeRadians $options] + set origin [dict getdef $options origin center] + set absolute [expr {$origin in {absolute local topleft top-left}}] + if {$absolute} { + set base {0 0} + } else { + set base [drawShapePosition $options $geom] + } + + set transformed [list] + foreach point $points { + if {$absolute} { + set point [drawShapePoint $point $geom] + } else { + set point [drawShapeOffset $point $geom] + } + lappend transformed [vec2 add $base [vec2 rotate $point $radians]] + } + return $transformed +} + +fn process_offset {offset regionOrGeom} { + if {[catch { + dict create width [dict get $regionOrGeom width] height [dict get $regionOrGeom height] + } geom]} { + set geom [dict create width [region width $regionOrGeom] height [region height $regionOrGeom]] + } + drawShapeOffset $offset $geom +} + +When /someone/ wishes /p/ draws a /shape/ with /...options/ &\ + /p/ has resolved geometry /geom/ { + set shape [drawShapeCanonical $shape $options] + set center [drawShapePosition $options $geom] + set color [dict getdef $options color white] + set filled [drawShapeTruthy [dict getdef $options filled false]] + set thickness [dict getdef $options thickness 0.002] + set layer [dict getdef $options layer 1] + set radians [drawShapeRadians $options] + + if {$shape eq "circle"} { + set radius [drawShapeRadius $options 0.02] + Wish to draw a circle onto $p with \ + center $center radius $radius thickness $thickness \ + color $color filled $filled layer $layer + return + } + + if {$shape eq "rect"} { + set radius [drawShapeRadius $options 0.02] + set size [dict getdef $options size [expr {$radius * 2.0}]] + set rectWidth [dict getdef $options width $size] + set rectHeight [dict getdef $options height [dict getdef $options width $size]] + set points [drawShapeRectPoints $center $rectWidth $rectHeight $radians] + } else { + if {[dict exists $options sides]} { + set sides [dict get $options sides] + } elseif {[dict exists $drawShapeSides $shape]} { + set sides [dict get $drawShapeSides $shape] + } else { + error "draw/shapes: unknown shape $shape" + } + set radius [drawShapeRadius $options 0.02] + set points [drawShapeRegularPolygon $center $radius $sides $radians] + } + + if {$filled} { + Wish to draw a polygon onto $p with points $points color $color layer $layer + } else { + lappend points [lindex $points 0] + Wish to draw a line onto $p with \ + points $points width $thickness color $color layer $layer + } +} + +When /someone/ wishes /p/ draws a /shape/ { + Wish $p draws a $shape with color white filled true +} + +When /someone/ wishes /p/ draws an /shape/ { + Wish $p draws a $shape +} + +When /someone/ wishes /p/ draws an /shape/ with /...options/ { + Wish $p draws a $shape with {*}$options +} + +When /someone/ wishes /p/ draws a rect with width /width/ height /height/ { + Wish $p draws a rect with width $width height $height +} + +When /someone/ wishes /p/ draws a /shape/ with radius /radius/ { + Wish $p draws a $shape with radius $radius +} + +When /someone/ wishes /p/ draws text /text/ with /...options/ &\ + /p/ has resolved geometry /geom/ { + set position [drawShapePosition $options $geom] + set color [dict getdef $options color white] + set scale [dict getdef $options scale 0.01] + set layer [dict getdef $options layer 0] + set anchor [dict getdef $options anchor center] + set font [dict getdef $options font "PTSans-Regular"] + set radians [drawShapeRadians $options] + + Wish to draw text onto $p with \ + position $position scale $scale text $text \ + color $color radians $radians anchor $anchor font $font layer $layer +} + +When /someone/ wishes /p/ draws text /text/ { + Wish $p draws text $text with color white +} + +When /someone/ wishes /p/ draws a polyline /points/ with /...options/ &\ + /p/ has resolved geometry /geom/ { + set points [drawShapePathPoints $points $geom $options] + set color [dict getdef $options color white] + set width [dict getdef $options width [dict getdef $options thickness 0.002]] + set layer [dict getdef $options layer 1] + set dashed [drawShapeTruthy [dict getdef $options dashed false]] + + if {$dashed} { + set dashlength [dict getdef $options dashlength 0.01] + set dashoffset [dict getdef $options dashoffset 0] + Wish to draw a dashed line onto $p with \ + points $points width $width color $color \ + dashlength $dashlength dashoffset $dashoffset layer $layer + } else { + Wish to draw a line onto $p with \ + points $points width $width color $color layer $layer + } +} + +When /someone/ wishes /p/ draws points /points/ with /...options/ &\ + /p/ has resolved geometry /geom/ { + set points [drawShapePathPoints $points $geom $options] + set radius [drawShapeRadius $options 0.003] + set thickness [dict getdef $options thickness 0.001] + set color [dict getdef $options color white] + set filled [drawShapeTruthy [dict getdef $options filled true]] + set layer [dict getdef $options layer 1] + + foreach point $points { + Wish to draw a circle onto $p with \ + center $point radius $radius thickness $thickness \ + color $color filled $filled layer $layer + } +} + +When /someone/ wishes /p/ draws a set of points /points/ with /...options/ { + Wish $p draws points $points with {*}$options +} + +Claim $this has demo code { + Wish $this draws a circle with radius 0.018 color white filled true + + set baseX -0.055 + set baseY -0.035 + set dx 0.037 + set dy 0.03 + + Wish $this draws text "triangle" with color skyblue offset [list $baseX [expr {$baseY - 0.018}]] scale 0.004 + Wish $this draws text "square" with color green offset [list [expr {$baseX + $dx}] [expr {$baseY - 0.018}]] scale 0.004 + Wish $this draws text "pentagon" with color gold offset [list [expr {$baseX + $dx * 2}] [expr {$baseY - 0.018}]] scale 0.004 + Wish $this draws text "rect" with color cyan offset [list [expr {$baseX + $dx * 3}] [expr {$baseY - 0.018}]] scale 0.004 + + Wish $this draws a triangle with color skyblue radius 0.012 thickness 0.001 offset [list $baseX $baseY] + Wish $this draws a square with color green radius 0.012 thickness 0.0015 radians 0.785398 offset [list [expr {$baseX + $dx}] $baseY] + Wish $this draws a pentagon with color gold radius 0.012 filled true offset [list [expr {$baseX + $dx * 2}] $baseY] + Wish $this draws a rect with width 0.026 height 0.014 color cyan radians 0.4 offset [list [expr {$baseX + $dx * 3}] $baseY] + + Wish $this draws a polyline [list {-0.055 0.01} {-0.035 0.025} {-0.015 0.008} {0.005 0.025}] \ + with color magenta width 0.0015 + Wish $this draws a polyline [list {0.02 0.012} {0.04 0.025} {0.06 0.012}] \ + with color orange width 0.001 dashed true dashlength 0.006 + Wish $this draws a set of points [list {-0.052 0.045} {-0.038 0.047} {-0.024 0.043} {-0.010 0.047}] \ + with color palegoldenrod radius 0.0025 + + When $this has resolved geometry /geom/ & the clock time is /t/ { + set x [expr {sin($t) * 0.028}] + set y [expr {cos($t * 1.5) * 0.018}] + Wish $this draws a circle with \ + radius 0.004 color palegoldenrod filled true offset [list $x $y] layer 4 + } + + When $this has resolved geometry /geom/ & the clock time is /t/ { + set filled [expr {round($t * 2) % 2 == 0}] + Wish $this draws a square with \ + radius 0.014 color white filled $filled offset {0.05 0.045} + Wish $this draws text $filled with \ + offset {0.05 0.045} scale 0.005 color red layer 5 + } + + Wish $this is outlined white +} diff --git a/builtin-programs/draw/text.folk b/builtin-programs/draw/text.folk index f9dfcf63..eb1e04f8 100644 --- a/builtin-programs/draw/text.folk +++ b/builtin-programs/draw/text.folk @@ -320,3 +320,18 @@ When the color map is /colorMap/ &\ } } + +Claim $this has demo code { + When $this has resolved geometry /geom/ { + set w [dict get $geom width] + set h [dict get $geom height] + Wish to draw text onto $this with \ + position [list [expr {$w * 0.50}] [expr {$h * 0.44}]] \ + scale [expr {$h * 0.085}] text "draw/text" \ + color white anchor center layer 8 + Wish to draw text onto $this with \ + position [list [expr {$w * 0.50}] [expr {$h * 0.62}]] \ + scale [expr {$h * 0.050}] text "anchor center" \ + color lavender anchor center layer 8 + } +} diff --git a/builtin-programs/shapes.folk b/builtin-programs/shapes.folk deleted file mode 100644 index c67c7e43..00000000 --- a/builtin-programs/shapes.folk +++ /dev/null @@ -1,357 +0,0 @@ -set shapes [dict create triangle 3 square 4 pentagon 5 hexagon 6 septagon 7 octagon 8 nonagon 9] - -proc process_offset {offset region} { - if {![info exists region]} { - return $offset - } - - set w [region width $region] - set h [region height $region] - - if {[llength $offset] == 2 && - ![string match *%* $offset] && - ![string is alpha -strict [lindex $offset 0]]} { - return $offset - } - - # Handle simple percentage string: "50%" - if {[string match *%* $offset] && [llength $offset] == 1} { - set pct [expr {[string map {% ""} $offset] / 100.0}] - return [list [expr {$w * $pct}] 0] # Default to horizontal offset - } - - # Handle directional strings: "right", "left", "up", "down" - if {$offset eq "right"} { - return [list [expr {$w * 0.5}] 0] - } elseif {$offset eq "left"} { - return [list [expr {-$w * 0.5}] 0] - } elseif {$offset eq "up"} { - return [list 0 [expr {-$h * 0.5}]] - } elseif {$offset eq "down"} { - return [list 0 [expr {$h * 0.5}]] - } - - # Handle directional percentage: "right 50%", "left 25%", etc. - if {[llength $offset] == 2 && [string is alpha -strict [lindex $offset 0]]} { - set direction [lindex $offset 0] - set amount [lindex $offset 1] - - if {[string match *%* $amount]} { - set pct [expr {[string map {% ""} $amount] / 100.0}] - - switch $direction { - "right" { return [list [expr {$w * $pct}] 0] } - "left" { return [list [expr {-$w * $pct}] 0] } - "up" { return [list 0 [expr {-$h * $pct}]] } - "down" { return [list 0 [expr {$h * $pct}]] } - default { return [list 0 0] } - } - } - } - - # Handle x y vector where one or both components have percentage notation - if {[llength $offset] == 2} { - lassign $offset ox oy - - if {[string match *%* $ox]} { - set pct [expr {[string map {% ""} $ox] / 100.0}] - set ox [expr {$w * $pct}] - } - - if {[string match *%* $oy]} { - set pct [expr {[string map {% ""} $oy] / 100.0}] - set oy [expr {$h * $pct}] - } - - return [list $ox $oy] - } - - # Default fallback - return $offset -} - -When /someone/ wishes to draw a shape with /...options/ { - set isRect 0 - if {[dict exists $options type] && [dict get $options type] eq "rect"} { - set isRect 1 - } - - set c [dict_getdef $options center {0 0}] - - set color [dict_getdef $options color white] - set filled [dict_getdef $options filled false] - set thickness [dict_getdef $options thickness 1] - set layer [dict_getdef $options layer 0] - set angle [dict_getdef $options angle 0] - - if {$isRect} { - set w [dict_getdef $options width 100] - set h [dict_getdef $options height 100] - - set hw [expr {$w / 2.0}] - set hh [expr {$h / 2.0}] - - set points [lmap v [list \ - [list [expr {-$hw}] [expr {-$hh}]] \ - [list [expr {$hw}] [expr {-$hh}]] \ - [list [expr {$hw}] [expr {$hh}]] \ - [list [expr {-$hw}] [expr {$hh}]] \ - [list [expr {-$hw}] [expr {-$hh}]] \ - ] { - vec2 add [vec2 rotate $v $angle] $c - }] - } else { - set numPoints [dict_getdef $options sides 4] - if {[dict exists $options shape] && [dict exists $shapes [dict get $options shape]]} { - set numPoints [dict get $shapes [dict get $options shape]] - } - set r [dict_getdef $options radius 50] - - set points {{0 0}} - set centerPoint {0 0} - set polyAngle [expr {2 * 3.14159 / $numPoints + 3.14159}] - set angleIncr [expr {2 * 3.14159 / $numPoints}] - - for {set i 0} {$i < $numPoints} {incr i} { - set p [vec2 add [lindex $points end] [vec2 scale [list [expr {cos($polyAngle)}] [expr {sin($polyAngle)}]] $r]] - lappend points $p - set centerPoint [vec2 add $centerPoint $p] - set polyAngle [expr {$polyAngle + $angleIncr}] - } - - set points [lmap v $points { - vec2 add [vec2 rotate [vec2 sub $v [vec2 scale $centerPoint [expr {1.0/$numPoints}]]] $angle] $c - }] - } - - if {$filled} { - Wish to draw a polygon with points $points color $color layer $layer - } else { - Wish to draw a stroke with points $points width $thickness color $color layer $layer - } -} - -When /someone/ wishes /p/ draws a /shape/ { - Wish $p draws a $shape with color white -} - -# Handle "a" vs "an" grammar variations -When /someone/ wishes /p/ draws an /shape/ { - Wish $p draws a $shape -} - -When /someone/ wishes /p/ draws text /text/ with /...options/ & /p/ has region /r/ { - # As shapes.folk but for text. - lassign [region centroid $r] cx cy - set pageAngle [region angle $r] - - # Use the page's angle unless explicitly overwritten - set defaults [dict create \ - color white \ - scale 1.0 \ - layer 0 \ - angle $pageAngle \ - anchor center \ - font "PTSans-Regular" - ] - - set options [dict merge $defaults $options] - - set color [dict get $options color] - set scale [dict get $options scale] - set layer [dict get $options layer] - set angle [dict get $options angle] - set anchor [dict get $options anchor] - set font [dict get $options font] - - set offset [dict_getdef $options offset {0 0}] - set offset [::process_offset $offset $r] - set center [vec2 add [list $cx $cy] [vec2 rotate $offset $pageAngle]] - - Wish to draw text with position $center scale $scale text $text\ - color $color radians $angle anchor $anchor font $font -} - -When /someone/ wishes /p/ draws text /text/ { - Wish $p draws text $text with color white -} - -When /someone/ wishes /p/ draws a /shape/ with /...options/ & /p/ has region /r/ { - lassign [region centroid $r] cx cy - set angle [region angle $r] - - set color [dict_getdef $options color white] - set filled [dict_getdef $options filled false] - set thickness [dict_getdef $options thickness 5] - set layer [dict_getdef $options layer 0] - - set offset [dict_getdef $options offset {0 0}] - set offset [process_offset $offset $r] - - set center [vec2 add [list $cx $cy] [vec2 rotate $offset $angle]] - - if {$shape eq "circle"} { - set radius [dict_getdef $options radius 50] - - Wish to draw a circle with center $center radius $radius thickness $thickness \ - color $color filled $filled layer $layer - - } elseif {$shape eq "rect"} { - set w [dict_getdef $options width [region width $r]] - set h [dict_getdef $options height [region height $r]] - - Wish to draw a shape with type rect center $center width $w height $h angle $angle \ - color $color filled $filled thickness $thickness layer $layer - - } elseif {[dict exists $shapes $shape]} { - set radius [dict_getdef $options radius 50] - - Wish to draw a shape with sides [dict get $shapes $shape] center $center radius $radius \ - angle $angle color $color filled $filled thickness $thickness layer $layer - - } else { - set radius [dict_getdef $options radius 50] - - Wish to draw a shape with sides 4 center $center radius $radius \ - angle $angle color $color filled $filled thickness $thickness layer $layer - } -} - -# Pass through options for "an" version -When /someone/ wishes /p/ draws an /shape/ with /...options/ { - Wish $p draws a $shape with {*}$options -} - -When /someone/ wishes /p/ draws a rect with width /w/ height /h/ { - Wish $p draws a rect with width $w height $h -} - -When /someone/ wishes /p/ draws a /shape/ with radius /rad/ { - Wish $p draws a $shape with radius $rad -} - -When /someone/ wishes /page/ draws a set of points /points/ with /...options/ & /page/ has region /r/ { - set radius [dict_getdef $options radius 5] - set color [dict_getdef $options color white] - set filled [dict_getdef $options filled true] - set thickness [dict_getdef $options thickness 2] - set layer [dict_getdef $options layer 0] - - lassign [region centroid $r] cx cy - set angle [region angle $r] - set center [list $cx $cy] - - if {[dict exists $options offset]} { - set offset [dict get $options offset] - set offset [process_offset $offset $r] - set center [vec2 add $center [vec2 rotate $offset $angle]] - } - - foreach point $points { - set pointPos [vec2 add $center [vec2 rotate $point $angle]] - - Wish to draw a circle with center $pointPos radius $radius thickness $thickness \ - color $color filled $filled layer $layer - } -} - -When /someone/ wishes /page/ draws a polyline /points/ with /...options/ & /page/ has region /r/ { - set color [dict_getdef $options color white] - set thickness [dict_getdef $options thickness 2] - set layer [dict_getdef $options layer 0] - set dashed [dict_getdef $options dashed false] - set dashlength [dict_getdef $options dashlength 20] - set dashoffset [dict_getdef $options dashoffset 0] - - lassign [region centroid $r] cx cy - set angle [region angle $r] - set center [list $cx $cy] - - if {[dict exists $options offset]} { - set offset [dict get $options offset] - set offset [process_offset $offset $r] - set center [vec2 add $center [vec2 rotate $offset $angle]] - } - - set transformedPoints {} - foreach point $points { - lappend transformedPoints [vec2 add $center [vec2 rotate $point $angle]] - } - - if {$dashed} { - Wish to draw a dashed stroke with points $transformedPoints color $color width $thickness \ - dashlength $dashlength dashoffset $dashoffset layer $layer - } else { - Wish to draw a stroke with points $transformedPoints color $color width $thickness layer $layer - } -} - -Claim $this has demo { - # Center circle - Wish $this draws a circle - - # Grid of shapes with varying thickness - set baseX -850 - set baseY -200 - set gridSpacing 130 - - # Row 0: Title - Wish $this draws text "triangle" with color skyblue offset [list $baseX [expr {$baseY - ($gridSpacing / 2.0)}]] scale 0.9 - Wish $this draws text "square" with color green offset [list [expr {$baseX + $gridSpacing}] [expr {$baseY - ($gridSpacing / 2.0)}]] scale 0.9 - Wish $this draws text "pentagon" with color gold offset [list [expr {$baseX + $gridSpacing*2}] [expr {$baseY - ($gridSpacing / 2.0)}]] scale 0.9 - Wish $this draws text "hexagon" with color orange offset [list [expr {$baseX + $gridSpacing*3}] [expr {$baseY - ($gridSpacing / 2.0)}]] scale 0.9 - - # Row 1: Regular polygons with different colors and thickness - Wish $this draws a triangle with color skyblue thickness 2 offset [list $baseX [expr {$baseY}]] - Wish $this draws a square with color green thickness 4 offset [list [expr {$baseX + $gridSpacing}] [expr {$baseY}]] - Wish $this draws a pentagon with color gold thickness 6 offset [list [expr {$baseX + $gridSpacing*2}] [expr {$baseY}]] - Wish $this draws a hexagon with color orange thickness 8 offset [list [expr {$baseX + $gridSpacing*3}] [expr {$baseY}]] - - # Row 2: Filled shapes - Wish $this draws a triangle with color skyblue filled true offset [list $baseX [expr {$baseY + $gridSpacing}]] - Wish $this draws a square with color green filled true offset [list [expr {$baseX + $gridSpacing}] [expr {$baseY + $gridSpacing}]] - Wish $this draws a pentagon with color gold filled true offset [list [expr {$baseX + $gridSpacing*2}] [expr {$baseY + $gridSpacing}]] - Wish $this draws a hexagon with color orange filled true offset [list [expr {$baseX + $gridSpacing*3}] [expr {$baseY + $gridSpacing}]] - - # Row 3: Directional offset examples (replacing shift) - Wish $this draws a triangle with radius 40 offset "right 50%" color skyblue - Wish $this draws a square with radius 40 offset "left 50%" color green - Wish $this draws a pentagon with radius 40 offset "up 50%" color gold - Wish $this draws a hexagon with radius 40 offset "down 50%" color orange - - # Row 4: Rectangles with different properties - Wish $this draws a rect with width 80 height 50 color cyan thickness 3 offset [list $baseX [expr {$baseY + $gridSpacing*3}]] - Wish $this draws a rect with width 80 height 50 color magenta filled true offset [list [expr {$baseX + $gridSpacing}] [expr {$baseY + $gridSpacing*3}]] - Wish $this draws a rect with width 80 height 50 offset "right 50%" - Wish $this draws a rect with width 80 height 50 offset "left 50%" - -# Animated elements - When $this has region /r/ & the clock time is /t/ { - lassign [region angle $r] angle - for {set i 0} {$i < 8} {incr i} { - set offsetVector [list [sin [+ [- $i $t] $angle]] [* 2 [cos [+ [- $i $t] $angle]]]] - set vector [::vec2::scale $offsetVector [+ [* $i $i] 15]] - Wish $this draws a circle with radius $i color palegoldenrod offset $vector - } - } - - When $this has region /r/ & the clock time is /t/ { - lassign [region centroid $r] x y - set fillVal [expr {round(sin($t) * 2)}] - set fill [expr {$fillVal % 2 == 0}] - set y [- $y 150] - Wish to draw a shape with sides 4 center [list [- $x 200] $y] radius 60 color white filled $fill - Wish to draw text with position [list [- $x 200] [+ $y 14]] scale 1.5 text "$fillVal" color red - } - - When $this has region /r/ & the clock time is /t/ { - lassign [region centroid $r] x y - set fillVal [expr {round($t * 2)}] - set fill [expr {$fillVal % 2 == 0}] - set y [- $y 150] - Wish to draw a shape with sides 4 center [list [+ $x 200] $y] radius 60 color white filled $fill - Wish to draw text with position [list [+ $x 200] [+ $y 14]] scale 1.5 text "$fill" color red - } - - Wish $this is outlined white -} diff --git a/test/draw-primitives.folk b/test/draw-primitives.folk new file mode 100644 index 00000000..5d407781 --- /dev/null +++ b/test/draw-primitives.folk @@ -0,0 +1,45 @@ +source builtin-programs/collect.folk +source builtin-programs/draw/color-map.folk +source builtin-programs/draw/fill.folk +source builtin-programs/draw/shapes.folk +source builtin-programs/draw/arc.folk +source builtin-programs/draw/curve.folk + +set geom {width 0.2 height 0.1} + +set pos [drawShapePosition {offset {right 25%}} $geom] +assert {abs([lindex $pos 0] - 0.15) < 1e-9} +assert {abs([lindex $pos 1] - 0.05) < 1e-9} + +set rectPoints [drawShapeRectPoints {0.1 0.05} 0.04 0.02 0] +lassign [lindex $rectPoints 0] x y +assert {abs($x - 0.08) < 1e-9} +assert {abs($y - 0.04) < 1e-9} +lassign [lindex $rectPoints 2] x y +assert {abs($x - 0.12) < 1e-9} +assert {abs($y - 0.06) < 1e-9} + +set shapePage shape-page +Assert! $shapePage has resolved geometry $geom +Wish $shapePage draws a rectangle with width 0.04 height 0.02 color cyan filled true + +set fillPage fill-page +Assert! $fillPage has resolved geometry {width 0.3 height 0.15} +Wish $fillPage is filled with color black layer 7 + +sleep 1 + +set shapeDraws [Query! /someone/ wishes to draw a polygon onto $shapePage with /...drawOptions/] +assert {[llength $shapeDraws] == 1} +set drawOptions [dict get [lindex $shapeDraws 0] drawOptions] +assert {[dict get $drawOptions color] eq "cyan"} +assert {[dict get $drawOptions points] eq $rectPoints} + +set fillDraws [Query! /someone/ wishes to draw a polygon onto $fillPage with /...drawOptions/] +assert {[llength $fillDraws] == 1} +set drawOptions [dict get [lindex $fillDraws 0] drawOptions] +assert {[dict get $drawOptions color] eq "black"} +assert {[dict get $drawOptions layer] == 7} +assert {[dict get $drawOptions points] eq {{0 0} {0.3 0} {0.3 0.15} {0 0.15}}} + +Exit! 0 From 0d02c569c430f59600a92df49dd06ff5db0ce82b Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andr=C3=A9s=20Cuervo?= Date: Wed, 6 May 2026 19:12:10 -0400 Subject: [PATCH 3/6] draw: add demo runner and title source margins Add a draw-space library with vector, quad, projection, and display-length helpers for building display-space drawing demos from a page quad. Move the drawing primitives booklet entry into builtin-programs/draw/space.folk and make Wish runs demo code from evaluate that program's has-demo-code claim.\n\nTeach title.folk to pass drawing options through for titled, footnoted, left-margined, and right-margined text. Styled variants can now choose font, color, scale, anchor, and padding, while plain no-options wishes normalize through the same rendering path. Add demo coverage for the composite drawing demo, per-program demo execution, source-code left margins, and styled title/margin examples. --- builtin-programs/draw/space.folk | 316 +++++++++++++++++++++++++++++++ builtin-programs/title.folk | 92 +++++++-- test/drawing-demo.folk | 299 +++++++++++++++++++++++++++++ 3 files changed, 693 insertions(+), 14 deletions(-) create mode 100644 builtin-programs/draw/space.folk create mode 100644 test/drawing-demo.folk diff --git a/builtin-programs/draw/space.folk b/builtin-programs/draw/space.folk new file mode 100644 index 00000000..750762f9 --- /dev/null +++ b/builtin-programs/draw/space.folk @@ -0,0 +1,316 @@ +set drawSpaceLib [library create drawSpaceLib { + proc vectorAdd {a b} { + set out [list] + foreach av $a bv $b { + lappend out [expr {$av + $bv}] + } + return $out + } + + proc vectorSub {a b} { + set out [list] + foreach av $a bv $b { + lappend out [expr {$av - $bv}] + } + return $out + } + + proc vectorScale {v s} { + lmap x $v { + expr {$x * $s} + } + } + + proc vectorDistance {a b} { + set sum 0.0 + foreach av $a bv $b { + set d [expr {$av - $bv}] + set sum [expr {$sum + $d * $d}] + } + expr {sqrt($sum)} + } + + proc vectorUnit {v} { + set zero [lmap _ $v { expr {0.0} }] + set n [vectorDistance $v $zero] + if {$n == 0.0} { return $zero } + vectorScale $v [expr {1.0 / $n}] + } + + proc vectorAverage {points} { + set first [lindex $points 0] + set sum [lmap _ $first { expr {0.0} }] + foreach point $points { + set sum [vectorAdd $sum $point] + } + vectorScale $sum [expr {1.0 / [llength $points]}] + } + + proc vectorMidpoint {a b} { + vectorScale [vectorAdd $a $b] 0.5 + } + + proc quadBasis {quadLib quad} { + lassign [$quadLib vertices $quad] topLeft topRight bottomRight bottomLeft + dict create \ + origin [vectorAverage [list $topLeft $topRight $bottomRight $bottomLeft]] \ + xAxis [vectorUnit [vectorSub $topRight $topLeft]] \ + yAxis [vectorUnit [vectorSub $bottomLeft $topLeft]] + } + + proc quadPoint {quadLib quad selector} { + lassign [$quadLib vertices $quad] topLeft topRight bottomRight bottomLeft + + switch -- [string tolower $selector] { + centroid - center { + return [vectorAverage [list $topLeft $topRight $bottomRight $bottomLeft]] + } + top { + return [vectorMidpoint $topLeft $topRight] + } + right { + return [vectorMidpoint $topRight $bottomRight] + } + bottom { + return [vectorMidpoint $bottomLeft $bottomRight] + } + left { + return [vectorMidpoint $topLeft $bottomLeft] + } + topleft - top-left { + return $topLeft + } + topright - top-right { + return $topRight + } + bottomright - bottom-right { + return $bottomRight + } + bottomleft - bottom-left { + return $bottomLeft + } + default { + error "draw/space: unknown quad point selector $selector" + } + } + } + + proc physicalPoint {origin xAxis yAxis scale x y} { + vectorAdd $origin \ + [vectorAdd \ + [vectorScale $xAxis [expr {$x * $scale}]] \ + [vectorScale $yAxis [expr {$y * $scale}]]] + } + + proc project {poseLib intrinsics width height point} { + $poseLib project $intrinsics $width $height $point + } + + proc projectPoint {poseLib intrinsics width height origin xAxis yAxis scale x y} { + set point [physicalPoint $origin $xAxis $yAxis $scale $x $y] + project $poseLib $intrinsics $width $height $point + } + + proc projectPoints {poseLib intrinsics width height origin xAxis yAxis scale points} { + lmap point $points { + projectPoint $poseLib $intrinsics $width $height \ + $origin $xAxis $yAxis $scale [lindex $point 0] [lindex $point 1] + } + } + + proc displayLength {poseLib intrinsics width height origin xAxis yAxis meters} { + set a [projectPoint $poseLib $intrinsics $width $height \ + $origin $xAxis $yAxis 1.0 0 0] + set b [projectPoint $poseLib $intrinsics $width $height \ + $origin $xAxis $yAxis 1.0 $meters 0] + vectorDistance $a $b + } + + proc regularPolygon {poseLib intrinsics width height origin xAxis yAxis scale cx cy radius sides radians} { + set points [list] + for {set i 0} {$i < $sides} {incr i} { + set theta [expr {$radians + $i * 2.0 * 3.141592653589793 / $sides - 1.5707963267948966}] + lappend points [list [expr {$cx + $radius * cos($theta)}] \ + [expr {$cy + $radius * sin($theta)}]] + } + projectPoints $poseLib $intrinsics $width $height \ + $origin $xAxis $yAxis $scale $points + } +}] + +Claim the draw space library is $drawSpaceLib + +When /someone/ wishes /thing/ runs demo code from /demoSource/ &\ + /demoSource/ has demo code /code/ { + Wish $thing is left-margined [string trim $code] with \ + font CourierPrimeCode \ + anchor {1.0 0.5 0 0.5} \ + scale 18.0 + evaluateBlock $code [list [dict create this $thing]] +} + +When /someone/ wishes /thing/ runs demo code { + Wish $thing runs demo code from $thing +} + +When /someone/ wishes /thing/ shows the drawing primitives demo &\ + the draw space library is /drawSpaceLib/ &\ + the quad library is /quadLib/ &\ + the pose library is /poseLib/ &\ + the quad changer is /quadChange/ &\ + display /disp/ has width /displayWidth/ height /displayHeight/ &\ + display /disp/ has intrinsics /displayIntrinsics/ &\ + /thing/ has quad /quad/ { + fn quadChange + + set basis [$drawSpaceLib quadBasis $quadLib [quadChange $quad "display $disp"]] + set origin [dict get $basis origin] + set xAxis [dict get $basis xAxis] + set yAxis [dict get $basis yAxis] + set scale 1.5 + + set displayScale [expr {$displayHeight / 1080.0}] + set hairline [expr {1.5 * $displayScale}] + set stroke [expr {3.0 * $displayScale}] + set dash [expr {10.0 * $displayScale}] + set textScale [expr {14.0 * $displayScale}] + set tinyTextScale [expr {9.0 * $displayScale}] + + set frame [$drawSpaceLib projectPoints \ + $poseLib $displayIntrinsics $displayWidth $displayHeight \ + $origin $xAxis $yAxis $scale \ + {{-0.10 -0.10} {0.10 -0.10} {0.10 0.10} {-0.10 0.10} {-0.10 -0.10}}] + Wish to draw a polygon onto $disp with \ + points [lrange $frame 0 3] color {0.02 0.025 0.03 0.55} layer 0 + Wish to draw a line onto $disp with \ + points $frame width $hairline color white layer 1 + + Wish to draw text onto $disp with \ + position [$drawSpaceLib projectPoint $poseLib $displayIntrinsics $displayWidth $displayHeight \ + $origin $xAxis $yAxis $scale 0 -0.087] \ + scale $textScale text "draw/* primitives" color white anchor center layer 8 + + Wish to draw a line onto $disp with \ + points [$drawSpaceLib projectPoints $poseLib $displayIntrinsics $displayWidth $displayHeight \ + $origin $xAxis $yAxis $scale {{-0.086 -0.062} {-0.034 -0.076} {-0.006 -0.054}}] \ + width $stroke color deepskyblue layer 4 + Wish to draw text onto $disp with \ + position [$drawSpaceLib projectPoint $poseLib $displayIntrinsics $displayWidth $displayHeight \ + $origin $xAxis $yAxis $scale -0.046 -0.042] \ + scale $tinyTextScale text "line" color deepskyblue anchor center layer 8 + + Wish to draw a dashed line onto $disp with \ + points [$drawSpaceLib projectPoints $poseLib $displayIntrinsics $displayWidth $displayHeight \ + $origin $xAxis $yAxis $scale {{0.018 -0.072} {0.083 -0.056}}] \ + width $stroke color gold dashlength $dash dashoffset 0 layer 4 + Wish to draw text onto $disp with \ + position [$drawSpaceLib projectPoint $poseLib $displayIntrinsics $displayWidth $displayHeight \ + $origin $xAxis $yAxis $scale 0.052 -0.041] \ + scale $tinyTextScale text "dash" color gold anchor center layer 8 + + Wish to draw a circle onto $disp with \ + center [$drawSpaceLib projectPoint $poseLib $displayIntrinsics $displayWidth $displayHeight \ + $origin $xAxis $yAxis $scale -0.072 -0.012] \ + radius [$drawSpaceLib displayLength $poseLib $displayIntrinsics $displayWidth $displayHeight \ + $origin $xAxis $yAxis [expr {0.013 * $scale}]] \ + thickness $stroke color cyan filled false layer 4 + Wish to draw a circle onto $disp with \ + center [$drawSpaceLib projectPoint $poseLib $displayIntrinsics $displayWidth $displayHeight \ + $origin $xAxis $yAxis $scale -0.045 -0.012] \ + radius [$drawSpaceLib displayLength $poseLib $displayIntrinsics $displayWidth $displayHeight \ + $origin $xAxis $yAxis [expr {0.009 * $scale}]] \ + thickness $hairline color mediumspringgreen filled true layer 5 + Wish to draw text onto $disp with \ + position [$drawSpaceLib projectPoint $poseLib $displayIntrinsics $displayWidth $displayHeight \ + $origin $xAxis $yAxis $scale -0.059 0.015] \ + scale $tinyTextScale text "circle" color cyan anchor center layer 8 + + Wish to draw a triangle onto $disp with \ + p0 [$drawSpaceLib projectPoint $poseLib $displayIntrinsics $displayWidth $displayHeight \ + $origin $xAxis $yAxis $scale -0.010 -0.028] \ + p1 [$drawSpaceLib projectPoint $poseLib $displayIntrinsics $displayWidth $displayHeight \ + $origin $xAxis $yAxis $scale -0.030 0.010] \ + p2 [$drawSpaceLib projectPoint $poseLib $displayIntrinsics $displayWidth $displayHeight \ + $origin $xAxis $yAxis $scale 0.010 0.010] \ + color magenta layer 4 + Wish to draw a quad onto $disp with \ + p0 [$drawSpaceLib projectPoint $poseLib $displayIntrinsics $displayWidth $displayHeight \ + $origin $xAxis $yAxis $scale 0.024 -0.030] \ + p1 [$drawSpaceLib projectPoint $poseLib $displayIntrinsics $displayWidth $displayHeight \ + $origin $xAxis $yAxis $scale 0.062 -0.020] \ + p2 [$drawSpaceLib projectPoint $poseLib $displayIntrinsics $displayWidth $displayHeight \ + $origin $xAxis $yAxis $scale 0.055 0.016] \ + p3 [$drawSpaceLib projectPoint $poseLib $displayIntrinsics $displayWidth $displayHeight \ + $origin $xAxis $yAxis $scale 0.018 0.006] \ + color orange layer 4 + Wish to draw text onto $disp with \ + position [$drawSpaceLib projectPoint $poseLib $displayIntrinsics $displayWidth $displayHeight \ + $origin $xAxis $yAxis $scale 0.026 0.022] \ + scale $tinyTextScale text "triangle + quad" color orange anchor center layer 8 + + Wish to draw a polygon onto $disp with \ + points [$drawSpaceLib regularPolygon $poseLib $displayIntrinsics $displayWidth $displayHeight \ + $origin $xAxis $yAxis $scale -0.064 0.044 0.016 6 0.523599] \ + color greenyellow layer 4 + Wish to draw text onto $disp with \ + position [$drawSpaceLib projectPoint $poseLib $displayIntrinsics $displayWidth $displayHeight \ + $origin $xAxis $yAxis $scale -0.058 0.069] \ + scale $tinyTextScale text "polygon" color greenyellow anchor center layer 8 + + Wish to draw an arc onto $disp with \ + center [$drawSpaceLib projectPoint $poseLib $displayIntrinsics $displayWidth $displayHeight \ + $origin $xAxis $yAxis $scale -0.010 0.046] \ + radius [$drawSpaceLib displayLength $poseLib $displayIntrinsics $displayWidth $displayHeight \ + $origin $xAxis $yAxis [expr {0.016 * $scale}]] \ + thickness $stroke start 0.25 arclen 4.7 color hotpink layer 5 + Wish to draw text onto $disp with \ + position [$drawSpaceLib projectPoint $poseLib $displayIntrinsics $displayWidth $displayHeight \ + $origin $xAxis $yAxis $scale -0.010 0.069] \ + scale $tinyTextScale text "arc" color hotpink anchor center layer 8 + + Wish to draw a curve onto $disp with \ + p0 [$drawSpaceLib projectPoint $poseLib $displayIntrinsics $displayWidth $displayHeight \ + $origin $xAxis $yAxis $scale 0.026 0.061] \ + p1 [$drawSpaceLib projectPoint $poseLib $displayIntrinsics $displayWidth $displayHeight \ + $origin $xAxis $yAxis $scale 0.032 0.020] \ + p2 [$drawSpaceLib projectPoint $poseLib $displayIntrinsics $displayWidth $displayHeight \ + $origin $xAxis $yAxis $scale 0.074 0.084] \ + p3 [$drawSpaceLib projectPoint $poseLib $displayIntrinsics $displayWidth $displayHeight \ + $origin $xAxis $yAxis $scale 0.083 0.041] \ + thickness $stroke color lightskyblue layer 5 + Wish to draw text onto $disp with \ + position [$drawSpaceLib projectPoint $poseLib $displayIntrinsics $displayWidth $displayHeight \ + $origin $xAxis $yAxis $scale 0.060 0.019] \ + scale $tinyTextScale text "curve" color lightskyblue anchor center layer 8 + + Wish to draw an AprilTag onto $disp with \ + id 45009 \ + corners [$drawSpaceLib projectPoints $poseLib $displayIntrinsics $displayWidth $displayHeight \ + $origin $xAxis $yAxis $scale {{0.066 -0.004} {0.092 -0.004} {0.092 0.022} {0.066 0.022}}] \ + background {0.96 0.98 1.0 1.0} layer 6 + + When the print library is /printLib/ { + Wish to draw an image onto $disp with \ + image [$printLib tagImageForId 45009] \ + position [$drawSpaceLib projectPoint $poseLib $displayIntrinsics $displayWidth $displayHeight \ + $origin $xAxis $yAxis $scale 0.079 0.060] \ + anchor center \ + width [$drawSpaceLib displayLength $poseLib $displayIntrinsics $displayWidth $displayHeight \ + $origin $xAxis $yAxis [expr {0.026 * $scale}]] \ + height [$drawSpaceLib displayLength $poseLib $displayIntrinsics $displayWidth $displayHeight \ + $origin $xAxis $yAxis [expr {0.026 * $scale}]] + } + + Wish to draw text onto $disp with \ + position [$drawSpaceLib projectPoint $poseLib $displayIntrinsics $displayWidth $displayHeight \ + $origin $xAxis $yAxis $scale 0.079 0.083] \ + scale $tinyTextScale text "tag + image" color lavender anchor center layer 8 +} + +Claim $this has demo code { + Wish $this shows the drawing primitives demo +} + +Claim 45009 has demo code { + Wish $this runs demo code from builtin-programs/draw/space.folk +} diff --git a/builtin-programs/title.folk b/builtin-programs/title.folk index 223bf6a7..3e62ad3d 100644 --- a/builtin-programs/title.folk +++ b/builtin-programs/title.folk @@ -4,6 +4,52 @@ # Wish $this is footnoted "This is a footnote" # Wish $this is right-margined "This is right-margined text" # Wish $this is left-margined "This is left-margined text" +# Any of those can also take text drawing options: +# Wish $this is left-margined "code" with font CourierPrimeCode anchor {1.0 0.5 0 0.5} + +Claim $this has demo code { + Wish $this is titled "Title demo\ncenter aligned" with \ + font PTSans-Regular \ + color deepskyblue \ + scale 44.0 \ + anchor {0.5 1.0 0.5 1.0} + + Wish $this is footnoted "Footnote demo\nright aligned" with \ + font VictorMonoRegular \ + color gold \ + scale 22.0 \ + anchor {0.5 0.0 1.0 0.0} + + Wish $this is left-margined "Left margin\nCourier mono\nleft aligned" with \ + font CourierPrimeCode \ + color mediumspringgreen \ + scale 18.0 \ + anchor {1.0 0.15 0.0 0.0} \ + padding 0.01 + + Wish $this is right-margined "Right margin\nNeomatrix\nright aligned" with \ + font NeomatrixCode \ + color hotpink \ + scale 28.0 \ + anchor {0.0 0.85 1.0 1.0} \ + padding 0.01 +} + +When /someone/ wishes /thing/ is titled /text/ { + Wish $thing is titled $text with scale 36.0 +} + +When /someone/ wishes /thing/ is footnoted /text/ { + Wish $thing is footnoted $text with scale 36.0 +} + +When /someone/ wishes /thing/ is right-margined /text/ { + Wish $thing is right-margined $text with scale 36.0 +} + +When /someone/ wishes /thing/ is left-margined /text/ { + Wish $thing is left-margined $text with scale 36.0 +} When /thing/ has quad /quad/ { Claim -keep 50ms $thing has a quad @@ -24,9 +70,18 @@ When the quad library is /quadLib/ &\ right-margined right left left-margined left right } { - When the collected results for [list /someone/ wishes $thing is $label /text/] are /results/ { - set text [join [lmap result $results {dict get $result text}] "\n"] - if {$text eq ""} { return } + When the collected results for [list /someone/ wishes $thing is $label /text/ with /...options/] are /results/ { + set groups [dict create] + foreach result $results { + set resultText [dict get $result text] + if {$resultText eq ""} { continue } + + set resultOptions [dict getdef $result options [dict create]] + set texts [dict getdef $groups $resultOptions [list]] + lappend texts $resultText + dict set groups $resultOptions $texts + } + if {[llength $groups] == 0} { return } When -atomically $thing has quad /q/ { package require linalg @@ -58,23 +113,32 @@ When the quad library is /quadLib/ &\ } } - set paddingMeters 0.02 - set offset [scale $paddingMeters [unitLengthVector $physicalDir]] - set physicalPos [add $physicalPos $offset] - - set dispPosition [$poseLib project $displayIntrinsics $displayWidth $displayHeight $physicalPos] - set dispTopLeft [$poseLib project $displayIntrinsics $displayWidth $displayHeight $topLeft] set dispTopRight [$poseLib project $displayIntrinsics $displayWidth $displayHeight $topRight] set dispTop [vec2 sub $dispTopRight $dispTopLeft] set dispRadians [expr {-atan2([lindex $dispTop 1], [lindex $dispTop 0])}] - Wish to draw text onto $disp with \ - position $dispPosition \ - scale 36.0 radians $dispRadians anchor $textAnchor \ - text $text + dict for {resultOptions texts} $groups { + set text [join $texts "\n"] + set drawOptions [dict create \ + scale 36.0 \ + anchor $textAnchor] + set drawOptions [dict merge $drawOptions $resultOptions] + + set paddingMeters [dict getdef $drawOptions padding 0.02] + set offset [scale $paddingMeters [unitLengthVector $physicalDir]] + set textPhysicalPos [add $physicalPos $offset] + set dispPosition [$poseLib project $displayIntrinsics $displayWidth $displayHeight $textPhysicalPos] + + dict set drawOptions position $dispPosition + dict set drawOptions radians $dispRadians + dict set drawOptions text $text + + Wish to draw text onto $disp with \ + {*}$drawOptions + } } } } -} \ No newline at end of file +} diff --git a/test/drawing-demo.folk b/test/drawing-demo.folk new file mode 100644 index 00000000..abbc0e89 --- /dev/null +++ b/test/drawing-demo.folk @@ -0,0 +1,299 @@ +source builtin-programs/collect.folk + +fn loadProgramForTest {filename} { + set fd [open $filename r] + set code [read $fd] + close $fd + evaluateBlock $code [list [dict create this $filename]] +} + +foreach program { + builtin-programs/draw/space.folk + builtin-programs/title.folk + builtin-programs/draw/line.folk + builtin-programs/draw/dashed-line.folk + builtin-programs/draw/circle.folk + builtin-programs/draw/fill.folk + builtin-programs/draw/arc.folk + builtin-programs/draw/curve.folk + builtin-programs/draw/apriltags.folk + builtin-programs/draw/image.folk + builtin-programs/draw/text.folk + builtin-programs/draw/shapes.folk +} { + loadProgramForTest $program +} + +set fakeQuadLib [library create fakeQuadLib { + proc vertices {quad} { + lindex $quad 1 + } +}] + +set fakePoseLib [library create fakePoseLib { + proc project {intrinsics width height point} { + list [lindex $point 0] [lindex $point 1] + } +}] + +set fakePrintLib [library create fakePrintLib { + proc tagImageForId {id} { + list fake-tag-image $id + } +}] + +fn fakeQuadChange {quad targetSpace} { + list $targetSpace [lindex $quad 1] +} + +fn drawingDemoPointClose {actual expected} { + if {[llength $actual] != [llength $expected]} { return 0 } + foreach av $actual ev $expected { + if {abs($av - $ev) > 1e-9} { return 0 } + } + return 1 +} + +set demo [QueryOne! 45009 has demo code /demoCode/] +evaluateBlock $demo(demoCode) [list [dict create this demo-page]] + +set curveDemo [QueryOne! builtin-programs/draw/curve.folk has demo code /demoCode/] +evaluateBlock $curveDemo(demoCode) [list [dict create this curve-page]] + +evaluateBlock { + Wish $this runs demo code from builtin-programs/title.folk +} [list [dict create this title-page]] + +evaluateBlock { + Wish $this is titled hello + Wish $this is footnoted goodbye + Wish $this is left-margined something + Wish $this is right-margined elsewhere +} [list [dict create this plain-title-page]] + +set disp test-display +Assert! the quad library is $fakeQuadLib +Assert! the pose library is $fakePoseLib +Assert! the quad changer is [fn fakeQuadChange] +Assert! the print library is $fakePrintLib +Assert! display $disp has width 1920 height 1080 +Assert! display $disp has intrinsics test-intrinsics +Assert! demo-page has quad \ + [list page-space {{-0.05 -0.05 0} {0.05 -0.05 0} {0.05 0.05 0} {-0.05 0.05 0}}] +Assert! title-page has quad \ + [list page-space {{-0.05 -0.05 0} {0.05 -0.05 0} {0.05 0.05 0} {-0.05 0.05 0}}] +Assert! plain-title-page has quad \ + [list page-space {{-0.05 -0.05 0} {0.05 -0.05 0} {0.05 0.05 0} {-0.05 0.05 0}}] +Assert! curve-page has resolved geometry {width 0.2 height 0.2} + +sleep 1 + +set errors [Query! /program/ has error /err/ with info /info/] +assert {[llength $errors] == 0} + +set demoWishes [Query! /someone/ wishes demo-page shows the drawing primitives demo] +assert {[llength $demoWishes] == 1} +set demoRunWishes [Query! /someone/ wishes demo-page runs demo code from builtin-programs/draw/space.folk] +assert {[llength $demoRunWishes] == 1} +set titleRunWishes [Query! /someone/ wishes title-page runs demo code from builtin-programs/title.folk] +assert {[llength $titleRunWishes] == 1} +set sourceWishes [Query! /someone/ wishes demo-page is left-margined /text/ with /...options/] +assert {[llength $sourceWishes] == 1} +assert {[dict get [lindex $sourceWishes 0] text] eq {Wish $this shows the drawing primitives demo}} +set sourceOptions [dict get [lindex $sourceWishes 0] options] +assert {[dict get $sourceOptions font] eq "CourierPrimeCode"} +assert {[dict get $sourceOptions anchor] eq {1.0 0.5 0 0.5}} +assert {[dict get $sourceOptions scale] == 18.0} +set titleMarginWishes [Query! /someone/ wishes title-page is left-margined /text/ with /...options/] +assert {[llength $titleMarginWishes] == 2} +foreach {label text} { + titled hello + footnoted goodbye + left-margined something + right-margined elsewhere +} { + set wishes [Query! /someone/ wishes plain-title-page is $label /actualText/ with /...options/] + assert {[llength $wishes] == 1} + assert {[dict get [lindex $wishes 0] actualText] eq $text} + assert {[dict get [lindex $wishes 0] options] eq {scale 36.0}} +} +set curvePageDraws [Query! /someone/ wishes to draw a curve onto curve-page with /...drawOptions/] +assert {[llength $curvePageDraws] >= 1} + +foreach {kind minimum} { + line 2 + dashed 1 + circle 2 + triangle 1 + quad 1 + polygon 2 + arc 1 + curve 1 + text 8 + apriltag 1 + image 1 +} { + switch -- $kind { + line { + set draws [Query! /someone/ wishes to draw a line onto $disp with /...drawOptions/] + } + dashed { + set draws [Query! /someone/ wishes to draw a dashed line onto $disp with /...drawOptions/] + } + circle { + set draws [Query! /someone/ wishes to draw a circle onto $disp with /...drawOptions/] + } + triangle { + set draws [Query! /someone/ wishes to draw a triangle onto $disp with /...drawOptions/] + } + quad { + set draws [Query! /someone/ wishes to draw a quad onto $disp with /...drawOptions/] + } + polygon { + set draws [Query! /someone/ wishes to draw a polygon onto $disp with /...drawOptions/] + } + arc { + set draws [Query! /someone/ wishes to draw an arc onto $disp with /...drawOptions/] + } + curve { + set draws [Query! /someone/ wishes to draw a curve onto $disp with /...drawOptions/] + } + text { + set draws [Query! /someone/ wishes to draw text onto $disp with /...drawOptions/] + } + apriltag { + set draws [Query! /someone/ wishes to draw an AprilTag onto $disp with /...drawOptions/] + } + image { + set draws [Query! /someone/ wishes to draw an image onto $disp with /...drawOptions/] + } + } + assert {[llength $draws] >= $minimum} +} + +set polygonDraws [Query! /someone/ wishes to draw a polygon onto $disp with /...drawOptions/] +set hasThirtyCmFrame 0 +foreach draw $polygonDraws { + set points [dict get [dict get $draw drawOptions] points] + if {[llength $points] == 4 && \ + [drawingDemoPointClose [lindex $points 0] {-0.15 -0.15}] && \ + [drawingDemoPointClose [lindex $points 2] {0.15 0.15}]} { + set hasThirtyCmFrame 1 + } +} +assert {$hasThirtyCmFrame} + +set lineDraws [Query! /someone/ wishes to draw a line onto $disp with /...drawOptions/] +set hasHairline 0 +set hasStroke 0 +foreach draw $lineDraws { + set width [dict get [dict get $draw drawOptions] width] + if {abs($width - 1.5) < 1e-9} { set hasHairline 1 } + if {abs($width - 3.0) < 1e-9} { set hasStroke 1 } +} +assert {$hasHairline} +assert {$hasStroke} + +set dashedDraws [Query! /someone/ wishes to draw a dashed line onto $disp with /...drawOptions/] +set dashedOptions [dict get [lindex $dashedDraws 0] drawOptions] +set dashedWidth [dict get $dashedOptions width] +set dashedLength [dict get $dashedOptions dashlength] +assert {abs($dashedWidth - 3.0) < 1e-9} +assert {abs($dashedLength - 10.0) < 1e-9} + +set textDraws [Query! /someone/ wishes to draw text onto $disp with /...drawOptions/] +set hasTitleScale 0 +set hasTinyScale 0 +set hasSourceMargin 0 +set hasTitleDemoTitle 0 +set hasTitleDemoFootnote 0 +set hasTitleDemoLeftMargin 0 +set hasTitleDemoRightMargin 0 +set hasTitleDemoSourceMargin 0 +set hasPlainTitle 0 +set hasPlainFootnote 0 +set hasPlainLeftMargin 0 +set hasPlainRightMargin 0 +foreach draw $textDraws { + set drawOptions [dict get $draw drawOptions] + set scale [dict get $drawOptions scale] + if {abs($scale - 14.0) < 1e-9} { set hasTitleScale 1 } + if {abs($scale - 9.0) < 1e-9} { set hasTinyScale 1 } + if {[dict getdef $drawOptions text ""] eq {Wish $this shows the drawing primitives demo}} { + assert {[dict get $drawOptions font] eq "CourierPrimeCode"} + assert {[dict get $drawOptions anchor] eq {1.0 0.5 0 0.5}} + assert {abs($scale - 18.0) < 1e-9} + set hasSourceMargin 1 + } + + set text [dict getdef $drawOptions text ""] + if {$text eq "Title demo\ncenter aligned"} { + assert {[dict get $drawOptions font] eq "PTSans-Regular"} + assert {[dict get $drawOptions color] eq "deepskyblue"} + assert {[dict get $drawOptions anchor] eq {0.5 1.0 0.5 1.0}} + assert {[drawingDemoPointClose [dict get $drawOptions position] {0.0 -0.07}]} + assert {abs($scale - 44.0) < 1e-9} + set hasTitleDemoTitle 1 + } elseif {$text eq "Footnote demo\nright aligned"} { + assert {[dict get $drawOptions font] eq "VictorMonoRegular"} + assert {[dict get $drawOptions color] eq "gold"} + assert {[dict get $drawOptions anchor] eq {0.5 0.0 1.0 0.0}} + assert {[drawingDemoPointClose [dict get $drawOptions position] {0.0 0.07}]} + assert {abs($scale - 22.0) < 1e-9} + set hasTitleDemoFootnote 1 + } elseif {$text eq "Left margin\nCourier mono\nleft aligned"} { + assert {[dict get $drawOptions font] eq "CourierPrimeCode"} + assert {[dict get $drawOptions color] eq "mediumspringgreen"} + assert {[dict get $drawOptions anchor] eq {1.0 0.15 0.0 0.0}} + assert {[drawingDemoPointClose [dict get $drawOptions position] {-0.06 0.0}]} + assert {abs($scale - 18.0) < 1e-9} + set hasTitleDemoLeftMargin 1 + } elseif {$text eq "Right margin\nNeomatrix\nright aligned"} { + assert {[dict get $drawOptions font] eq "NeomatrixCode"} + assert {[dict get $drawOptions color] eq "hotpink"} + assert {[dict get $drawOptions anchor] eq {0.0 0.85 1.0 1.0}} + assert {[drawingDemoPointClose [dict get $drawOptions position] {0.06 0.0}]} + assert {abs($scale - 28.0) < 1e-9} + set hasTitleDemoRightMargin 1 + } elseif {[string first {Wish $this is titled} $text] >= 0} { + assert {[dict get $drawOptions font] eq "CourierPrimeCode"} + assert {[dict get $drawOptions anchor] eq {1.0 0.5 0 0.5}} + assert {[drawingDemoPointClose [dict get $drawOptions position] {-0.07 0.0}]} + assert {abs($scale - 18.0) < 1e-9} + set hasTitleDemoSourceMargin 1 + } elseif {$text eq "hello"} { + assert {[dict get $drawOptions anchor] eq "bottom"} + assert {[drawingDemoPointClose [dict get $drawOptions position] {0.0 -0.07}]} + assert {abs($scale - 36.0) < 1e-9} + set hasPlainTitle 1 + } elseif {$text eq "goodbye"} { + assert {[dict get $drawOptions anchor] eq "top"} + assert {[drawingDemoPointClose [dict get $drawOptions position] {0.0 0.07}]} + assert {abs($scale - 36.0) < 1e-9} + set hasPlainFootnote 1 + } elseif {$text eq "something"} { + assert {[dict get $drawOptions anchor] eq "right"} + assert {[drawingDemoPointClose [dict get $drawOptions position] {-0.07 0.0}]} + assert {abs($scale - 36.0) < 1e-9} + set hasPlainLeftMargin 1 + } elseif {$text eq "elsewhere"} { + assert {[dict get $drawOptions anchor] eq "left"} + assert {[drawingDemoPointClose [dict get $drawOptions position] {0.07 0.0}]} + assert {abs($scale - 36.0) < 1e-9} + set hasPlainRightMargin 1 + } +} +assert {$hasTitleScale} +assert {$hasTinyScale} +assert {$hasSourceMargin} +assert {$hasTitleDemoTitle} +assert {$hasTitleDemoFootnote} +assert {$hasTitleDemoLeftMargin} +assert {$hasTitleDemoRightMargin} +assert {$hasTitleDemoSourceMargin} +assert {$hasPlainTitle} +assert {$hasPlainFootnote} +assert {$hasPlainLeftMargin} +assert {$hasPlainRightMargin} + +Exit! 0 From 568eac3f94cae5cb26a1ad08914e8c77ba25c254 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andr=C3=A9s=20Cuervo?= Date: Wed, 6 May 2026 19:12:20 -0400 Subject: [PATCH 4/6] connections: restore quad-based drawing Rewrite connections.folk around quads instead of the old region helpers. Connection endpoints are resolved through quad vertices, projected into the target display, and rendered with the new draw line and fill triangle primitives.\n\nKeep the friendly shorthand wishes for static and dynamic connections while normalizing them into the explicit with from/to option form. Add regression coverage for centroid endpoints, option forwarding, display projection, and dynamic arrowhead placement. --- builtin-programs/connections.folk | 133 ++++++++++++++++++++---------- test/draw-connections.folk | 68 +++++++++++++++ 2 files changed, 159 insertions(+), 42 deletions(-) create mode 100644 test/draw-connections.folk diff --git a/builtin-programs/connections.folk b/builtin-programs/connections.folk index 8efa359a..e8ad439c 100644 --- a/builtin-programs/connections.folk +++ b/builtin-programs/connections.folk @@ -3,67 +3,116 @@ # "Wish $tag is connected to $tag2" or "Wish $tag is dynamically connected to $tag2" When /anyone/ wishes /source/ is connected to /sink/ { - Wish $source is connected to $sink from centroid to centroid + Wish $source is connected to $sink with from centroid to centroid +} +When /anyone/ wishes /source/ is connected to /sink/ from /from/ to /to/ { + Wish $source is connected to $sink with from $from to $to } When /anyone/ wishes /source/ is dynamically connected to /sink/ { - Wish $source is dynamically connected to $sink from centroid to centroid + Wish $source is dynamically connected to $sink with from centroid to centroid +} +When /anyone/ wishes /source/ is dynamically connected to /sink/ from /from/ to /to/ { + Wish $source is dynamically connected to $sink with from $from to $to } -When /anyone/ wishes /source/ is connected to /sink/ /...options/ & \ - /source/ has region /source_region/ & \ - /sink/ has region /sink_region/ { - if {$source == $sink} {return} +fn drawConnectionArrowPoints {center radius radians} { + lassign $center cx cy + set dx [expr {cos($radians)}] + set dy [expr {sin($radians)}] + set spread [expr {$radius * 0.8}] + set baseX [expr {$cx - $dx * $radius}] + set baseY [expr {$cy - $dy * $radius}] + set tip [list [expr {$cx + $dx * $radius}] [expr {$cy + $dy * $radius}]] + set rearLeft [list [expr {$baseX + $dy * $spread}] [expr {$baseY - $dx * $spread}]] + set rearRight [list [expr {$baseX - $dy * $spread}] [expr {$baseY + $dx * $spread}]] + list $tip $rearLeft $rearRight +} - set p1 [dict_getdef $options from centroid] - set p2 [dict_getdef $options to centroid] - set source [region $p1 $source_region] - set sink [region $p2 $sink_region] +fn drawConnectionArrow {disp center radius radians color layer} { + if {$radius <= 0.0} { return } + lassign [drawConnectionArrowPoints $center $radius $radians] p0 p1 p2 + Wish to draw a triangle onto $disp with \ + p0 $p0 p1 $p1 p2 $p2 color $color layer $layer +} - set direction [vec2 sub $sink $source] - set color [dict_getdef $options color grey] - set layer [dict_getdef $options layer 0] +When the draw space library is /drawSpaceLib/ &\ + the quad library is /quadLib/ &\ + the pose library is /poseLib/ &\ + the quad changer is /quadChange/ &\ + display /disp/ has width /displayWidth/ height /displayHeight/ &\ + display /disp/ has intrinsics /displayIntrinsics/ &\ + /anyone/ wishes /source/ is connected to /sink/ with /...options/ &\ + /source/ has quad /sourceQuad/ &\ + /sink/ has quad /sinkQuad/ { + if {$source eq $sink} { return } + fn quadChange - set c [vec2 scale [vec2 add $source $sink] 0.5] - set angle [expr {atan2(-[lindex $direction 1], [lindex $direction 0]) - 3.14159/2}] + set p1 [$drawSpaceLib quadPoint $quadLib \ + [quadChange $sourceQuad "display $disp"] \ + [dict getdef $options from centroid]] + set p2 [$drawSpaceLib quadPoint $quadLib \ + [quadChange $sinkQuad "display $disp"] \ + [dict getdef $options to centroid]] + set from [$drawSpaceLib project $poseLib $displayIntrinsics $displayWidth $displayHeight $p1] + set to [$drawSpaceLib project $poseLib $displayIntrinsics $displayWidth $displayHeight $p2] - Wish to draw a stroke with points [list $source $sink] width 2 color $color layer $layer - Wish to draw a shape with sides 3 center $c radius 30 radians $angle color $color filled true layer $layer + set direction [$drawSpaceLib vectorSub $to $from] + if {[$drawSpaceLib vectorDistance $to $from] == 0.0} { return } + set color [dict getdef $options color grey] + set layer [dict getdef $options layer 0] + + set c [$drawSpaceLib vectorMidpoint $from $to] + set angle [expr {atan2([lindex $direction 1], [lindex $direction 0])}] + + Wish to draw a line onto $disp with \ + points [list $from $to] width 2 color $color layer $layer + drawConnectionArrow $disp $c 30 $angle $color $layer } set speed 75 set spacing 50 set maxsize 25 -When /anyone/ wishes /source/ is dynamically connected to /sink/ /...options/ & \ - /source/ has region /source_region/ & \ - /sink/ has region /sink_region/ { - - if {$source == $sink} {return} +When the draw space library is /drawSpaceLib/ &\ + the quad library is /quadLib/ &\ + the pose library is /poseLib/ &\ + the quad changer is /quadChange/ &\ + display /disp/ has width /displayWidth/ height /displayHeight/ &\ + display /disp/ has intrinsics /displayIntrinsics/ &\ + /anyone/ wishes /source/ is dynamically connected to /sink/ with /...options/ &\ + /source/ has quad /sourceQuad/ &\ + /sink/ has quad /sinkQuad/ { - set p1 [dict_getdef $options from centroid] - set p2 [dict_getdef $options to centroid] - set source [region $p1 $source_region] - set sink [region $p2 $sink_region] + if {$source eq $sink} { return } + fn quadChange - set direction [vec2 normalize [vec2 sub $sink $source]] - set distance [vec2 distance $sink $source] - set angle [expr {atan2(-[lindex $direction 1], [lindex $direction 0]) - 3.14159/2}] + set p1 [$drawSpaceLib quadPoint $quadLib \ + [quadChange $sourceQuad "display $disp"] \ + [dict getdef $options from centroid]] + set p2 [$drawSpaceLib quadPoint $quadLib \ + [quadChange $sinkQuad "display $disp"] \ + [dict getdef $options to centroid]] + set from [$drawSpaceLib project $poseLib $displayIntrinsics $displayWidth $displayHeight $p1] + set to [$drawSpaceLib project $poseLib $displayIntrinsics $displayWidth $displayHeight $p2] - set color [dict_getdef $options color white] - set layer [dict_getdef $options layer 0] + set direction [$drawSpaceLib vectorSub $to $from] + set distance [$drawSpaceLib vectorDistance $to $from] + if {$distance == 0.0} { return } + set direction [$drawSpaceLib vectorScale $direction [expr {1.0 / $distance}]] + set angle [expr {atan2([lindex $direction 1], [lindex $direction 0])}] - lassign [vec2 scale [vec2 add $source $sink] 0.5] cx cy + set color [dict getdef $options color white] + set layer [dict getdef $options layer 0] - Wish to draw a stroke with points [list $source $sink] width 1 color $color layer $layer - - When the clock time is /t/ { - set offset [expr {round($t*$speed) % $spacing}] - set count [expr {round($distance / $spacing)}] + Wish to draw a line onto $disp with \ + points [list $from $to] width 1 color $color layer $layer - for {set p $offset} {$p < $distance} {incr p $spacing} { - set c [vec2 add $source [vec2 scale $direction $p]] - set s [expr {min($maxsize, 0.20*min($p, $distance - $p))}] - Wish to draw a shape with sides 3 center $c radius $s radians $angle color $color filled true layer $layer - } + When the clock time is /t/ { + set offset [expr {round($t*$speed) % $spacing}] + for {set p $offset} {$p < $distance} {incr p $spacing} { + set c [$drawSpaceLib vectorAdd $from [$drawSpaceLib vectorScale $direction $p]] + set s [expr {min($maxsize, 0.20*min($p, $distance - $p))}] + drawConnectionArrow $disp $c $s $angle $color $layer + } } } diff --git a/test/draw-connections.folk b/test/draw-connections.folk new file mode 100644 index 00000000..f39a9265 --- /dev/null +++ b/test/draw-connections.folk @@ -0,0 +1,68 @@ +source builtin-programs/collect.folk +source builtin-programs/draw/space.folk + +set fakeQuadLib [library create fakeQuadLib { + proc vertices {quad} { + lindex $quad 1 + } +}] + +set fakePoseLib [library create fakePoseLib { + proc project {intrinsics width height point} { + list [lindex $point 0] [lindex $point 1] + } +}] + +fn fakeQuadChange {quad targetSpace} { + list $targetSpace [lindex $quad 1] +} + +source builtin-programs/connections.folk + +set points [drawConnectionArrowPoints {5 1} 2 0] +lassign [lindex $points 0] x y +assert {abs($x - 7.0) < 1e-9} +assert {abs($y - 1.0) < 1e-9} +lassign [lindex $points 1] x y +assert {abs($x - 3.0) < 1e-9} +assert {abs($y + 0.6) < 1e-9} + +set disp test-display +set source source-page +set sink sink-page + +Assert! the quad library is $fakeQuadLib +Assert! the pose library is $fakePoseLib +Assert! the quad changer is [fn fakeQuadChange] +Assert! display $disp has width 100 height 100 +Assert! display $disp has intrinsics test-intrinsics +Assert! $source has quad \ + [list source-space {{0 0 0} {2 0 0} {2 2 0} {0 2 0}}] +Assert! $sink has quad \ + [list source-space {{10 0 0} {12 0 0} {12 2 0} {10 2 0}}] +Wish $source is connected to $sink with color cyan layer 4 + +sleep 1 + +set errors [Query! /program/ has error /err/ with info /info/] +assert {[llength $errors] == 0} + +set lineDraws [Query! /someone/ wishes to draw a line onto $disp with /...drawOptions/] +assert {[llength $lineDraws] == 1} +set drawOptions [dict get [lindex $lineDraws 0] drawOptions] +assert {[dict get $drawOptions points] eq {{1.0 1.0} {11.0 1.0}}} +assert {[dict get $drawOptions width] == 2} +assert {[dict get $drawOptions color] eq "cyan"} +assert {[dict get $drawOptions layer] == 4} + +set triangleDraws [Query! /someone/ wishes to draw a triangle onto $disp with /...drawOptions/] +assert {[llength $triangleDraws] == 1} +set drawOptions [dict get [lindex $triangleDraws 0] drawOptions] +assert {[dict get $drawOptions color] eq "cyan"} +assert {[dict get $drawOptions layer] == 4} +foreach key {p0 p1 p2} { + assert {[llength [dict get $drawOptions $key]] == 2} +} +assert {[dict get $drawOptions p0] eq {36.0 1.0}} + +Exit! 0 From ce8c2924c5963c971273f70c2a4946fc178a7170 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andr=C3=A9s=20Cuervo?= Date: Wed, 6 May 2026 19:12:34 -0400 Subject: [PATCH 5/6] draw/text: honor block anchors for aligned lines Fix four-value text anchors so the block anchor places the whole text block and the line anchor only aligns each line inside that block. Previously the X offset subtracted the block offset again, so a left-aligned source-code block anchored on its right edge started at the margin point and spilled into the page.\n\nAdd a glyph-level regression test that draws multi-line Courier text with anchor {1.0 0.5 0.0 0.5} and checks the generated glyph instances stay to the left of the anchor point. --- builtin-programs/draw/text.folk | 6 ++-- test/draw-text-anchor.folk | 63 +++++++++++++++++++++++++++++++++ 2 files changed, 67 insertions(+), 2 deletions(-) create mode 100644 test/draw-text-anchor.folk diff --git a/builtin-programs/draw/text.folk b/builtin-programs/draw/text.folk index eb1e04f8..71926516 100644 --- a/builtin-programs/draw/text.folk +++ b/builtin-programs/draw/text.folk @@ -113,8 +113,10 @@ $cc proc textShape {Jim_Obj* viewport Jim_Obj* surfaceToClip ch = charOrFallback(font, ch); GlyphInfo* glyphInfo = &font->glyphInfos[ch]; if (ch != ' ') { - // Calculate the absolute glyph position. - float lineOffsetX = -(lineAnchorX * lineWidth) - blockOffsetX; + // Calculate the absolute glyph position. The block anchor places the + // text block relative to the requested position; the line anchor then + // aligns each individual line inside that block. + float lineOffsetX = lineAnchorX * (extent.x - lineWidth); // `lineOffsetY` doesn't exist, since it's already included in the `blockOffsetY` calculation. vec2f rotatedLineOffset = vec2f_rotate((vec2f) { lineOffsetX, 0 }, radians); vec2f combinedOffset = vec2f_add(blockStart, rotatedLineOffset); diff --git a/test/draw-text-anchor.folk b/test/draw-text-anchor.folk new file mode 100644 index 00000000..b53e9d04 --- /dev/null +++ b/test/draw-text-anchor.folk @@ -0,0 +1,63 @@ +source builtin-programs/collect.folk +source builtin-programs/image/image-lib.folk +source builtin-programs/draw/color-map.folk +source builtin-programs/draw/text.folk + +When the image library is /imageLib/ { + fn fakeLoadImage {path} { + $imageLib imageNew 8 8 4 1 + } + Claim the image loader is [fn fakeLoadImage] +} + +When /someone/ wishes the GPU loads image /im/ as texture { + Claim the GPU has loaded image $im as texture 17 +} + +fn drawTextAnchorBounds {instances} { + set minX 1000000.0 + set maxX -1000000.0 + foreach instance $instances { + foreach point [list \ + [lindex $instance 4] \ + [lindex $instance 5] \ + [lindex $instance 6] \ + [lindex $instance 7]] { + set x [lindex $point 0] + if {$x < $minX} { set minX $x } + if {$x > $maxX} { set maxX $x } + } + } + dict create minX $minX maxX $maxX +} + +Assert! text-page has canvas canvas-id with width 400 height 300 +Assert! text-page has canvas projection {1 0 0 0 1 0 0 0 1} + +set fonts [list] +for {set i 0} {$i < 100 && [llength $fonts] == 0} {incr i} { + sleep 0.1 + set fonts [Query! the GPU has font CourierPrimeCode with data /fontData/] +} +assert {[llength $fonts] == 1} + +Wish to draw text onto text-page with \ + position {100 100} \ + scale 10.0 \ + font CourierPrimeCode \ + anchor {1.0 0.5 0.0 0.5} \ + text "A\nAA" \ + color white + +set draws [list] +for {set i 0} {$i < 100 && [llength $draws] == 0} {incr i} { + sleep 0.1 + set draws [Query! /someone/ wishes the GPU draws pipeline "glyph" onto canvas canvas-id with instances /instances/ layer /layer/] +} +assert {[llength $draws] == 1} + +set bounds [drawTextAnchorBounds [dict get [lindex $draws 0] instances]] +assert {[dict get $bounds minX] < 95.0} +assert {[dict get $bounds maxX] < 101.0} + +Exit! 0 From 016c83eaed4afe73497f58ce8d958dbb05b4c8ca Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andr=C3=A9s=20Cuervo?= Date: Wed, 6 May 2026 20:31:57 -0400 Subject: [PATCH 6/6] draw/image: make Folk logo URL work offline The live Folk machine may not have a public internet route, so fetching https://folk.computer/_media/logo.png can fail even though the URL is valid elsewhere. Bundle the small logo asset and resolve that well-known Folk media URL locally before falling back to curl.\n\nAlso harden URL downloads: preserve a useful extension for loader matching, write through a temporary file, reject empty downloads, and avoid leaving poisoned cache files behind after curl failures. Add a regression test for Wish displays image "https://folk.computer/_media/logo.png". --- assets/logo.png | Bin 0 -> 7111 bytes builtin-programs/draw/image.folk | 47 +++++++++++++++++++++++++++++-- test/draw-image-url.folk | 32 +++++++++++++++++++++ 3 files changed, 76 insertions(+), 3 deletions(-) create mode 100644 assets/logo.png create mode 100644 test/draw-image-url.folk diff --git a/assets/logo.png b/assets/logo.png new file mode 100644 index 0000000000000000000000000000000000000000..a14866a126e31c262e7bdc3e2b8f9f7d4cbcb3c8 GIT binary patch literal 7111 zcmZ{JbySpV*Z0sJiZn=<#LzKxHw+9)2m->;3|%5aN=SqB&>)@CjkF-$(jzS(NS803 z^L*z$-?yIczSni_-@W(#?O6Nz<67&E0Bb1|;8NiN000726$RY~`Da0}F&}n(XRs6i zfZ|~*FAuhtSC)5jaB_t>n_EB?Y~7q4%zeND004WuM_jvl5BN!+cA4%tD4dX%hCf1n zdJ@;u#fI~VBCj4s86+K!(Md-#L;Bqy^^B0 z$hb1Fc_)f+Yc}qp22*mLqq6TN$7}Q!)K9m3_YDrqf|Od-7Uyx{-ru$E|C%^k(GEA% zZ1p5w&^AsPnapGlrBmIlPRmA9lC8x@BsoUntgt-gv*Fk%U27X22%6%_ z7SBquL|i5tOyb&wHmPzIiJ!j3N_h{hs1KfB$)3?q>7&`x88IherFak42}H+O_rINr zk&fYZ)i(q4#G-P2QBZwEQrr7$JlFg&zYDhPUR;ygKAfoHX2{X;h&0vFc@(&~D2FDR znVUHCZP6Q@f(iiJ(-6{A-pf7Ta_zdo;Y~#iJ!1c4zV(^G%hw-&$9MhK0{?dXRr0*PrbliJF7@kB4p!+CLcb$9MC22GT@P4kZCd3YJ6aOvskC0s47K)MP_|Div8Niy2FyE}t` zKrb&Z9xnkNCs%7ApO}~!ke46G&(Hnf!R_V)b2sq~_y77E{?`ou z*8Yp}r&18u)*I?zs9@^|g}MEyi(lxWuK#NJuS|n~F$Kl`&HR_;KTHYWpIQ8CHh&NP zFYUwRrEn#H|C}NzT&@F}hXYBDuc{!c=Z$h;g6B>%<8!~=+?sG37gZCDVi6n>?GQ}Y zw^mmorm6-BXITWH$otgUs^o-(FxQDXGVTcra@1+5>@f?n2=>wB%>v)6W@H7^)5zfp zUos#P(y78xIvu%e>jlK!Zv4CiPweW;mXqodM8oWlMn^~dZZBGY|6culf59NH#6zK0 zPcb=b^(A-c%cX&R+{-#UTfWV7M}pTGQ?<)m-^YpA*4n8+URWI>JL6TICE_XDB>wqG9m+|1~z8I*Mkg)*j7b2WE zOSCpwV(95Mt9%b`d0%zc$A)M|nt}nAQ@P{dpN?&BMv3cZYNq`uqGQ{iq7^-%f-It< z0g=`{J{7oe%plCT0L%kTeN4kEdHQpP#{Nn)-Hjr&fR6#`Ayir67XfH0y3c|%M3l1k zl<2{Tc&tf&%+9n$cZZ(3#4fz~>&$K(%QKRinTyPRZs{1ep+auBFwLAf#))e9&y!7^ zvNCe1-OGsJxia3{sEledV)`mh^@-`%n8jRAq{=t*qrh^4gs$~mJxcizGNj({CW52c zmR~$Z+U+GqfHVCUa_#3cQ}QV82G8Uwhe?qmm0SBctuNT@%9~N+_tmg!R08z}flQAX zVagVTc3gOwsh7(Ov>(lvEXG!E**Uz|-}Q}d^nI)CVK|h>OfdE~jOD-ZtT15Ab;(Yw zmC6B_d5NH>8)F?(KiYXu8YG1)Sgbc$TLQT|%ppMdhWSn;lczB^686=ypS@L)c~)0k zW0^4~$1k2S*VS?5#%8Y8!Xz#X7^#v(d1s|Lv(PX{%RVL8xxqDG7dqj(pO9USxRFJ{ zS%wYbMLGr*FX|(dz-nU1Div$eeN!{mwhNd_oh2D{!*(-RtkSn!Y7-(JZS| zQ92xFq-Z5)=KE@im>!R!;mJkd)%gms|;5#;Up8N77XQxfQnmAP8_ z{gykH6C?PQk@<-I%bXv1&r0i_`l&=xaPxli6!9Ca`Pv!WkxPkWVha1vju$+J5`Z+S zmY?B1yw%*tM6+6uNgzSKIPntp|60j+^aFIrAyKd{(ULg?eo53qqG2|p;mop+QI^@S zd0{4sx1Wb`#u+Ox%&%A{y1JYvdjz-b1GSE}2>309E#%O(x5`>Fjeiu1uHFwJU&Prj zOEb~*FC5qfo5$Pgw-kQaPA{G52?8YnKgPa+Ylls;N#f2hd~S4K&nFGGJZESN zBUaPLE;OB5GkTS>nvmMLdFZN{FL!lTV!D**0~A>$l&mG&&_JdmmVn&uAJHXa-qql< z+D1~hYeVy?3B}}3cam3W?<2&Wkc}4jxV;B{(?n4#BA1W8y{LYaVKOj3KeG#A<5%l+ ze|vl6hy@*L!{PT+d)&j%;>;5@6u^*QJ%MH8u;<5=R2xN)T~)V`k-{7Oeov)V@SyiF zr4mHPQyO-MkBOx-p!+22sNv~{o&kxP^)wDD+b6j~6SYzj8m9NNuQb^ZG<~9pO(BL+ zqe0`|1_!oMVdv244Dw1D*`74q3*4miH5=EB*7ahI2t$%GdF*+bQ?{t25){ksvX2 z@u~DRpY=Bquawx7L!v8nvY)&=dAQ(FbA4*veJTR|O{v87l(B^`+J%rIT#c3Msw$f{ zx%28CzPm$~wrHl-gO2wqE8MxCWpEQCA(2|-cSoD?hJh4jX+eBohdNd?eun<};h0_L zw&@DL3H)YGI|ZgfotA4BFaUgh1bS7}$y#GJoMPdTLf2?&rx+hf^4Z?0gJO1O>=T@b z1>=9rKslCNO=+u#olxgR~J{Q%*hbtiZ3}KE?mW$%Ir8j zunE4KQ8i3Er=8eG9+iTLPl9s}xK4O$W?+LoRZreZ?l7c#TKBVV2uIA`PK|Z;Af?}Jzu*{EqmkJEO?7S}?{8i3+fecbNOP{`S99f@ zDpQ{dh}+Uee*{0gjmhL^#4M{K*(fd0T0>LK+PXnhM9Hu=eF0rUxr1&cOgY5`Th;kE zNO5-@E61RqJtZ9$#Q9_LR2;6;PGQ}pD-n=%jD}yM&@!Y$0S?apoRO_c@KLiVoXyVhLo(%f{elHDh;TA%unnv>7!od7TuQ z4N(tN%{jae!fy=8szSg^$yK@)NT)85{32$j{H?9x1==;`>!u^C-!UIAMyT;}nJxm{ z(0tD8-qL7ymT#oQ?hXwRR4#ScB^cinwQja>?m_Rbko4T+-}*pFlcxr2uU9Kvwk{9O zMEI^793y>MS}v3=56kOrO;#!rP)>BDbwD==3SK&f4Ykpa=a>wy=`bsdX~U zEi-PhlUDaP3{a4_R~Krok3l;kEMoKZ*aqX$VJp0dlCOj9Aio{?=m_7QrnVhv=Y>;*r*F`?r3F&}H!W-}FWDB0*fn`lVlf)|WWABA%lijVFcQ5-glkd}Q;*cdpwa z&GVhpy~6+H`veh?;lK6dC94dnW$v&YMEH&V2S`w)4bW9jx974jpNM*0Pl3iphK7-z zPb8+0r3oYQHFHxnb*SLyxZV~1EHhJO{E4UJAgWh^*=zQ;djw|+)zl6BNywVejdlNnx zz*MthJt*nQf*x$lb%|@gw?=s~)2Bj(Vw<|fQXQuxG~Qp3%F3{%POgy~`LS zhS32HQ*4~a#!N_hrz@n(>DvEaW$g%UW=(+Bb zi_vzX(%)#{&&SloeOzCpj(=6xv~rFQPQ7v!dAY z*(2xdPaC@a?oP2@WD#$r%J(e(xVk;2*=?S`TuI5sLJeQZ5z+?pXedDy>+v86qh%9y zn^tJ0@~E)OqOg}K42uZam4Rppe3cp9Sd>M#+vh`JK4T7_&cufAO$^J-m7)sEY#E5q zJQgRVnsO*#m(uJ}_MuXwK<1T@h)KqEg>~A_;y;_~!YEk2&og;gv&YMe=LW{Q?!n3Sb92#gx%PAAj0+uAG-f+~CoxOiNtc0{n0ciF#E1 z83lpo5;Hza{i@p&yBrLL$JDWT%a6K6TfqGmjxEz_f$8X=7@XoRt7!beL>Tg&P{2J0Mo!C9f<#-eHd_abRMBzgqT0wV63a#v*!p?A zz#f2=kwLvyLbnCPUr3~=Eu@%nVq1MK9ZQ-HJC)@@h{vCvVvg$k%EWBA*d2$D<2dk- z44UvJKKok~jd zLXeX`9S?{(8fLC=eso%$y2o&LBJ#~$I=>S=GT?Gt6%=dLQtQ-0NTy%&jnb07=GGbB zf{5$<*oF|?>}4P@K2fII=DY!Y$JP?<;$v8pV~?$c7or>BIP`p8*rqtdygM)1q+%mr zR>01e|4}8@c!nMtOEhml8cNKKev~o?Ad<<%B<^+FK{C63ui^r!iQgsHCRDlGoxVei0qFlq{&b~UEeC&}P zF*);o^+?}Uk+M1N_4VLvr6w}Tjqw) z03~1N{R6r01GHv0%X-T#;cHovs!b6J)Y7Nja%*2&u3i!bM9zYKf`iH4y!%3E{3+9! zV4<;79cIujzlBKr&E71)l># zak%Ff8lcM-Bk)Vw_9PzbpLx(ry{t!{VbNYybGfhp7YXVmj4Q6?V948=*YZ`A+0wp< z+x=BwLRbS$g0HkRt^E);x9*QzW&Su$vB9P*r1cP1^7Q^PL3}m|jb2*E&}+W3gThbZ zOIMLy(bO!5`Wx4$D35)VTPD33k&UKjlt1@LY{Z3m29gzZ)*@|kZR)m(TGeU{PXw=` z`_A61Gz)0Dg^DpSrZI>VE&1MCg(DTcCcI$jmp-uDOUf#Y6NF^`3-umVhcu+Gmi7k{ z1Fvb#qYPn3B%YCLc9d}Y)<>X1R&PG7lh-e=8q$r#dD>wY@9rz7_K%Ms`QJ>X7|2cU zq)*nNsynK%EIt0*(IARI+@()wvHO|oGWGtSg6a;YQrW!BZ`mG)O5A^7YczSuW)BnB z_j+#`^cw&D`GtM8`0UYX=Qhv0t6P+&)Uuyw?M30?2Q1%5#fKH2bByHY8g`~vv zZ7pXkr^L|@qaP)z=CyFD^M>hN#dGFLGxakvL04&ZVm)pI5eV*DW$d-7Ct10zborV- z2ozq2LHwyols00_&d#N)Xhkhi`Hi&M<%Wvgd?ea~w1h7zLl=aZ)vdt}N}#Wsl$ z1X09VF$%`(Z|Turk5t8OMyRr+F|}wodF7}8%#L5Q#)VuE91tyao9po~n`P3uqKo$} z8{zyJ`CL5-_R-J^+pp0|kqynh$g^8^Z01!Lby}|g5MF~sbWZ|IQ`5OKQ!1vN<_*_$ z$^&lP5B6$$!VnN~ z#nHY~>Q&-y?up)^W-d~W-f_*;>Vm`zmYNDuP!N~VH#%(l`WtY5Z&fN~jus8K4%>Yn zkfY91{*IH&j#|^7#5~6&PcbMdvtnX zmk95i@~pdcCn51~Rkzm>0#h>AT_^-4%faErZJC_2;`O6KyB1ktMKHM90fm`nzgdnA zMA`M`_~y4+kwb@n%t#RKGiUtZuzYgkPA2a`lj>b16aQ(fnJ>^&xX=%w!JGD7pBw=& zHx=!vQCY1?HzrxgoP=JbcJa9IexfHcjD2M~(f`($pd~*S#F)~LQssxZK)%UbP{w(E z+Q!2FdqYLBvdER=F$0_?TdB|2Nq>q-E85Rvu116GrTUI8#{#{Jl*PK*F>CQ99hQ5Z zs9;HVeQ@Fe-6A=xBMaCx5a($@W1C~Y0Qji_3>q3)y2_|J*1ldXO-rrL{UF9>I01I0 z4^rBo)xUh)`_#%3=nzD5;85hhY9_<{73yYb+`aVT#8YUMkbKqXaG-xngYE`vf$}-R z8gUW+YUqP#4YhEsROKVuZti5Mlekj|Vi?(*x+VMEsNQVQ9YsqMGv%XKRnrJ=6jmmc zz0x)MomGoRIYgI)Tu8XGoVQ7*72D^Y@^sx^l;R##c!Kg!O( z=#n!Cl;&SK@|*)z`j8NDXelq*28s{ApmoW5-l0p5ImCPqMhT4+wMS-WS}r>-X2|<< zIc#?)OEc3O+TgSLTYsyv`+VPB56kq6xriCV;fk8zdZh)y~ik z^>e>e@q*EMOQ-T$(i^g$eN+)Y#RV16c0SLj*YzruS;oxxv~u)w*LKKGTI`3J0$noy za50zUi}4k;ZU*~r^`dim0=^W_tSiJj?xifYh+6XHkyL!Bl^S$p&wLFylfKpN6>=8& zCi`)kbqr}5Le9DmMcc5ivHYu11CrN~Tnf%Z*32}rHGnn;oZPHNr2PF$1k1fpPvh&~49{#Mb7kO_;--U$-h zh~0>)CPF~7l*!0BzO<( zPN~?T_Q;soaCacSsj)jpvasvUM01!o-9{-l1ua;KX1bRU=hch*&A6SaFtb$EIA=!V zc>XvF9bO?z3SkFehJPi7zHs0iWdQYaaoGKo;0VEJP_%TUTLhqdWwlB6c!mHlLX4Py zlASX)X*2KZCJ=2<^HT4^QM^BO5SoaNPBF7Xlm7hUZ_uQCNK(bHsFgIWRZ~a-90#VvBS02G(!@N?MAZ? zGthRtj6}YtT=sfiY$NU258P@W03PK^E$#k6Ol4(b6IhsssYB_UK4n7>&g+X%E}Z*~ Z^+`@ACGa@}`sa^}s-l)crJPyN{{Tqi0l5GG literal 0 HcmV?d00001 diff --git a/builtin-programs/draw/image.folk b/builtin-programs/draw/image.folk index 6f932b60..cca71ab2 100644 --- a/builtin-programs/draw/image.folk +++ b/builtin-programs/draw/image.folk @@ -35,6 +35,45 @@ When the gif library is /gifLib/ { When the collected results for {/loader/ is an image loader} are /loaders/ { + fn imageUrlCachePath {url} { + set cleanUrl [regsub {[?#].*$} $url ""] + set ext [file extension $cleanUrl] + set cachePath /tmp/[regsub -all {\W+} $url "_"] + if {$ext ne "" && ![string match "*$ext" $cachePath]} { + append cachePath $ext + } + return $cachePath + } + + fn imageUrlLocalFallback {url} { + if {[regexp {^https?://folk[.]computer/_media/logo[.]png([?#].*)?$} $url]} { + set path [file join [pwd] assets logo.png] + if {[file exists $path]} { return $path } + } + return "" + } + + fn imageDownloadUrl {url} { + set path [imageUrlCachePath $url] + if {[file exists $path] && [file size $path] > 0} { + return $path + } + + file delete -force $path + set tmp "$path.[pid].tmp" + try { + exec curl -fsSL --connect-timeout 10 --retry 2 -o $tmp $url + if {![file exists $tmp] || [file size $tmp] == 0} { + error "Downloaded empty image from $url" + } + file rename -force $tmp $path + } on error {e opts} { + file delete -force $tmp + return -options $opts $e + } + return $path + } + # Pass coerceToImage = 0 if the caller is willing to handle a Gif # object, not just a normal Image. fn loadImage {im {coerceToImage 1}} { @@ -45,9 +84,11 @@ When the collected results for {/loader/ is an image loader} are /loaders/ { set impath $im if {[string match "http*://*" $impath]} { - set im /tmp/[regsub -all {\W+} $impath "_"] - if {![file exists $im]} { - exec curl -s -L -o$im $impath + set fallback [imageUrlLocalFallback $impath] + if {$fallback ne ""} { + set im $fallback + } else { + set im [imageDownloadUrl $impath] } } set path [expr {[string index $im 0] eq "/" ? diff --git a/test/draw-image-url.folk b/test/draw-image-url.folk new file mode 100644 index 00000000..e637dc5e --- /dev/null +++ b/test/draw-image-url.folk @@ -0,0 +1,32 @@ +source builtin-programs/collect.folk +source builtin-programs/image/image-lib.folk +source builtin-programs/image/png-lib.folk +source builtin-programs/draw/color-map.folk +source builtin-programs/draw/image.folk + +When /someone/ wishes the GPU loads image /im/ as texture { + Claim the GPU has loaded image $im as texture 99 +} + +Assert! image-page has resolved geometry {width 0.2 height 0.1 left 0.2} +Assert! image-page has canvas canvas-id with width 400 height 300 +Assert! image-page has canvas projection {1 0 0 0 1 0 0 0 1} + +Wish image-page displays image "https://folk.computer/_media/logo.png" + +sleep 1 + +set errors [Query! /program/ has error /err/ with info /info/] +assert {[llength $errors] == 0} + +set loads [Query! /someone/ wishes the GPU loads image /im/ as texture] +assert {[llength $loads] == 1} + +set draws [Query! /someone/ wishes the GPU draws pipeline "image" onto canvas canvas-id with arguments /arguments/] +assert {[llength $draws] == 1} + +set arguments [dict get [lindex $draws 0] arguments] +assert {[lindex $arguments 2] == 99} +assert {[lindex $arguments 3] eq {0 0}} + +Exit! 0