From 69148a9150dda25061e58b0e4f1d24b570939b06 Mon Sep 17 00:00:00 2001 From: Omar Rizwan Date: Thu, 5 Oct 2023 21:20:11 -0400 Subject: process: Allow running multiple On process blocks on process Turn off share wishes/claims default for subprocesses, so you (for now) have to explicitly specify sharing if you want any to happen. On process now only spawns process if it doesn't exist but always runs the code block (which now happens through a statement instead of directly on init). --- virtual-programs/apriltags.folk | 16 ---------------- virtual-programs/camera.folk | 3 +++ virtual-programs/display.folk | 10 ++-------- 3 files changed, 5 insertions(+), 24 deletions(-) (limited to 'virtual-programs') diff --git a/virtual-programs/apriltags.folk b/virtual-programs/apriltags.folk index 7e190a5b..b23f2bdc 100644 --- a/virtual-programs/apriltags.folk +++ b/virtual-programs/apriltags.folk @@ -6,18 +6,10 @@ set tagfamily "tagStandard52h13" set mainDetectorProcess [On process { source pi/AprilTags.tcl - # TODO: Clean this up. We retract these so that we don't bounce - # statements back to the main Folk process that it sends us. - Retract /anyone/ wishes $::thisProcess shares all wishes - Retract /anyone/ wishes $::thisProcess shares all claims Wish $::thisProcess receives statements like \ [list /someone/ claims the camera frame is /grayFrame/ at /timestamp/] - Wish $::thisProcess shares statements like \ - [list /someone/ wishes /process/ receives statements like /pattern/] Wish $::thisProcess shares statements like \ [list /someone/ claims /process/ detects tags /tags/ at /timestamp/ in time /aprilTime/] - Wish $::thisProcess shares statements like \ - [list /someone/ claims $::thisProcess has pid /pid/] set detector [AprilTags new $tagfamily] When the camera frame is /grayFrame/ at /timestamp/ { @@ -33,18 +25,10 @@ set mainDetectorProcess [On process { On process { source pi/AprilTags.tcl - # TODO: Clean this up. We retract these so that we don't bounce - # statements back to the main Folk process that it sends us. - Retract /anyone/ wishes $::thisProcess shares all wishes - Retract /anyone/ wishes $::thisProcess shares all claims Wish $::thisProcess receives statements like \ [list /someone/ claims the camera frame is /grayFrame/ at /timestamp/] Wish $::thisProcess receives statements like \ [list /someone/ claims $mainDetectorProcess detects tags /tags/ at /timestamp/ in time /aprilTime/] - Wish $::thisProcess shares statements like \ - [list /someone/ wishes /process/ receives statements like /pattern/] - Wish $::thisProcess shares statements like \ - [list /someone/ claims $::thisProcess has pid /pid/] Wish $::thisProcess shares statements like \ [list /someone/ claims $::thisProcess detects tags /tags/ at /timestamp/ in time /aprilTime/] Wish $::thisProcess shares statements like \ diff --git a/virtual-programs/camera.folk b/virtual-programs/camera.folk index 0e1710e7..46daa52e 100644 --- a/virtual-programs/camera.folk +++ b/virtual-programs/camera.folk @@ -15,6 +15,9 @@ set width $::Camera::WIDTH set height $::Camera::HEIGHT On process { + Wish $::thisProcess shares statements like \ + [list /someone/ claims the camera /...anything/] + source pi/Camera.tcl Camera::init $width $height diff --git a/virtual-programs/display.folk b/virtual-programs/display.folk index f7b70959..47ed3d7e 100644 --- a/virtual-programs/display.folk +++ b/virtual-programs/display.folk @@ -405,18 +405,12 @@ On process { proc end {} { Gpu::drawEnd; Gpu::poll } } - # TODO: Clean this up. We retract these so that we don't bounce - # statements back to the main Folk process that it sends us. - Retract /anyone/ wishes $::thisProcess shares all wishes - Retract /anyone/ wishes $::thisProcess shares all claims - Wish $::thisProcess shares statements like \ - [list /someone/ wishes /process/ receives statements like /pattern/] - Wish $::thisProcess shares statements like \ - [list /someone/ claims $::thisProcess has pid /pid/] Wish $::thisProcess receives statements like \ [list /someone/ wishes display runs /command/ on layer /layer/] Wish $::thisProcess receives statements like \ [list /someone/ wishes display runs /command/] + Wish $::thisProcess receives statements like \ + [list /someone/ wishes display runs program /program/] Wish $::thisProcess shares statements like \ [list /someone/ claims the display time is /displayTime/] -- cgit v1.2.3 From f4356b98d2041d8188ae61d1025a98db7becdee0 Mon Sep 17 00:00:00 2001 From: Omar Rizwan Date: Fri, 6 Oct 2023 17:41:15 -0400 Subject: display: WIP: Refactor into files; use wishes, not Display:: Expose shader stuff to user programs for the first time. Mostly works, but display thread and main thread run much slower (28fps display, 70fps main). Also introduce dict getwithdefault (helpful for rest options). --- .../_archive/calibration-overlays.folk | 22 + virtual-programs/_archive/hello-name.folk | 11 + virtual-programs/_archive/highlight.folk | 6 + virtual-programs/_archive/log.folk | 13 + virtual-programs/_archive/metrics.folk | 14 + virtual-programs/_archive/points-up-test.folk | 6 + virtual-programs/_archive/points-up.folk | 18 + virtual-programs/_archive/test.folk | 13 + virtual-programs/_archive/welcome.folk | 1 + virtual-programs/apriltags.folk | 4 +- virtual-programs/archive/calibration-overlays.folk | 22 - virtual-programs/archive/hello-name.folk | 11 - virtual-programs/archive/highlight.folk | 6 - virtual-programs/archive/log.folk | 13 - virtual-programs/archive/metrics.folk | 14 - virtual-programs/archive/points-up-test.folk | 6 - virtual-programs/archive/points-up.folk | 18 - virtual-programs/archive/test.folk | 13 - virtual-programs/archive/welcome.folk | 1 - virtual-programs/camera.folk | 2 +- virtual-programs/display.folk | 501 +++------------------ virtual-programs/display/circle.folk | 31 ++ virtual-programs/display/fill.folk | 46 ++ virtual-programs/display/fns.folk | 0 virtual-programs/display/image.folk | 99 ++++ virtual-programs/display/stroke.folk | 33 ++ virtual-programs/display/text.folk | 150 ++++++ virtual-programs/label.folk | 5 +- virtual-programs/outline.folk | 12 +- 29 files changed, 545 insertions(+), 546 deletions(-) create mode 100644 virtual-programs/_archive/calibration-overlays.folk create mode 100644 virtual-programs/_archive/hello-name.folk create mode 100644 virtual-programs/_archive/highlight.folk create mode 100644 virtual-programs/_archive/log.folk create mode 100644 virtual-programs/_archive/metrics.folk create mode 100644 virtual-programs/_archive/points-up-test.folk create mode 100644 virtual-programs/_archive/points-up.folk create mode 100644 virtual-programs/_archive/test.folk create mode 100644 virtual-programs/_archive/welcome.folk delete mode 100644 virtual-programs/archive/calibration-overlays.folk delete mode 100644 virtual-programs/archive/hello-name.folk delete mode 100644 virtual-programs/archive/highlight.folk delete mode 100644 virtual-programs/archive/log.folk delete mode 100644 virtual-programs/archive/metrics.folk delete mode 100644 virtual-programs/archive/points-up-test.folk delete mode 100644 virtual-programs/archive/points-up.folk delete mode 100644 virtual-programs/archive/test.folk delete mode 100644 virtual-programs/archive/welcome.folk create mode 100644 virtual-programs/display/circle.folk create mode 100644 virtual-programs/display/fill.folk create mode 100644 virtual-programs/display/fns.folk create mode 100644 virtual-programs/display/image.folk create mode 100644 virtual-programs/display/stroke.folk create mode 100644 virtual-programs/display/text.folk (limited to 'virtual-programs') diff --git a/virtual-programs/_archive/calibration-overlays.folk b/virtual-programs/_archive/calibration-overlays.folk new file mode 100644 index 00000000..6575168d --- /dev/null +++ b/virtual-programs/_archive/calibration-overlays.folk @@ -0,0 +1,22 @@ +if {[info hostname] != "folk0"} {return} + +# Move tag 1 to each of the 4 calibrators in turn; write down the 4 point correspondences + +set minX 500 +set maxX [expr $Display::WIDTH - 500] +set minY 300 +set maxY [expr $Display::HEIGHT - 300] +set projectorPoints [list \ + [list $minX $minY] \ + [list $maxX $minY] \ + [list $maxX $maxY] \ + [list $minX $maxY] \ +] +for {set i 0} {$i < [llength $projectorPoints]} {incr i} { + lassign [lindex $projectorPoints $i] px py + Claim "calibrator $i" is a rectangle with x $px y $py width 20 height 20 + Wish "calibrator $i" is highlighted blue + When tag 1 has center /c/ size /something/ { + Wish "calibrator $i" is labelled "proj $i ($px, $py)\ntag 1 ([lindex $c 0], [lindex $c 1])" + } +} diff --git a/virtual-programs/_archive/hello-name.folk b/virtual-programs/_archive/hello-name.folk new file mode 100644 index 00000000..be31ba5c --- /dev/null +++ b/virtual-programs/_archive/hello-name.folk @@ -0,0 +1,11 @@ +Wish $this is outlined blue + +When someone claims /firstName/ is /text/ { + Wish $this is outlined blue + Wish $this is labelled " + + + + +Hi $text!" +} \ No newline at end of file diff --git a/virtual-programs/_archive/highlight.folk b/virtual-programs/_archive/highlight.folk new file mode 100644 index 00000000..768e4bc9 --- /dev/null +++ b/virtual-programs/_archive/highlight.folk @@ -0,0 +1,6 @@ +When /someone/ wishes /thing/ is highlighted /color/ & /thing/ has region /region/ { + # it's not really correct to just stick a side-effect in the + # When handler like this. but we did it in Realtalk, and it + # was ok, so whatever for now + Display::fillRect device $x $y [expr {$x+$width}] [expr {$y+$height}] $color +} diff --git a/virtual-programs/_archive/log.folk b/virtual-programs/_archive/log.folk new file mode 100644 index 00000000..872f3fe2 --- /dev/null +++ b/virtual-programs/_archive/log.folk @@ -0,0 +1,13 @@ +Wish the web server handles route "/log$" with handler { + set log [Evaluator::getOperationLog] + set body [list "
    "] + foreach entry $log { + if {$entry eq "Evaluate"} { + lappend body {
  1. Evaluate
    2. } + } else { + lappend body "
  2. [htmlEscape $entry]
    3. " + } + } + lappend body "
" + html [join $body ""] +} \ No newline at end of file diff --git a/virtual-programs/_archive/metrics.folk b/virtual-programs/_archive/metrics.folk new file mode 100644 index 00000000..e5389512 --- /dev/null +++ b/virtual-programs/_archive/metrics.folk @@ -0,0 +1,14 @@ +When $::thisNode has step count /c/ { + Wish $this is labelled [string trim " + +Metrics +---- +step count: $c +step time: $::stepTime +camera time: $::cameraTime +AprilTag time: $::aprilTime +display time: $::displayTime + +"] +} +Wish $this is outlined skyblue diff --git a/virtual-programs/_archive/points-up-test.folk b/virtual-programs/_archive/points-up-test.folk new file mode 100644 index 00000000..c4fcff4d --- /dev/null +++ b/virtual-programs/_archive/points-up-test.folk @@ -0,0 +1,6 @@ +Wish $this is highlighted blue + +Wish $this points up +When $this points up at /target/ & /target/ has program code /code/ { + Wish $target is labelled "being pointed at" +} diff --git a/virtual-programs/_archive/points-up.folk b/virtual-programs/_archive/points-up.folk new file mode 100644 index 00000000..e5c12126 --- /dev/null +++ b/virtual-programs/_archive/points-up.folk @@ -0,0 +1,18 @@ +When /someone/ wishes /rect/ points up & /rect/ is a rectangle with x /x/ y /y/ width /width/ height /height/ { + set wx [expr {$x+$width/2}] + set wy [expr {$y-40}] + set ww 5 + set wh 40 + Claim $rect-whisker is a rectangle with x $wx y $wy width $ww height $wh + Wish $rect-whisker is highlighted green + + When /target/ is a rectangle with x /tx/ y /ty/ width /tw/ height /th/ { + if {$target != $rect && \ + [rectanglesOverlap \ + [list $wx $wy] [list [expr {$wx+$ww}] [expr {$wy+$wh}]] \ + [list $tx $ty] [list [expr {$tx+$tw}] [expr {$ty+$th}]] \ + false]} { + Claim $rect points up at $target + } + } +} diff --git a/virtual-programs/_archive/test.folk b/virtual-programs/_archive/test.folk new file mode 100644 index 00000000..9b5c75f0 --- /dev/null +++ b/virtual-programs/_archive/test.folk @@ -0,0 +1,13 @@ +Wish $this has filename "test.folk" + +When $this has region /r/ { + set points [lindex $r 0] + lassign $points one two three four + lassign $one a b + lassign $three c d + # Wish $this is labelled "$a $b $c $d" + # Display::fillRect $a $b $c $d skyblue + Display::stroke [list [list $a $b] [list $c $d]] 3 skyblue +} + +Wish $this is outlined thick magenta diff --git a/virtual-programs/_archive/welcome.folk b/virtual-programs/_archive/welcome.folk new file mode 100644 index 00000000..6c08ed47 --- /dev/null +++ b/virtual-programs/_archive/welcome.folk @@ -0,0 +1 @@ +Wish $this is labelled "welcome 2!" \ No newline at end of file diff --git a/virtual-programs/apriltags.folk b/virtual-programs/apriltags.folk index b23f2bdc..49b83e5a 100644 --- a/virtual-programs/apriltags.folk +++ b/virtual-programs/apriltags.folk @@ -3,7 +3,7 @@ if {$::isLaptop} return set tagfamily "tagStandard52h13" # Plain detector. Runs on entire camera frame. -set mainDetectorProcess [On process { +set mainDetectorProcess [Start process { source pi/AprilTags.tcl Wish $::thisProcess receives statements like \ @@ -22,7 +22,7 @@ set mainDetectorProcess [On process { # Incremental detector. Looks at regions where there were tags in the # old camera frame. -On process { +Start process { source pi/AprilTags.tcl Wish $::thisProcess receives statements like \ diff --git a/virtual-programs/archive/calibration-overlays.folk b/virtual-programs/archive/calibration-overlays.folk deleted file mode 100644 index 6575168d..00000000 --- a/virtual-programs/archive/calibration-overlays.folk +++ /dev/null @@ -1,22 +0,0 @@ -if {[info hostname] != "folk0"} {return} - -# Move tag 1 to each of the 4 calibrators in turn; write down the 4 point correspondences - -set minX 500 -set maxX [expr $Display::WIDTH - 500] -set minY 300 -set maxY [expr $Display::HEIGHT - 300] -set projectorPoints [list \ - [list $minX $minY] \ - [list $maxX $minY] \ - [list $maxX $maxY] \ - [list $minX $maxY] \ -] -for {set i 0} {$i < [llength $projectorPoints]} {incr i} { - lassign [lindex $projectorPoints $i] px py - Claim "calibrator $i" is a rectangle with x $px y $py width 20 height 20 - Wish "calibrator $i" is highlighted blue - When tag 1 has center /c/ size /something/ { - Wish "calibrator $i" is labelled "proj $i ($px, $py)\ntag 1 ([lindex $c 0], [lindex $c 1])" - } -} diff --git a/virtual-programs/archive/hello-name.folk b/virtual-programs/archive/hello-name.folk deleted file mode 100644 index be31ba5c..00000000 --- a/virtual-programs/archive/hello-name.folk +++ /dev/null @@ -1,11 +0,0 @@ -Wish $this is outlined blue - -When someone claims /firstName/ is /text/ { - Wish $this is outlined blue - Wish $this is labelled " - - - - -Hi $text!" -} \ No newline at end of file diff --git a/virtual-programs/archive/highlight.folk b/virtual-programs/archive/highlight.folk deleted file mode 100644 index 768e4bc9..00000000 --- a/virtual-programs/archive/highlight.folk +++ /dev/null @@ -1,6 +0,0 @@ -When /someone/ wishes /thing/ is highlighted /color/ & /thing/ has region /region/ { - # it's not really correct to just stick a side-effect in the - # When handler like this. but we did it in Realtalk, and it - # was ok, so whatever for now - Display::fillRect device $x $y [expr {$x+$width}] [expr {$y+$height}] $color -} diff --git a/virtual-programs/archive/log.folk b/virtual-programs/archive/log.folk deleted file mode 100644 index 872f3fe2..00000000 --- a/virtual-programs/archive/log.folk +++ /dev/null @@ -1,13 +0,0 @@ -Wish the web server handles route "/log$" with handler { - set log [Evaluator::getOperationLog] - set body [list "
    "] - foreach entry $log { - if {$entry eq "Evaluate"} { - lappend body {
  1. Evaluate
    2. } - } else { - lappend body "
  2. [htmlEscape $entry]
    3. " - } - } - lappend body "
" - html [join $body ""] -} \ No newline at end of file diff --git a/virtual-programs/archive/metrics.folk b/virtual-programs/archive/metrics.folk deleted file mode 100644 index e5389512..00000000 --- a/virtual-programs/archive/metrics.folk +++ /dev/null @@ -1,14 +0,0 @@ -When $::thisNode has step count /c/ { - Wish $this is labelled [string trim " - -Metrics ----- -step count: $c -step time: $::stepTime -camera time: $::cameraTime -AprilTag time: $::aprilTime -display time: $::displayTime - -"] -} -Wish $this is outlined skyblue diff --git a/virtual-programs/archive/points-up-test.folk b/virtual-programs/archive/points-up-test.folk deleted file mode 100644 index c4fcff4d..00000000 --- a/virtual-programs/archive/points-up-test.folk +++ /dev/null @@ -1,6 +0,0 @@ -Wish $this is highlighted blue - -Wish $this points up -When $this points up at /target/ & /target/ has program code /code/ { - Wish $target is labelled "being pointed at" -} diff --git a/virtual-programs/archive/points-up.folk b/virtual-programs/archive/points-up.folk deleted file mode 100644 index e5c12126..00000000 --- a/virtual-programs/archive/points-up.folk +++ /dev/null @@ -1,18 +0,0 @@ -When /someone/ wishes /rect/ points up & /rect/ is a rectangle with x /x/ y /y/ width /width/ height /height/ { - set wx [expr {$x+$width/2}] - set wy [expr {$y-40}] - set ww 5 - set wh 40 - Claim $rect-whisker is a rectangle with x $wx y $wy width $ww height $wh - Wish $rect-whisker is highlighted green - - When /target/ is a rectangle with x /tx/ y /ty/ width /tw/ height /th/ { - if {$target != $rect && \ - [rectanglesOverlap \ - [list $wx $wy] [list [expr {$wx+$ww}] [expr {$wy+$wh}]] \ - [list $tx $ty] [list [expr {$tx+$tw}] [expr {$ty+$th}]] \ - false]} { - Claim $rect points up at $target - } - } -} diff --git a/virtual-programs/archive/test.folk b/virtual-programs/archive/test.folk deleted file mode 100644 index 9b5c75f0..00000000 --- a/virtual-programs/archive/test.folk +++ /dev/null @@ -1,13 +0,0 @@ -Wish $this has filename "test.folk" - -When $this has region /r/ { - set points [lindex $r 0] - lassign $points one two three four - lassign $one a b - lassign $three c d - # Wish $this is labelled "$a $b $c $d" - # Display::fillRect $a $b $c $d skyblue - Display::stroke [list [list $a $b] [list $c $d]] 3 skyblue -} - -Wish $this is outlined thick magenta diff --git a/virtual-programs/archive/welcome.folk b/virtual-programs/archive/welcome.folk deleted file mode 100644 index 6c08ed47..00000000 --- a/virtual-programs/archive/welcome.folk +++ /dev/null @@ -1 +0,0 @@ -Wish $this is labelled "welcome 2!" \ No newline at end of file diff --git a/virtual-programs/camera.folk b/virtual-programs/camera.folk index 46daa52e..f997d419 100644 --- a/virtual-programs/camera.folk +++ b/virtual-programs/camera.folk @@ -14,7 +14,7 @@ if {$::thisNode eq "folk-interact"} { set width $::Camera::WIDTH set height $::Camera::HEIGHT -On process { +Start process "camera" { Wish $::thisProcess shares statements like \ [list /someone/ claims the camera /...anything/] diff --git a/virtual-programs/display.folk b/virtual-programs/display.folk index aed9d51d..0cfc63b2 100644 --- a/virtual-programs/display.folk +++ b/virtual-programs/display.folk @@ -25,459 +25,102 @@ namespace eval ::Display { } } -On process { + +namespace eval Colors { source "pi/Colors.tcl" } +proc ::getColor {color} { + if {[info exists Colors::$color]} { return [set Colors::$color] } \ + else { return $Colors::white } +} + +Start process "display" { puts "Display pid: [pid]" source pi/Gpu.tcl Gpu::init Gpu::ImageManager::imageManagerInit - namespace eval Display { - namespace eval Colors { source "pi/Colors.tcl" } - - variable rotate [Gpu::fn {vec2 v float a} vec2 { - float s = sin(a); - float c = cos(a); - mat2 m = mat2(c, s, -s, c); - return m * v; - }] - variable cross2d [Gpu::fn {vec2 a vec2 b} float { - return a.x*b.y - a.y*b.x; - }] - # See https://www.shadertoy.com/view/lsBSDm - variable invBilinear [Gpu::fn {vec2 p vec2 a vec2 b vec2 c vec2 d fn cross2d} vec2 { - vec2 res = vec2(-1.0); - - vec2 e = b-a; - vec2 f = d-a; - vec2 g = a-b+c-d; - vec2 h = p-a; - - float k2 = cross2d( g, f ); - float k1 = cross2d( e, f ) + cross2d( h, g ); - float k0 = cross2d( h, e ); - - // if edges are parallel, this is a linear equation - k2 /= k0; k1 /= k0; k0 = 1.0; - if( abs(k2)<0.001*abs(k0) ) + # TODO: Share these functions through the database somehow, + # instead of keeping them in globals. + + set ::rotate [Gpu::fn {vec2 v float a} vec2 { + float s = sin(a); + float c = cos(a); + mat2 m = mat2(c, s, -s, c); + return m * v; + }] + set ::cross2d [Gpu::fn {vec2 a vec2 b} float { + return a.x*b.y - a.y*b.x; + }] + # See https://www.shadertoy.com/view/lsBSDm + set ::invBilinear [Gpu::fn {vec2 p vec2 a vec2 b vec2 c vec2 d fn ::cross2d} vec2 { + vec2 res = vec2(-1.0); + + vec2 e = b-a; + vec2 f = d-a; + vec2 g = a-b+c-d; + vec2 h = p-a; + + float k2 = cross2d( g, f ); + float k1 = cross2d( e, f ) + cross2d( h, g ); + float k0 = cross2d( h, e ); + + // if edges are parallel, this is a linear equation + k2 /= k0; k1 /= k0; k0 = 1.0; + if( abs(k2)<0.001*abs(k0) ) + { + res = vec2( (h.x*k1+f.x*k0)/(e.x*k1-g.x*k0), -k0/k1 ); + } + // otherwise, it's a quadratic + else + { + float w = k1*k1 - 4.0*k0*k2; + if( w<0.0 ) return vec2(-1.0); + w = sqrt( w ); + + float ik2 = 0.5/k2; + float v = (-k1 - w)*ik2; + float u = (h.x - f.x*v)/(e.x + g.x*v); + + if( u<0.0 || u>1.0 || v<0.0 || v>1.0 ) { - res = vec2( (h.x*k1+f.x*k0)/(e.x*k1-g.x*k0), -k0/k1 ); - } - // otherwise, it's a quadratic - else - { - float w = k1*k1 - 4.0*k0*k2; - if( w<0.0 ) return vec2(-1.0); - w = sqrt( w ); - - float ik2 = 0.5/k2; - float v = (-k1 - w)*ik2; - float u = (h.x - f.x*v)/(e.x + g.x*v); - - if( u<0.0 || u>1.0 || v<0.0 || v>1.0 ) - { - v = (-k1 + w)*ik2; - u = (h.x - f.x*v)/(e.x + g.x*v); - } - res = vec2( u, v ); - } - return res; - }] - - namespace eval font { - proc load {name} { - set csvFd [open "vendor/fonts/$name.csv" r]; set csv [read $csvFd]; close $csvFd - set glyphInfos [dict create] - foreach line [split $csv "\n"] { - set info [lassign [split $line ,] glyph] - lassign $info advance \ - planeLeft planeBottom planeRight planeTop \ - atlasLeft atlasBottom atlasRight atlasTop - dict set glyphInfos $glyph \ - [list $advance \ - [list $planeLeft $planeBottom $planeRight $planeTop] \ - [list $atlasLeft $atlasBottom $atlasRight $atlasTop]] - } - - set im [image load "[pwd]/vendor/fonts/$name.png"] - set gim [Gpu::ImageManager::copyImageToGpu $im] - - return [list $glyphInfos $im $gim] - } - proc hasGlyphInfo {font charCode} { dict exists [lindex $font 0] $charCode } - proc glyphInfo {font charCode} { dict get [lindex $font 0] $charCode } - proc atlasImage {font} { lindex $font 1 } - proc gpuAtlasImage {font} { lindex $font 2 } - - namespace export * - namespace ensemble create - } - variable glyphMsd [Gpu::fn {sampler2D atlas vec4 atlasGlyphBounds vec2 glyphUv} vec4 { - vec2 atlasUv = mix(atlasGlyphBounds.xw, atlasGlyphBounds.zy, glyphUv); - return texture(atlas, vec2(atlasUv.x, 1.0-atlasUv.y)); - }] - variable median [Gpu::fn {float r float g float b} float { - return max(min(r, g), min(max(r, g), b)); - }] - variable glyph [Gpu::pipeline {sampler2D atlas vec2 atlasSize - vec4 atlasGlyphBounds - vec4 planeGlyphBounds - vec2 pos float radians float em - fn rotate} { - float left = planeGlyphBounds[0] * em; - float bottom = planeGlyphBounds[1] * em; - float right = planeGlyphBounds[2] * em; - float top = planeGlyphBounds[3] * em; - vec2 a = pos + rotate(vec2(left, -top), -radians); - vec2 b = pos + rotate(vec2(right, -top), -radians); - vec2 c = pos + rotate(vec2(right, -bottom), -radians); - vec2 d = pos + rotate(vec2(left, -bottom), -radians); - - vec2 vertices[4] = vec2[4](a, b, d, c); - return vertices[gl_VertexIndex]; - } {fn rotate fn invBilinear fn glyphMsd fn median} { - float left = planeGlyphBounds[0] * em; - float bottom = planeGlyphBounds[1] * em; - float right = planeGlyphBounds[2] * em; - float top = planeGlyphBounds[3] * em; - vec2 a = pos + rotate(vec2(left, -top), -radians); - vec2 b = pos + rotate(vec2(right, -top), -radians); - vec2 c = pos + rotate(vec2(right, -bottom), -radians); - vec2 d = pos + rotate(vec2(left, -bottom), -radians); - - vec2 glyphUv = invBilinear(gl_FragCoord.xy, a, b, c, d); - if( max( abs(glyphUv.x-0.5), abs(glyphUv.y-0.5))>=0.5 ) { - return vec4(0, 0, 0, 0); - } - vec3 msd = glyphMsd(atlas, atlasGlyphBounds/atlasSize.xyxy, glyphUv).rgb; - float sd = median(msd.r, msd.g, msd.b); - float screenPxDistance = 4.5*(sd - 0.5); - float opacity = clamp(screenPxDistance + 0.5, 0.0, 1.0); - return mix(vec4(0, 0, 0, 0), vec4(1, 1, 1, 1), opacity); - }] - - proc start {} { Gpu::drawStart } - - proc getColor {color} { - if {[info exists Colors::$color]} { return [set Colors::$color] } \ - else { return $Colors::white } - } - - variable line [Gpu::pipeline {vec2 from vec2 to float thickness vec4 color} { - vec2 vertices[4] = vec2[4]( - min(from, to) - thickness, - vec2(max(from.x, to.x) + thickness, min(from.y, to.y) - thickness), - vec2(min(from.x, to.x) - thickness, max(from.y, to.y) + thickness), - max(from, to) + thickness - ); - return vertices[gl_VertexIndex]; - } { - float l = length(to - from); - vec2 d = (to - from) / l; - vec2 q = (gl_FragCoord.xy - (from + to)*0.5); - q = mat2(d.x, -d.y, d.y, d.x) * q; - q = abs(q) - vec2(l, thickness)*0.5; - float dist = length(max(q, 0.0)) + min(max(q.x, q.y), 0.0); - - return dist < 0.0 ? color : vec4(0, 0, 0, 0); - }] - proc stroke {points width color} { - variable line - for {set i 0} {$i < [expr {[llength $points] - 1}]} {incr i} { - set from [lindex $points $i] - set to [lindex $points [expr $i+1]] - Gpu::draw $line $from $to $width [getColor $color] - } - } - - # TODO: Fix bool support. - variable circle [Gpu::pipeline {vec2 center float radius float thickness vec4 color int filled} { - 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 vertices[gl_VertexIndex]; - } { - float dist = length(gl_FragCoord.xy - center) - radius; - if (filled == 1) { - return (dist < thickness) ? color : vec4(0, 0, 0, 0); - } else { - return (dist < thickness && dist > 0.0) ? color : vec4(0, 0, 0, 0); - } - }] - proc circle {x y radius thickness color {filled false}} { - variable circle - Gpu::draw $circle [list $x $y] $radius $thickness [getColor $color] [ne $filled "false"] - } - - set ::FontCache [dict create] - - # load all fonts into the fontCache - foreach fontPath [list {*}[glob {*}vendor/fonts/*.png]] { - set fontName "" - regexp {vendor/fonts/(.*).png} $fontPath whole_match fontName - if {!($fontName eq "")} { - puts "Loaded $fontName into font cache" - set fontdata [font load $fontName] - dict set ::FontCache $fontName $fontdata + v = (-k1 + w)*ik2; + u = (h.x - f.x*v)/(e.x + g.x*v); } + res = vec2( u, v ); } + return res; + }] - proc textExtent {text scale {font "PTSans-Regular"}} { - if {!([dict exists $::FontCache $font])} { - throw {DISPLAY FONT {font doesn't exist}} "$font doesn't exist" - return - } - set font [dict get $::FontCache $font] - - set em [* $scale 25.0] - set x 0; set y 0 - set width 0 - for {set i 0} {$i < [string length $text]} {incr i} { - set char [string index $text $i] - if {$char eq "\n"} { - set y [+ $y $em]; set x 0; continue - } - set charCode [scan $char %c] - if {[font hasGlyphInfo $font $charCode]} { - set glyphInfo [font glyphInfo $font $charCode] - } else { - set glyphInfo [font glyphInfo $font [scan ? %c]] - } - lassign $glyphInfo advance planeBounds atlasBounds - set x [+ $x [* $advance $em]] - if {$x > $width} { set width $x } - } - return [list $width [+ $y $em]] - } - proc text {x0 y0 scale text radians {font "PTSans-Regular"}} { - if {!([dict exists $::FontCache $font])} { - throw {DISPLAY FONT {font doesn't exist}} "$font doesn't exist" - return - } - set font [dict get $::FontCache $font] - - - variable glyph - set fontAtlas [font gpuAtlasImage $font] - set fontAtlasSize [list [::image width [font atlasImage $font]] \ - [::image height [font atlasImage $font]]] - - set extent [vec2 rotate [textExtent $text $scale] $radians] - - set em [* $scale 25.0] - - # TODO: Add text alignment/anchor options (right now, this - # setup centers the text). - set x0 [expr {$x0 - [lindex $extent 0]/2}] - set y0 [expr {$y0 - [lindex $extent 1]/2}] - set x $x0; set y $y0 - - set lineNum 0 - for {set i 0} {$i < [string length $text]} {incr i} { - set char [string index $text $i] - if {$char eq "\n"} { - incr lineNum - lassign [vec2 add [list $x0 $y0] \ - [vec2 rotate [list 0 [* $lineNum $em]] $radians]] x y - continue - } - set charCode [scan $char %c] - if {[font hasGlyphInfo $font $charCode]} { - set glyphInfo [font glyphInfo $font $charCode] - } else { - set glyphInfo [font glyphInfo $font [scan ? %c]] - } - lassign $glyphInfo advance planeBounds atlasBounds - if {$char ne " "} { - Gpu::draw $glyph $fontAtlas $fontAtlasSize \ - $atlasBounds $planeBounds [list $x $y] $radians $em - } - lassign [vec2 add [list $x $y] \ - [vec2 rotate [list [* $advance $em] 0] $radians]] x y - } - } - - variable fillTriangle [Gpu::pipeline {vec2 p0 vec2 p1 vec2 p2 vec4 color} { - vec2 vertices[4] = vec2[4](p0, p1, p2, p0); - return vertices[gl_VertexIndex]; - } { - return color; - }] - proc fillTriangle {p0 p1 p2 color} { - variable fillTriangle - Gpu::draw $fillTriangle $p0 $p1 $p2 [getColor $color] - } - - proc fillQuad {p0 p1 p2 p3 color} { - fillTriangle $p1 $p2 $p3 $color - fillTriangle $p0 $p1 $p3 $color - } - - proc fillPolygon {points color} { - set num_points [llength $points] - if {$num_points < 3} { - error "At least 3 points are required to form a polygon." - } elseif {$num_points == 3} { - eval fillTriangle $points $color - } elseif {$num_points == 4} { - eval fillQuad $points $color - } else { - # Get the first point in the list as the "base" point of the triangles - set p0 [lindex $points 0] - - for {set i 1} {$i < $num_points - 1} {incr i} { - set p1 [lindex $points $i] - set p2 [lindex $points [expr {$i+1}]] - fillTriangle $p0 $p1 $p2 $color - } - } - } - - variable image [Gpu::pipeline {sampler2D image vec2 imageSize - vec2 pos float radians float scale - fn rotate} { - vec2 a = pos + rotate(-imageSize/2, -radians); - vec2 b = pos + rotate(vec2(imageSize.x, -imageSize.y)/2, -radians); - vec2 c = pos + rotate(imageSize/2, -radians); - vec2 d = pos + rotate(vec2(-imageSize.x, imageSize.y)/2, -radians); - vec2 vertices[4] = vec2[4](a, b, d, c); - return vertices[gl_VertexIndex]; - } {fn invBilinear fn rotate} { - vec2 a = pos + rotate(-imageSize/2, -radians); - vec2 b = pos + rotate(vec2(imageSize.x, -imageSize.y)/2, -radians); - vec2 c = pos + rotate(imageSize/2, -radians); - vec2 d = pos + rotate(vec2(-imageSize.x, imageSize.y)/2, -radians); - vec2 p = gl_FragCoord.xy; - vec2 uv = invBilinear(p, a, b, c, d); - if( max( abs(uv.x-0.5), abs(uv.y-0.5))<0.5 ) { - return texture(image, uv); - } - return vec4(0.0, 0.0, 0.0, 0.0); - }] - variable imCache [dict create] - variable IMCACHE_MAX_IMAGES [- $Gpu::ImageManager::GPU_MAX_IMAGES [dict size $::FontCache]] - proc checkImCacheAndCopyIfNeeded {imDrawSet} { - variable imCache - variable IMCACHE_MAX_IMAGES - - dict for {im v} $imDrawSet { - if {![dict exists $imCache $im]} { continue } - # Check for staleness and remove from cache if so. - lassign [dict get $imCache $im] gim expectedVersion - set version [Heap::folkHeapGetVersion [string map {uint8_t void} [::image_t data_ptr $im]]] - if {$expectedVersion != $version} { - Gpu::ImageManager::freeGpuImage $gim - dict unset imCache $im - } - } - - set notInCache [dictset difference $imDrawSet $imCache] - set notInDrawSet [dictset difference $imCache $imDrawSet] - - set numImagesToCopy [dictset size $notInCache] - if {$numImagesToCopy > 0} { - if {[dictset size $imCache] + $numImagesToCopy > $IMCACHE_MAX_IMAGES} { - set numImagesToEvict \ - [expr {[dictset size $imCache] + $numImagesToCopy - $IMCACHE_MAX_IMAGES}] - - # What can we safely evict? - # - Anything that's stale - # - Anything that's not in use - set numImagesEvicted 0 - dict for {im v} $imCache { - if {$numImagesEvicted == $numImagesToEvict} { break } - - lassign $v gim expectedVersion - set version [Heap::folkHeapGetVersion [string map {uint8_t void} [::image_t data_ptr $im]]] - if {$expectedVersion != $version} { - Gpu::ImageManager::freeGpuImage $gim - dict unset imCache $im - incr numImagesEvicted - continue - } - if {![dict exists $imDrawSet $im]} { - Gpu::ImageManager::freeGpuImage $gim - dict unset imCache $im - incr numImagesEvicted - } - } - } - - dict for {im _} $notInCache { - # TODO: This is unsafe (has a race condition) -- we're - # not locking the image, so version and gim may diverge. - set version [Heap::folkHeapGetVersion [string map {uint8_t void} [::image_t data_ptr $im]]] - set gim [Gpu::ImageManager::copyImageToGpu $im] - dict set imCache $im [list $gim $version] - } - } - } - proc image {x y im radians {scale 1.0}} { - # TODO: Implement scale. - variable image - variable imCache - lassign [dict get $imCache $im] gim - Gpu::draw $image $gim [list [::image width $im] [::image height $im]] \ - [list $x $y] $radians $scale - } - - proc end {} { Gpu::drawEnd; Gpu::poll } + namespace eval Colors { source "pi/Colors.tcl" } + proc ::getColor {color} { + if {[info exists Colors::$color]} { return [set Colors::$color] } \ + else { return $Colors::white } } Wish $::thisProcess receives statements like \ - [list /someone/ wishes display runs /command/ on layer /layer/] - Wish $::thisProcess receives statements like \ - [list /someone/ wishes display runs /command/] + [list /someone/ wishes the GPU compiles pipeline /name/ /source/] Wish $::thisProcess receives statements like \ - [list /someone/ wishes display runs program /program/] + [list /someone/ wishes the GPU draws pipeline /name/ with arguments /args/] Wish $::thisProcess shares statements like \ [list /someone/ claims the display time is /displayTime/] - while true { - set displayList [list] - foreach match [Statements::findMatches {/someone/ wishes display runs /command/ on layer /layer/}] { - lappend displayList [list [dict get $match layer] [dict get $match command]] - } - foreach match [Statements::findMatches {/someone/ wishes display runs /command/}] { - lappend displayList [list 0 [dict get $match command]] - } - - proc lcomp {a b} { - set layerA [lindex $a 0] - set layerB [lindex $b 0] - if {$layerA == $layerB} { - expr {[lindex $a 1 0] == "Display::text"} - } else { - expr {$layerA - $layerB} - } - } - - set displayCommands [lmap sublist [lsort -command lcomp $displayList] {lindex $sublist 1}] + set ::pipelines [dict create] + When /someone/ wishes the GPU compiles pipeline /name/ /source/ { + dict set ::pipelines $name [Gpu::pipeline {*}$source] + } - set imDrawSet [dictset create] - foreach command $displayCommands { - if {[lindex $command 0] eq "Display::image"} { - set im [lindex $command 3] - dictset add imDrawSet $im - } - } - Display::checkImCacheAndCopyIfNeeded $imDrawSet + while true { + Step set renderTime [baretime { - Display::start - foreach command $displayCommands { - try { {*}$command } \ - on error e { puts stderr $::errorInfo } + Gpu::drawStart + foreach match [Statements::findMatches {/someone/ wishes the GPU draws pipeline /name/ with arguments /args/}] { + Gpu::draw [dict get $::pipelines [dict get $match name]] {*}[dict get $match args] } - Display::end + Gpu::drawEnd }] Commit { Claim the display time is "render $renderTime us ($::stepTime)" } - Step } } diff --git a/virtual-programs/display/circle.folk b/virtual-programs/display/circle.folk new file mode 100644 index 00000000..f50813eb --- /dev/null +++ b/virtual-programs/display/circle.folk @@ -0,0 +1,31 @@ +Wish the GPU compiles pipeline "circle" { + {vec2 center float radius float thickness vec4 color int filled} { + 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 vertices[gl_VertexIndex]; + } { + float dist = length(gl_FragCoord.xy - center) - radius; + if (filled == 1) { + return (dist < thickness) ? color : vec4(0, 0, 0, 0); + } else { + return (dist < thickness && dist > 0.0) ? color : vec4(0, 0, 0, 0); + } + } +} + +When /someone/ wishes to draw a circle 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 color [getColor [dict get $options color]] + set filled [dict getdef $options filled false] + + Wish the GPU draws pipeline "circle" with arguments \ + [list $center $radius $thickness $color $filled] +} diff --git a/virtual-programs/display/fill.folk b/virtual-programs/display/fill.folk new file mode 100644 index 00000000..dd9e199d --- /dev/null +++ b/virtual-programs/display/fill.folk @@ -0,0 +1,46 @@ +Wish the GPU compiles pipeline "fillTriangle" { + {vec2 p0 vec2 p1 vec2 p2 vec4 color} { + vec2 vertices[4] = vec2[4](p0, p1, p2, p0); + return vertices[gl_VertexIndex]; + } { + return color; + } +} + +When /someone/ wishes to draw a triangle with /...options/ { + dict with options { + Wish the GPU draws pipeline "fillTriangle" with arguments \ + [list $p0 $p1 $p2 [getColor $color]] + } +} +When /someone/ wishes to draw a quad with /...options/ { + dict with options { + Wish the GPU draws pipeline "fillTriangle" with arguments \ + [list $p0 $p1 $p2 [getColor $color]] + Wish the GPU draws pipeline "fillTriangle" with arguments \ + [list $p0 $p1 $p3 [getColor $color]] + } +} +When /someone/ wishes to draw a polygon with /...options/ { + set points [dict get $options points] + set color [dict get $options color] + + set num_points [llength $points] + if {$num_points < 3} { + error "At least 3 points are required to form a polygon." + } elseif {$num_points == 3} { + eval fillTriangle $points $color + } elseif {$num_points == 4} { + eval fillQuad $points $color + } else { + # Get the first point in the list as the "base" point of the triangles + set p0 [lindex $points 0] + + 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] + } + } +} diff --git a/virtual-programs/display/fns.folk b/virtual-programs/display/fns.folk new file mode 100644 index 00000000..e69de29b diff --git a/virtual-programs/display/image.folk b/virtual-programs/display/image.folk new file mode 100644 index 00000000..4665a236 --- /dev/null +++ b/virtual-programs/display/image.folk @@ -0,0 +1,99 @@ +On process "display" { + set invBilinear $::invBilinear + set rotate $::rotate + set image [Gpu::pipeline {sampler2D image vec2 imageSize + vec2 pos float radians float scale + fn rotate} { + vec2 a = pos + rotate(-imageSize/2, -radians); + vec2 b = pos + rotate(vec2(imageSize.x, -imageSize.y)/2, -radians); + vec2 c = pos + rotate(imageSize/2, -radians); + vec2 d = pos + rotate(vec2(-imageSize.x, imageSize.y)/2, -radians); + vec2 vertices[4] = vec2[4](a, b, d, c); + return vertices[gl_VertexIndex]; + } {fn invBilinear fn rotate} { + vec2 a = pos + rotate(-imageSize/2, -radians); + vec2 b = pos + rotate(vec2(imageSize.x, -imageSize.y)/2, -radians); + vec2 c = pos + rotate(imageSize/2, -radians); + vec2 d = pos + rotate(vec2(-imageSize.x, imageSize.y)/2, -radians); + vec2 p = gl_FragCoord.xy; + vec2 uv = invBilinear(p, a, b, c, d); + if( max( abs(uv.x-0.5), abs(uv.y-0.5))<0.5 ) { + return texture(image, uv); + } + return vec4(0.0, 0.0, 0.0, 0.0); + }] + + set ::ImCache [dict create] + variable IMCACHE_MAX_IMAGES [- $Gpu::ImageManager::GPU_MAX_IMAGES 1] + proc checkImCacheAndCopyIfNeeded {imDrawSet} { + variable ::ImCache + variable IMCACHE_MAX_IMAGES + + dict for {im v} $imDrawSet { + if {![dict exists $::ImCache $im]} { continue } + # Check for staleness and remove from cache if so. + lassign [dict get $::ImCache $im] gim expectedVersion + set version [Heap::folkHeapGetVersion [string map {uint8_t void} [::image_t data_ptr $im]]] + if {$expectedVersion != $version} { + Gpu::ImageManager::freeGpuImage $gim + dict unset ::ImCache $im + } + } + + set notInCache [dictset difference $imDrawSet $::ImCache] + set notInDrawSet [dictset difference $::ImCache $imDrawSet] + + set numImagesToCopy [dictset size $notInCache] + if {$numImagesToCopy > 0} { + if {[dictset size $::ImCache] + $numImagesToCopy > $IMCACHE_MAX_IMAGES} { + set numImagesToEvict \ + [expr {[dictset size $::ImCache] + $numImagesToCopy - $IMCACHE_MAX_IMAGES}] + + # What can we safely evict? + # - Anything that's stale + # - Anything that's not in use + set numImagesEvicted 0 + dict for {im v} $::ImCache { + if {$numImagesEvicted == $numImagesToEvict} { break } + + lassign $v gim expectedVersion + set version [Heap::folkHeapGetVersion [string map {uint8_t void} [::image_t data_ptr $im]]] + if {$expectedVersion != $version} { + Gpu::ImageManager::freeGpuImage $gim + dict unset ::ImCache $im + incr numImagesEvicted + continue + } + if {![dict exists $imDrawSet $im]} { + Gpu::ImageManager::freeGpuImage $gim + dict unset ::ImCache $im + incr numImagesEvicted + } + } + } + + dict for {im _} $notInCache { + # TODO: This is unsafe (has a race condition) -- we're + # not locking the image, so version and gim may diverge. + set version [Heap::folkHeapGetVersion [string map {uint8_t void} [::image_t data_ptr $im]]] + set gim [Gpu::ImageManager::copyImageToGpu $im] + dict set ::ImCache $im [list $gim $version] + } + } + } + + Wish $::thisProcess receives statements like \ + [list /someone/ wishes to draw an image with /...options/] + When /someone/ wishes to draw an image with /...options/ { + set x [dict get $options x] + set y [dict get $options y] + set im [dict get $options image] + set radians [dict get $options radians] + set scale [dict getdef $options scale 1.0] + + lassign [dict get $::ImCache $im] gim + + Wish the GPU draws pipeline "image" with arguments \ + [list $x $y $im $radians $scale] + } +} diff --git a/virtual-programs/display/stroke.folk b/virtual-programs/display/stroke.folk new file mode 100644 index 00000000..98eec038 --- /dev/null +++ b/virtual-programs/display/stroke.folk @@ -0,0 +1,33 @@ +Wish the GPU compiles pipeline "line" { + {vec2 from vec2 to float thickness vec4 color} { + vec2 vertices[4] = vec2[4]( + min(from, to) - thickness, + vec2(max(from.x, to.x) + thickness, min(from.y, to.y) - thickness), + vec2(min(from.x, to.x) - thickness, max(from.y, to.y) + thickness), + max(from, to) + thickness + ); + return vertices[gl_VertexIndex]; + } { + float l = length(to - from); + vec2 d = (to - from) / l; + vec2 q = (gl_FragCoord.xy - (from + to)*0.5); + q = mat2(d.x, -d.y, d.y, d.x) * q; + q = abs(q) - vec2(l, thickness)*0.5; + float dist = length(max(q, 0.0)) + min(max(q.x, q.y), 0.0); + + return dist < 0.0 ? color : vec4(0, 0, 0, 0); + } +} + +When /someone/ wishes to draw a stroke with /...options/ { + set points [dict get $options points] + set width [dict get $options width] + set color [getColor [dict get $options color]] + + for {set i 0} {$i < [expr {[llength $points] - 1}]} {incr i} { + set from [lindex $points $i] + set to [lindex $points [expr $i+1]] + Wish the GPU draws pipeline "line" with arguments \ + [list $from $to $width $color] + } +} diff --git a/virtual-programs/display/text.folk b/virtual-programs/display/text.folk new file mode 100644 index 00000000..3f2b4b5c --- /dev/null +++ b/virtual-programs/display/text.folk @@ -0,0 +1,150 @@ +On process "display" { + namespace eval font { + proc load {name} { + set csvFd [open "vendor/fonts/$name.csv" r]; set csv [read $csvFd]; close $csvFd + set glyphInfos [dict create] + foreach line [split $csv "\n"] { + set info [lassign [split $line ,] glyph] + lassign $info advance \ + planeLeft planeBottom planeRight planeTop \ + atlasLeft atlasBottom atlasRight atlasTop + dict set glyphInfos $glyph \ + [list $advance \ + [list $planeLeft $planeBottom $planeRight $planeTop] \ + [list $atlasLeft $atlasBottom $atlasRight $atlasTop]] + } + + set im [image load "[pwd]/vendor/fonts/$name.png"] + set gim [Gpu::ImageManager::copyImageToGpu $im] + + return [list $glyphInfos $im $gim] + } + proc hasGlyphInfo {font charCode} { dict exists [lindex $font 0] $charCode } + proc glyphInfo {font charCode} { dict get [lindex $font 0] $charCode } + proc atlasImage {font} { lindex $font 1 } + proc gpuAtlasImage {font} { lindex $font 2 } + + namespace export * + namespace ensemble create + } + set font [font load "PTSans-Regular"] + + set rotate $::rotate + set invBilinear $::invBilinear + set glyphMsd [Gpu::fn {sampler2D atlas vec4 atlasGlyphBounds vec2 glyphUv} vec4 { + vec2 atlasUv = mix(atlasGlyphBounds.xw, atlasGlyphBounds.zy, glyphUv); + return texture(atlas, vec2(atlasUv.x, 1.0-atlasUv.y)); + }] + set median [Gpu::fn {float r float g float b} float { + return max(min(r, g), min(max(r, g), b)); + }] + dict set ::pipelines "glyph" [Gpu::pipeline \ + {sampler2D atlas vec2 atlasSize + vec4 atlasGlyphBounds + vec4 planeGlyphBounds + vec2 pos float radians float em + fn rotate} { + float left = planeGlyphBounds[0] * em; + float bottom = planeGlyphBounds[1] * em; + float right = planeGlyphBounds[2] * em; + float top = planeGlyphBounds[3] * em; + vec2 a = pos + rotate(vec2(left, -top), -radians); + vec2 b = pos + rotate(vec2(right, -top), -radians); + vec2 c = pos + rotate(vec2(right, -bottom), -radians); + vec2 d = pos + rotate(vec2(left, -bottom), -radians); + + vec2 vertices[4] = vec2[4](a, b, d, c); + return vertices[gl_VertexIndex]; + } {fn rotate fn invBilinear fn glyphMsd fn median} { + float left = planeGlyphBounds[0] * em; + float bottom = planeGlyphBounds[1] * em; + float right = planeGlyphBounds[2] * em; + float top = planeGlyphBounds[3] * em; + vec2 a = pos + rotate(vec2(left, -top), -radians); + vec2 b = pos + rotate(vec2(right, -top), -radians); + vec2 c = pos + rotate(vec2(right, -bottom), -radians); + vec2 d = pos + rotate(vec2(left, -bottom), -radians); + + vec2 glyphUv = invBilinear(gl_FragCoord.xy, a, b, c, d); + if( max( abs(glyphUv.x-0.5), abs(glyphUv.y-0.5))>=0.5 ) { + return vec4(0, 0, 0, 0); + } + vec3 msd = glyphMsd(atlas, atlasGlyphBounds/atlasSize.xyxy, glyphUv).rgb; + float sd = median(msd.r, msd.g, msd.b); + float screenPxDistance = 4.5*(sd - 0.5); + float opacity = clamp(screenPxDistance + 0.5, 0.0, 1.0); + return mix(vec4(0, 0, 0, 0), vec4(1, 1, 1, 1), opacity); + }] + + fn textExtent {text scale} { + set em [* $scale 25.0] + set x 0; set y 0 + set width 0 + for {set i 0} {$i < [string length $text]} {incr i} { + set char [string index $text $i] + if {$char eq "\n"} { + set y [+ $y $em]; set x 0; continue + } + set charCode [scan $char %c] + if {[font hasGlyphInfo $font $charCode]} { + set glyphInfo [font glyphInfo $font $charCode] + } else { + set glyphInfo [font glyphInfo $font [scan ? %c]] + } + lassign $glyphInfo advance planeBounds atlasBounds + set x [+ $x [* $advance $em]] + if {$x > $width} { set width $x } + } + return [list $width [+ $y $em]] + } + + Wish $::thisProcess receives statements like \ + [list /someone/ wishes to draw text with /...options/] + + When /someone/ wishes to draw text with /...options/ { + set x0 [dict get $options x] + set y0 [dict get $options y] + set scale [dict getdef $options scale 1.0] + set text [dict get $options text] + set radians [dict get $options radians] + + set fontAtlas [font gpuAtlasImage $font] + set fontAtlasSize [list [::image width [font atlasImage $font]] \ + [::image height [font atlasImage $font]]] + + set extent [vec2 rotate [textExtent $text $scale] $radians] + + set em [* $scale 25.0] + + # TODO: Add text alignment/anchor options (right now, this + # setup centers the text). + set x0 [expr {$x0 - [lindex $extent 0]/2}] + set y0 [expr {$y0 - [lindex $extent 1]/2}] + set x $x0; set y $y0 + + set lineNum 0 + for {set i 0} {$i < [string length $text]} {incr i} { + set char [string index $text $i] + if {$char eq "\n"} { + incr lineNum + lassign [vec2 add [list $x0 $y0] \ + [vec2 rotate [list 0 [* $lineNum $em]] $radians]] x y + continue + } + set charCode [scan $char %c] + if {[font hasGlyphInfo $font $charCode]} { + set glyphInfo [font glyphInfo $font $charCode] + } else { + set glyphInfo [font glyphInfo $font [scan ? %c]] + } + lassign $glyphInfo advance planeBounds atlasBounds + if {$char ne " "} { + Wish the GPU draws pipeline "glyph" with arguments \ + [list $fontAtlas $fontAtlasSize \ + $atlasBounds $planeBounds [list $x $y] $radians $em] + } + lassign [vec2 add [list $x $y] \ + [vec2 rotate [list [* $advance $em] 0] $radians]] x y + } + } +} diff --git a/virtual-programs/label.folk b/virtual-programs/label.folk index 18c6e139..2a4458ad 100644 --- a/virtual-programs/label.folk +++ b/virtual-programs/label.folk @@ -1,15 +1,12 @@ When /thing/ has region /region/ { lassign [region centroid $region] x y - # set width [region width $region] - # set height [region height $region] set radians [region angle $region] When the collected matches for [list /someone/ wishes $thing is labelled /text/ with font /font/] are /matches/ { set text [join [lmap match $matches {dict get $match text}] "\n"] if {$text eq ""} { return } - set scale 1 - Display::text $x $y $scale $text $radians [dict get $match font] + Wish to draw text with x $x y $y text $text radians $radians font [dict get $match font] } } diff --git a/virtual-programs/outline.folk b/virtual-programs/outline.folk index f62ab0ba..cdfe6fbd 100644 --- a/virtual-programs/outline.folk +++ b/virtual-programs/outline.folk @@ -1,9 +1,9 @@ proc loopRegion {edges vertices weight color} { - foreach edge $edges { - set from [lindex $vertices [lindex $edge 0]] - set to [lindex $vertices [lindex $edge 1]] - Display::stroke [list $from $to] $weight $color - } + foreach edge $edges { + set from [lindex $vertices [lindex $edge 0]] + set to [lindex $vertices [lindex $edge 1]] + Wish to draw a stroke with points [list $from $to] width $weight color $color + } } When the collected matches for [list /someone/ wishes /thing/ is outlined /color/] are /matches/ { @@ -27,4 +27,4 @@ When /someone/ wishes /thing/ is outlined thick /color/ & /thing/ has region /re # FIXME: assumes path lassign $region vertices edges loopRegion $edges $vertices 6 $color -} \ No newline at end of file +} -- cgit v1.2.3 From 7b7a4b895f99a305263e03687b4f7cfa3065dd73 Mon Sep 17 00:00:00 2001 From: Omar Rizwan Date: Fri, 6 Oct 2023 17:57:29 -0400 Subject: display/text: Write glyphs straight to displaylist. Hack, but faster --- virtual-programs/display.folk | 8 +++++--- virtual-programs/display/text.folk | 16 ++++++++-------- 2 files changed, 13 insertions(+), 11 deletions(-) (limited to 'virtual-programs') diff --git a/virtual-programs/display.folk b/virtual-programs/display.folk index 0cfc63b2..07b94825 100644 --- a/virtual-programs/display.folk +++ b/virtual-programs/display.folk @@ -110,13 +110,15 @@ Start process "display" { } while true { + set ::displayList [list] Step + foreach match [Statements::findMatches {/someone/ wishes the GPU draws pipeline /name/ with arguments /args/}] { + lappend ::displayList [list Gpu::draw [dict get $::pipelines [dict get $match name]] {*}[dict get $match args]] + } set renderTime [baretime { Gpu::drawStart - foreach match [Statements::findMatches {/someone/ wishes the GPU draws pipeline /name/ with arguments /args/}] { - Gpu::draw [dict get $::pipelines [dict get $match name]] {*}[dict get $match args] - } + foreach displayCommand $::displayList { {*}$displayCommand } Gpu::drawEnd }] diff --git a/virtual-programs/display/text.folk b/virtual-programs/display/text.folk index 3f2b4b5c..412ce266 100644 --- a/virtual-programs/display/text.folk +++ b/virtual-programs/display/text.folk @@ -38,12 +38,12 @@ On process "display" { set median [Gpu::fn {float r float g float b} float { return max(min(r, g), min(max(r, g), b)); }] - dict set ::pipelines "glyph" [Gpu::pipeline \ - {sampler2D atlas vec2 atlasSize - vec4 atlasGlyphBounds - vec4 planeGlyphBounds - vec2 pos float radians float em - fn rotate} { + set glyph [Gpu::pipeline \ + {sampler2D atlas vec2 atlasSize + vec4 atlasGlyphBounds + vec4 planeGlyphBounds + vec2 pos float radians float em + fn rotate} { float left = planeGlyphBounds[0] * em; float bottom = planeGlyphBounds[1] * em; float right = planeGlyphBounds[2] * em; @@ -139,8 +139,8 @@ On process "display" { } lassign $glyphInfo advance planeBounds atlasBounds if {$char ne " "} { - Wish the GPU draws pipeline "glyph" with arguments \ - [list $fontAtlas $fontAtlasSize \ + lappend ::displayList \ + [list Gpu::draw $glyph $fontAtlas $fontAtlasSize \ $atlasBounds $planeBounds [list $x $y] $radians $em] } lassign [vec2 add [list $x $y] \ -- cgit v1.2.3 From e91f7c12cb45b7430b08a860993ab5dbbf599b81 Mon Sep 17 00:00:00 2001 From: Omar Rizwan Date: Fri, 6 Oct 2023 17:59:03 -0400 Subject: dict getdef -> dict_getdef. Much, much faster --- virtual-programs/display/circle.folk | 4 ++-- virtual-programs/display/image.folk | 2 +- virtual-programs/display/text.folk | 2 +- 3 files changed, 4 insertions(+), 4 deletions(-) (limited to 'virtual-programs') diff --git a/virtual-programs/display/circle.folk b/virtual-programs/display/circle.folk index f50813eb..2951f3a9 100644 --- a/virtual-programs/display/circle.folk +++ b/virtual-programs/display/circle.folk @@ -19,12 +19,12 @@ Wish the GPU compiles pipeline "circle" { } When /someone/ wishes to draw a circle with /...options/ { - set center [dict getdef $options center ""] + 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 color [getColor [dict get $options color]] - set filled [dict getdef $options filled false] + set filled [dict_getdef $options filled false] Wish the GPU draws pipeline "circle" with arguments \ [list $center $radius $thickness $color $filled] diff --git a/virtual-programs/display/image.folk b/virtual-programs/display/image.folk index 4665a236..8ef1cc30 100644 --- a/virtual-programs/display/image.folk +++ b/virtual-programs/display/image.folk @@ -89,7 +89,7 @@ On process "display" { set y [dict get $options y] set im [dict get $options image] set radians [dict get $options radians] - set scale [dict getdef $options scale 1.0] + set scale [dict_getdef $options scale 1.0] lassign [dict get $::ImCache $im] gim diff --git a/virtual-programs/display/text.folk b/virtual-programs/display/text.folk index 412ce266..1c8f6c45 100644 --- a/virtual-programs/display/text.folk +++ b/virtual-programs/display/text.folk @@ -104,7 +104,7 @@ On process "display" { When /someone/ wishes to draw text with /...options/ { set x0 [dict get $options x] set y0 [dict get $options y] - set scale [dict getdef $options scale 1.0] + set scale [dict_getdef $options scale 1.0] set text [dict get $options text] set radians [dict get $options radians] -- cgit v1.2.3 From ce6a82e7db7447e90650df00ccd185e9b258f1ae Mon Sep 17 00:00:00 2001 From: Omar Rizwan Date: Mon, 9 Oct 2023 19:02:02 -0400 Subject: text: Draw with wish; stops the blinking bug. (because now, the text draws every frame, instead of just when it happens to change.) --- virtual-programs/display/text.folk | 9 +++++---- 1 file changed, 5 insertions(+), 4 deletions(-) (limited to 'virtual-programs') diff --git a/virtual-programs/display/text.folk b/virtual-programs/display/text.folk index 1c8f6c45..992e77b1 100644 --- a/virtual-programs/display/text.folk +++ b/virtual-programs/display/text.folk @@ -38,7 +38,8 @@ On process "display" { set median [Gpu::fn {float r float g float b} float { return max(min(r, g), min(max(r, g), b)); }] - set glyph [Gpu::pipeline \ + # TODO: Do this with a wish, instead of hard-coding the global dict. + dict set ::pipelines "glyph" [Gpu::pipeline \ {sampler2D atlas vec2 atlasSize vec4 atlasGlyphBounds vec4 planeGlyphBounds @@ -74,7 +75,7 @@ On process "display" { float screenPxDistance = 4.5*(sd - 0.5); float opacity = clamp(screenPxDistance + 0.5, 0.0, 1.0); return mix(vec4(0, 0, 0, 0), vec4(1, 1, 1, 1), opacity); - }] + }] fn textExtent {text scale} { set em [* $scale 25.0] @@ -139,8 +140,8 @@ On process "display" { } lassign $glyphInfo advance planeBounds atlasBounds if {$char ne " "} { - lappend ::displayList \ - [list Gpu::draw $glyph $fontAtlas $fontAtlasSize \ + Wish the GPU draws pipeline "glyph" with arguments \ + [list $fontAtlas $fontAtlasSize \ $atlasBounds $planeBounds [list $x $y] $radians $em] } lassign [vec2 add [list $x $y] \ -- cgit v1.2.3 From cc418917fcf9a95873401a3f59b68771c8c4a1e7 Mon Sep 17 00:00:00 2001 From: Omar Rizwan Date: Thu, 12 Oct 2023 12:42:56 -0400 Subject: text: Batch glyphs into one wish -- fixes performance. --- virtual-programs/display.folk | 8 ++++++++ virtual-programs/display/text.folk | 7 ++++++- 2 files changed, 14 insertions(+), 1 deletion(-) (limited to 'virtual-programs') diff --git a/virtual-programs/display.folk b/virtual-programs/display.folk index 07b94825..387d300a 100644 --- a/virtual-programs/display.folk +++ b/virtual-programs/display.folk @@ -101,6 +101,8 @@ Start process "display" { [list /someone/ wishes the GPU compiles pipeline /name/ /source/] Wish $::thisProcess receives statements like \ [list /someone/ wishes the GPU draws pipeline /name/ with arguments /args/] + Wish $::thisProcess receives statements like \ + [list /someone/ wishes the GPU draws pipeline /name/ with instances /args/] Wish $::thisProcess shares statements like \ [list /someone/ claims the display time is /displayTime/] @@ -115,6 +117,12 @@ Start process "display" { foreach match [Statements::findMatches {/someone/ wishes the GPU draws pipeline /name/ with arguments /args/}] { lappend ::displayList [list Gpu::draw [dict get $::pipelines [dict get $match name]] {*}[dict get $match args]] } + foreach match [Statements::findMatches {/someone/ wishes the GPU draws pipeline /name/ with instances /instances/}] { + set pipeline [dict get $::pipelines [dict get $match name]] + foreach instance [dict get $match instances] { + lappend ::displayList [list Gpu::draw $pipeline {*}$instance] + } + } set renderTime [baretime { Gpu::drawStart diff --git a/virtual-programs/display/text.folk b/virtual-programs/display/text.folk index 992e77b1..a6c828b9 100644 --- a/virtual-programs/display/text.folk +++ b/virtual-programs/display/text.folk @@ -124,6 +124,7 @@ On process "display" { set x $x0; set y $y0 set lineNum 0 + set instances [list] for {set i 0} {$i < [string length $text]} {incr i} { set char [string index $text $i] if {$char eq "\n"} { @@ -140,12 +141,16 @@ On process "display" { } lassign $glyphInfo advance planeBounds atlasBounds if {$char ne " "} { - Wish the GPU draws pipeline "glyph" with arguments \ + lappend instances \ [list $fontAtlas $fontAtlasSize \ $atlasBounds $planeBounds [list $x $y] $radians $em] } lassign [vec2 add [list $x $y] \ [vec2 rotate [list [* $advance $em] 0] $radians]] x y } + + # We need to batch into one wish so we don't deal with n^2 + # checks for existing statements for n glyphs. + Wish the GPU draws pipeline "glyph" with instances $instances } } -- cgit v1.2.3 From 12a58eb55b1afd7dad5b9865b9e86fc85ac1d675 Mon Sep 17 00:00:00 2001 From: Omar Rizwan Date: Thu, 12 Oct 2023 12:49:00 -0400 Subject: display: Error on Display:: calls; implement titles with wish --- virtual-programs/display.folk | 2 +- virtual-programs/display/text.folk | 8 ++++++-- virtual-programs/title.folk | 4 ++-- 3 files changed, 9 insertions(+), 5 deletions(-) (limited to 'virtual-programs') diff --git a/virtual-programs/display.folk b/virtual-programs/display.folk index 387d300a..ed3fb62d 100644 --- a/virtual-programs/display.folk +++ b/virtual-programs/display.folk @@ -20,7 +20,7 @@ namespace eval ::Display { foreach func {stroke circle text fillTriangle fillQuad fillPolygon} { proc $func args { set func [lindex [info level 0] 0] - uplevel [list Wish display runs [list $func {*}$args] on layer $::Display::LAYER] + error "$func has been removed; use GPU shaders" } } } diff --git a/virtual-programs/display/text.folk b/virtual-programs/display/text.folk index a6c828b9..14f0294a 100644 --- a/virtual-programs/display/text.folk +++ b/virtual-programs/display/text.folk @@ -103,8 +103,12 @@ On process "display" { [list /someone/ wishes to draw text with /...options/] When /someone/ wishes to draw text with /...options/ { - set x0 [dict get $options x] - set y0 [dict get $options y] + if {[dict exists $options center]} { + lassign [dict get $options center] x0 y0 + } else { + set x0 [dict get $options x] + set y0 [dict get $options y] + } set scale [dict_getdef $options scale 1.0] set text [dict get $options text] set radians [dict get $options radians] diff --git a/virtual-programs/title.folk b/virtual-programs/title.folk index fccacc17..3187ed3c 100644 --- a/virtual-programs/title.folk +++ b/virtual-programs/title.folk @@ -14,7 +14,7 @@ When /thing/ has region /region/ { if {$text eq ""} { return } set scale 1 - Display::text {*}$top $scale $text $radians + Wish to draw text with center $top scale $scale text $text radians $radians } When the collected matches for [list /someone/ wishes $thing is footnoted /text/] are /matches/ { @@ -22,6 +22,6 @@ When /thing/ has region /region/ { if {$text eq ""} { return } set scale 1 - Display::text {*}$bot $scale $text $radians + Wish to draw text with center $bot scale $scale text $text radians $radians } } -- cgit v1.2.3 From 913f16d12bdf2208c35093350276ca0b6493c81c Mon Sep 17 00:00:00 2001 From: Omar Rizwan Date: Thu, 12 Oct 2023 15:56:42 -0400 Subject: image: WIP: Images are starting to work. --- virtual-programs/display/image.folk | 111 ++++++++++++++++++++---------------- virtual-programs/display/text.folk | 1 + virtual-programs/images.folk | 2 +- virtual-programs/mask-tags.folk | 2 +- 4 files changed, 66 insertions(+), 50 deletions(-) (limited to 'virtual-programs') diff --git a/virtual-programs/display/image.folk b/virtual-programs/display/image.folk index 8ef1cc30..07cf342a 100644 --- a/virtual-programs/display/image.folk +++ b/virtual-programs/display/image.folk @@ -1,7 +1,8 @@ On process "display" { set invBilinear $::invBilinear set rotate $::rotate - set image [Gpu::pipeline {sampler2D image vec2 imageSize + # TODO: Do this with a wish, instead of hard-coding the global dict. + dict set ::pipelines "image" [Gpu::pipeline {sampler2D image vec2 imageSize vec2 pos float radians float scale fn rotate} { vec2 a = pos + rotate(-imageSize/2, -radians); @@ -23,61 +24,70 @@ On process "display" { return vec4(0.0, 0.0, 0.0, 0.0); }] - set ::ImCache [dict create] - variable IMCACHE_MAX_IMAGES [- $Gpu::ImageManager::GPU_MAX_IMAGES 1] - proc checkImCacheAndCopyIfNeeded {imDrawSet} { - variable ::ImCache - variable IMCACHE_MAX_IMAGES + When the GPU has loaded /nfonts/ fonts { + puts LOADING + namespace eval ::ImageCache { + # Backing store: stores triples of (GPU image handle, heap slot version, refcount). + variable cache [dict create] + variable CACHE_MAX_SIZE [- $Gpu::ImageManager::GPU_MAX_IMAGES [uplevel {set nfonts}]] - dict for {im v} $imDrawSet { - if {![dict exists $::ImCache $im]} { continue } - # Check for staleness and remove from cache if so. - lassign [dict get $::ImCache $im] gim expectedVersion - set version [Heap::folkHeapGetVersion [string map {uint8_t void} [::image_t data_ptr $im]]] - if {$expectedVersion != $version} { - Gpu::ImageManager::freeGpuImage $gim - dict unset ::ImCache $im + proc getOrInsertAndIncr {im} { + variable cache + variable CACHE_MAX_SIZE + if {[dict exists $cache $im]} { + lassign [dict get $cache $im] gim cachedVersion refcount + set version [Heap::folkHeapGetVersion [string map {uint8_t void} [::image_t data_ptr $im]]] + if {$version == $cachedVersion} { + dict set cache $im [list $gim $cachedVersion [+ $refcount 1]] + return $gim + } else { + remove $im + } + } + if {[dict size $cache] >= $CACHE_MAX_SIZE} { + evict + } + set version [Heap::folkHeapGetVersion [string map {uint8_t void} [::image_t data_ptr $im]]] + set gim [Gpu::ImageManager::copyImageToGpu $im] + dict set cache $im [list $gim $version 1] + return $gim } - } - - set notInCache [dictset difference $imDrawSet $::ImCache] - set notInDrawSet [dictset difference $::ImCache $imDrawSet] - set numImagesToCopy [dictset size $notInCache] - if {$numImagesToCopy > 0} { - if {[dictset size $::ImCache] + $numImagesToCopy > $IMCACHE_MAX_IMAGES} { - set numImagesToEvict \ - [expr {[dictset size $::ImCache] + $numImagesToCopy - $IMCACHE_MAX_IMAGES}] - - # What can we safely evict? - # - Anything that's stale - # - Anything that's not in use - set numImagesEvicted 0 - dict for {im v} $::ImCache { - if {$numImagesEvicted == $numImagesToEvict} { break } + proc decr {im} { + variable cache + set version [Heap::folkHeapGetVersion [string map {uint8_t void} [::image_t data_ptr $im]]] + lassign [dict get $cache $im] gim cachedVersion refcount + incr refcount -1 + if {$refcount == 0} { + remove $im + } else { + dict set cache $im [list $gim $version $refcount] + } + } + proc evict {} { + variable cache + # Evict stale. + dict for {im v} $cache { lassign $v gim expectedVersion set version [Heap::folkHeapGetVersion [string map {uint8_t void} [::image_t data_ptr $im]]] if {$expectedVersion != $version} { Gpu::ImageManager::freeGpuImage $gim - dict unset ::ImCache $im - incr numImagesEvicted - continue - } - if {![dict exists $imDrawSet $im]} { - Gpu::ImageManager::freeGpuImage $gim - dict unset ::ImCache $im - incr numImagesEvicted + dict unset cache $im } } + if {[dict size $cache] >= $CACHE_MAX_SIZE} { + error "image: Unable to evict enough from image cache." + } } - dict for {im _} $notInCache { - # TODO: This is unsafe (has a race condition) -- we're - # not locking the image, so version and gim may diverge. - set version [Heap::folkHeapGetVersion [string map {uint8_t void} [::image_t data_ptr $im]]] - set gim [Gpu::ImageManager::copyImageToGpu $im] - dict set ::ImCache $im [list $gim $version] + proc remove {im} { + variable cache + if {[dict exists $cache $im]} { + lassign [dict get $cache $im] gim + Gpu::ImageManager::freeGpuImage $gim + } + dict unset cache $im } } } @@ -85,15 +95,20 @@ On process "display" { Wish $::thisProcess receives statements like \ [list /someone/ wishes to draw an image with /...options/] When /someone/ wishes to draw an image with /...options/ { - set x [dict get $options x] - set y [dict get $options y] + if {[dict exists $options center]} { + set center [dict get $options center] + } else { + set center [list [dict get $options x] [dict get $options y]] + } set im [dict get $options image] set radians [dict get $options radians] set scale [dict_getdef $options scale 1.0] - lassign [dict get $::ImCache $im] gim + set gim [ImageCache::getOrInsertAndIncr $im] + On unmatch { ImageCache::decr $im } Wish the GPU draws pipeline "image" with arguments \ - [list $x $y $im $radians $scale] + [list $gim [list [image_t width $im] [image_t height $im]] \ + $center $radians $scale] } } diff --git a/virtual-programs/display/text.folk b/virtual-programs/display/text.folk index 14f0294a..64c96885 100644 --- a/virtual-programs/display/text.folk +++ b/virtual-programs/display/text.folk @@ -28,6 +28,7 @@ On process "display" { namespace ensemble create } set font [font load "PTSans-Regular"] + Claim the GPU has loaded 1 fonts set rotate $::rotate set invBilinear $::invBilinear diff --git a/virtual-programs/images.folk b/virtual-programs/images.folk index e748cd11..5c9e4d80 100644 --- a/virtual-programs/images.folk +++ b/virtual-programs/images.folk @@ -348,7 +348,7 @@ When /someone/ wishes /p/ displays image /im/ { # set scale [expr {min($width / [image width $im], # $height / [image height $im])}] # Wish $p is labelled $im - Wish display runs [list Display::image {*}$center $im [region angle $r] 1] + Wish to draw an image with center $center image $im radians [region angle $r] } # On unmatch { # # HACK: Leaves time for the display to finish trying to display this. diff --git a/virtual-programs/mask-tags.folk b/virtual-programs/mask-tags.folk index 4f0ae4b2..6bf9d474 100644 --- a/virtual-programs/mask-tags.folk +++ b/virtual-programs/mask-tags.folk @@ -12,5 +12,5 @@ When tag /something/ has corners /corners/ { set p1 [lindex $corners 1] set p2 [lindex $corners 2] set p3 [lindex $corners 3] - Display::drawOnTop Display::fillQuad $p0 $p1 $p2 $p3 black + Wish to draw a quad with p0 $p0 p1 $p1 p2 $p2 p3 $p3 color black } \ No newline at end of file -- cgit v1.2.3 From 56b622663ff4d98b58a0903f224bf781a158dbc2 Mon Sep 17 00:00:00 2001 From: Omar Rizwan Date: Thu, 12 Oct 2023 16:07:18 -0400 Subject: images: WIP: camera slice --- virtual-programs/images.folk | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'virtual-programs') diff --git a/virtual-programs/images.folk b/virtual-programs/images.folk index 5c9e4d80..844ca119 100644 --- a/virtual-programs/images.folk +++ b/virtual-programs/images.folk @@ -334,7 +334,7 @@ When /someone/ wishes /p/ displays camera slice /slice/ & /p/ has region /r/ { # set scale [expr {$Display::WIDTH / $Camera::WIDTH}] # Use 1x scale instead of $scale so the projected tag doesn't redetect. # TODO: Mask the tag out? - Wish display runs [list Display::image {*}$center $slice 0 1] + Wish to draw an image with center $center image $slice radians 0 scale 1 } When /someone/ wishes /p/ displays image /im/ { -- cgit v1.2.3 From 0a69f89605a73c87814fda86860099829d6ffa5c Mon Sep 17 00:00:00 2001 From: Omar Rizwan Date: Fri, 13 Oct 2023 15:46:22 -0400 Subject: image: WIP: Replace cache refcount with simpler LRU scheme We don't really want to be constantly throwing out and recopying images when they flip and back, and it's not a big deal to fault an image now. Works well for static Toph image; doesn't work for camera slice yet (validation errors, and it just blinks a lot). --- virtual-programs/display/image.folk | 48 +++++++++++++++++++------------------ 1 file changed, 25 insertions(+), 23 deletions(-) (limited to 'virtual-programs') diff --git a/virtual-programs/display/image.folk b/virtual-programs/display/image.folk index 07cf342a..91e571b9 100644 --- a/virtual-programs/display/image.folk +++ b/virtual-programs/display/image.folk @@ -25,60 +25,63 @@ On process "display" { }] When the GPU has loaded /nfonts/ fonts { - puts LOADING namespace eval ::ImageCache { - # Backing store: stores triples of (GPU image handle, heap slot version, refcount). + # Backing store: stores pairs of (GPU image handle, heap slot version). variable cache [dict create] variable CACHE_MAX_SIZE [- $Gpu::ImageManager::GPU_MAX_IMAGES [uplevel {set nfonts}]] - proc getOrInsertAndIncr {im} { + proc getOrInsert {im} { variable cache variable CACHE_MAX_SIZE if {[dict exists $cache $im]} { - lassign [dict get $cache $im] gim cachedVersion refcount + lassign [dict get $cache $im] gim cachedVersion set version [Heap::folkHeapGetVersion [string map {uint8_t void} [::image_t data_ptr $im]]] if {$version == $cachedVersion} { - dict set cache $im [list $gim $cachedVersion [+ $refcount 1]] + # Bump this image to end of cache since it's + # most-recently-accessed. + dict unset cache $im + dict set cache $im [list $gim $cachedVersion] return $gim } else { + # This image is stale. Don't retain it. remove $im } } if {[dict size $cache] >= $CACHE_MAX_SIZE} { evict } + if {[dict size $cache] >= $CACHE_MAX_SIZE} { + puts stderr "image: Warning: Out of slots in GPU image cache." + } set version [Heap::folkHeapGetVersion [string map {uint8_t void} [::image_t data_ptr $im]]] set gim [Gpu::ImageManager::copyImageToGpu $im] - dict set cache $im [list $gim $version 1] + dict set cache $im [list $gim $version] return $gim } - proc decr {im} { - variable cache - set version [Heap::folkHeapGetVersion [string map {uint8_t void} [::image_t data_ptr $im]]] - lassign [dict get $cache $im] gim cachedVersion refcount - incr refcount -1 - if {$refcount == 0} { - remove $im - } else { - dict set cache $im [list $gim $version $refcount] - } - } - proc evict {} { variable cache + variable CACHE_MAX_SIZE + set numToEvict [expr {$CACHE_MAX_SIZE - [dict size $cache]}] + set numEvicted [list] # Evict stale. dict for {im v} $cache { lassign $v gim expectedVersion set version [Heap::folkHeapGetVersion [string map {uint8_t void} [::image_t data_ptr $im]]] if {$expectedVersion != $version} { Gpu::ImageManager::freeGpuImage $gim - dict unset cache $im + lappend numEvicted $im } } - if {[dict size $cache] >= $CACHE_MAX_SIZE} { - error "image: Unable to evict enough from image cache." + # Evict old. + dict for {im v} $cache { + if {$numToEvict - [llength $numEvicted] == 0} { + break + } + Gpu::ImageManager::freeGpuImage $im + lappend numEvicted $im } + foreach im $numEvicted { dict unset cache $im } } proc remove {im} { @@ -104,8 +107,7 @@ On process "display" { set radians [dict get $options radians] set scale [dict_getdef $options scale 1.0] - set gim [ImageCache::getOrInsertAndIncr $im] - On unmatch { ImageCache::decr $im } + set gim [ImageCache::getOrInsert $im] Wish the GPU draws pipeline "image" with arguments \ [list $gim [list [image_t width $im] [image_t height $im]] \ -- cgit v1.2.3 From 5fea5647e7f40c0f5cb99eccd7ab65319a9aa571 Mon Sep 17 00:00:00 2001 From: Omar Rizwan Date: Fri, 13 Oct 2023 16:18:49 -0400 Subject: image,Gpu: Fix cache, for the most part (was double-freeing) --- virtual-programs/display/image.folk | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) (limited to 'virtual-programs') diff --git a/virtual-programs/display/image.folk b/virtual-programs/display/image.folk index 91e571b9..28c66a3b 100644 --- a/virtual-programs/display/image.folk +++ b/virtual-programs/display/image.folk @@ -73,12 +73,14 @@ On process "display" { lappend numEvicted $im } } + foreach im $numEvicted { dict unset cache $im } # Evict old. dict for {im v} $cache { if {$numToEvict - [llength $numEvicted] == 0} { break } - Gpu::ImageManager::freeGpuImage $im + lassign $v gim + Gpu::ImageManager::freeGpuImage $gim lappend numEvicted $im } foreach im $numEvicted { dict unset cache $im } -- cgit v1.2.3 From 4e944eb62b0b1be680f6e4aa372de9c2cbb2d195 Mon Sep 17 00:00:00 2001 From: Omar Rizwan Date: Fri, 13 Oct 2023 16:52:36 -0400 Subject: image: Actually fix cache math --- virtual-programs/display/image.folk | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'virtual-programs') diff --git a/virtual-programs/display/image.folk b/virtual-programs/display/image.folk index 28c66a3b..23246d45 100644 --- a/virtual-programs/display/image.folk +++ b/virtual-programs/display/image.folk @@ -62,7 +62,7 @@ On process "display" { proc evict {} { variable cache variable CACHE_MAX_SIZE - set numToEvict [expr {$CACHE_MAX_SIZE - [dict size $cache]}] + set numToEvict [expr {([dict size $cache] + 1) - $CACHE_MAX_SIZE}] set numEvicted [list] # Evict stale. dict for {im v} $cache { @@ -76,7 +76,7 @@ On process "display" { foreach im $numEvicted { dict unset cache $im } # Evict old. dict for {im v} $cache { - if {$numToEvict - [llength $numEvicted] == 0} { + if {$numToEvict - [llength $numEvicted] <= 0} { break } lassign $v gim -- cgit v1.2.3 From 2c2163396b0aec16bc608e2c6c329e1b4f2e0a56 Mon Sep 17 00:00:00 2001 From: Omar Rizwan Date: Fri, 13 Oct 2023 17:04:21 -0400 Subject: display,mask-tags,fill: Add layer support Only implemented minimum for mask-tags for now. --- virtual-programs/display.folk | 39 +++++++++++++++++++++----------------- virtual-programs/display/fill.folk | 4 ++-- virtual-programs/mask-tags.folk | 2 +- 3 files changed, 25 insertions(+), 20 deletions(-) (limited to 'virtual-programs') diff --git a/virtual-programs/display.folk b/virtual-programs/display.folk index ed3fb62d..826d37f0 100644 --- a/virtual-programs/display.folk +++ b/virtual-programs/display.folk @@ -8,19 +8,13 @@ namespace eval ::Display { regexp {mode "(\d+)x(\d+)"} [exec fbset] -> WIDTH HEIGHT } - proc drawOnTop {func args} { - set ::Display::LAYER 1 - uplevel [list $func {*}$args] - set ::Display::LAYER 0 - } - # Create proxy versions of drawing primitives for the main Folk # process (that will forward those draw commands to the display # subprocess). - foreach func {stroke circle text fillTriangle fillQuad fillPolygon} { + foreach func {stroke circle text fillTriangle fillQuad fillPolygon image} { proc $func args { set func [lindex [info level 0] 0] - error "$func has been removed; use GPU shaders" + error "$func has been removed; use GPU wishes/shaders" } } } @@ -98,11 +92,7 @@ Start process "display" { } Wish $::thisProcess receives statements like \ - [list /someone/ wishes the GPU compiles pipeline /name/ /source/] - Wish $::thisProcess receives statements like \ - [list /someone/ wishes the GPU draws pipeline /name/ with arguments /args/] - Wish $::thisProcess receives statements like \ - [list /someone/ wishes the GPU draws pipeline /name/ with instances /args/] + [list /someone/ wishes the GPU /...anything/] Wish $::thisProcess shares statements like \ [list /someone/ claims the display time is /displayTime/] @@ -112,21 +102,36 @@ Start process "display" { } while true { - set ::displayList [list] + set ::displayList [dict create] ;# Keys are layer numbers; values are lists of commands Step foreach match [Statements::findMatches {/someone/ wishes the GPU draws pipeline /name/ with arguments /args/}] { - lappend ::displayList [list Gpu::draw [dict get $::pipelines [dict get $match name]] {*}[dict get $match args]] + dict lappend ::displayList 0 [list Gpu::draw [dict get $::pipelines [dict get $match name]] {*}[dict get $match args]] + } + foreach match [Statements::findMatches {/someone/ wishes the GPU draws pipeline /name/ with arguments /args/ layer /layer/}] { + dict lappend ::displayList [dict get $match layer] \ + [list Gpu::draw [dict get $::pipelines [dict get $match name]] {*}[dict get $match args]] } foreach match [Statements::findMatches {/someone/ wishes the GPU draws pipeline /name/ with instances /instances/}] { set pipeline [dict get $::pipelines [dict get $match name]] foreach instance [dict get $match instances] { - lappend ::displayList [list Gpu::draw $pipeline {*}$instance] + dict lappend ::displayList 0 [list Gpu::draw $pipeline {*}$instance] } } + foreach match [Statements::findMatches {/someone/ wishes the GPU draws pipeline /name/ with instances /instances/ layer /layer/}] { + set layer [dict get $match layer] + set pipeline [dict get $::pipelines [dict get $match name]] + foreach instance [dict get $match instances] { + dict lappend ::displayList $layer [list Gpu::draw $pipeline {*}$instance] + } + } + # TODO: Sort by layer set renderTime [baretime { Gpu::drawStart - foreach displayCommand $::displayList { {*}$displayCommand } + foreach layer [lsort -real [dict keys $::displayList]] { + set layerDisplayList [dict get $::displayList $layer] + foreach displayCommand $layerDisplayList { {*}$displayCommand } + } Gpu::drawEnd }] diff --git a/virtual-programs/display/fill.folk b/virtual-programs/display/fill.folk index dd9e199d..52039661 100644 --- a/virtual-programs/display/fill.folk +++ b/virtual-programs/display/fill.folk @@ -16,9 +16,9 @@ When /someone/ wishes to draw a triangle with /...options/ { When /someone/ wishes to draw a quad with /...options/ { dict with options { Wish the GPU draws pipeline "fillTriangle" with arguments \ - [list $p0 $p1 $p2 [getColor $color]] + [list $p0 $p1 $p2 [getColor $color]] layer $layer Wish the GPU draws pipeline "fillTriangle" with arguments \ - [list $p0 $p1 $p3 [getColor $color]] + [list $p0 $p1 $p3 [getColor $color]] layer $layer } } When /someone/ wishes to draw a polygon with /...options/ { diff --git a/virtual-programs/mask-tags.folk b/virtual-programs/mask-tags.folk index 6bf9d474..749bb26c 100644 --- a/virtual-programs/mask-tags.folk +++ b/virtual-programs/mask-tags.folk @@ -12,5 +12,5 @@ When tag /something/ has corners /corners/ { set p1 [lindex $corners 1] set p2 [lindex $corners 2] set p3 [lindex $corners 3] - Wish to draw a quad with p0 $p0 p1 $p1 p2 $p2 p3 $p3 color black + Wish to draw a quad with p0 $p0 p1 $p1 p2 $p2 p3 $p3 color black layer 1 } \ No newline at end of file -- cgit v1.2.3 From a285be8d97d5a75fce4a0a9bef9c755b8dc1acc2 Mon Sep 17 00:00:00 2001 From: Omar Rizwan Date: Fri, 13 Oct 2023 17:38:02 -0400 Subject: fill: Fix quad fill (& mask-tags) --- virtual-programs/display/fill.folk | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'virtual-programs') diff --git a/virtual-programs/display/fill.folk b/virtual-programs/display/fill.folk index 52039661..ae3626f4 100644 --- a/virtual-programs/display/fill.folk +++ b/virtual-programs/display/fill.folk @@ -16,7 +16,7 @@ When /someone/ wishes to draw a triangle with /...options/ { When /someone/ wishes to draw a quad with /...options/ { dict with options { Wish the GPU draws pipeline "fillTriangle" with arguments \ - [list $p0 $p1 $p2 [getColor $color]] layer $layer + [list $p1 $p2 $p3 [getColor $color]] layer $layer Wish the GPU draws pipeline "fillTriangle" with arguments \ [list $p0 $p1 $p3 [getColor $color]] layer $layer } -- cgit v1.2.3 From 38999289e04a7659fed0501278ec52cd7ca9f0ad Mon Sep 17 00:00:00 2001 From: Omar Rizwan Date: Fri, 13 Oct 2023 17:43:13 -0400 Subject: display: Report shader compilation errors, catch render errors --- virtual-programs/display.folk | 16 +++++++++++++--- 1 file changed, 13 insertions(+), 3 deletions(-) (limited to 'virtual-programs') diff --git a/virtual-programs/display.folk b/virtual-programs/display.folk index 826d37f0..21fd1776 100644 --- a/virtual-programs/display.folk +++ b/virtual-programs/display.folk @@ -95,10 +95,17 @@ Start process "display" { [list /someone/ wishes the GPU /...anything/] Wish $::thisProcess shares statements like \ [list /someone/ claims the display time is /displayTime/] + Wish $::thisProcess shares statements like \ + [list /someone/ has error /err/ with info /errorInfo/] set ::pipelines [dict create] - When /someone/ wishes the GPU compiles pipeline /name/ /source/ { - dict set ::pipelines $name [Gpu::pipeline {*}$source] + When /wisher/ wishes the GPU compiles pipeline /name/ /source/ { + try { + dict set ::pipelines $name [Gpu::pipeline {*}$source] + } on error e { + puts stderr $::errorInfo + Say $wisher has error $e with info $::errorInfo + } } while true { @@ -130,7 +137,10 @@ Start process "display" { Gpu::drawStart foreach layer [lsort -real [dict keys $::displayList]] { set layerDisplayList [dict get $::displayList $layer] - foreach displayCommand $layerDisplayList { {*}$displayCommand } + foreach displayCommand $layerDisplayList { + try { {*}$displayCommand } \ + on error e { puts stderr $::errorInfo } + } } Gpu::drawEnd }] -- cgit v1.2.3 From af55d786e915afb1279805d18dd39c0f9e05fab2 Mon Sep 17 00:00:00 2001 From: Omar Rizwan Date: Fri, 13 Oct 2023 18:10:28 -0400 Subject: display: nit --- virtual-programs/display.folk | 1 - 1 file changed, 1 deletion(-) (limited to 'virtual-programs') diff --git a/virtual-programs/display.folk b/virtual-programs/display.folk index 21fd1776..9df7575c 100644 --- a/virtual-programs/display.folk +++ b/virtual-programs/display.folk @@ -131,7 +131,6 @@ Start process "display" { dict lappend ::displayList $layer [list Gpu::draw $pipeline {*}$instance] } } - # TODO: Sort by layer set renderTime [baretime { Gpu::drawStart -- cgit v1.2.3 From 3f3eece201d0c5dc8087788846f4a30e7bd297df Mon Sep 17 00:00:00 2001 From: Omar Rizwan Date: Fri, 13 Oct 2023 18:15:54 -0400 Subject: text: Restore font support --- virtual-programs/display/text.folk | 24 ++++++++++++++++++++---- 1 file changed, 20 insertions(+), 4 deletions(-) (limited to 'virtual-programs') diff --git a/virtual-programs/display/text.folk b/virtual-programs/display/text.folk index 64c96885..95901380 100644 --- a/virtual-programs/display/text.folk +++ b/virtual-programs/display/text.folk @@ -27,8 +27,18 @@ On process "display" { namespace export * namespace ensemble create } - set font [font load "PTSans-Regular"] - Claim the GPU has loaded 1 fonts + set ::FontCache [dict create] + # load all fonts into the fontCache + foreach fontPath [list {*}[glob vendor/fonts/*.png]] { + set fontName "" + regexp {vendor/fonts/(.*).png} $fontPath -> fontName + if {!($fontName eq "")} { + puts "Loaded $fontName into font cache" + set fontdata [font load $fontName] + dict set ::FontCache $fontName $fontdata + } + } + Claim the GPU has loaded [dict size $::FontCache] fonts set rotate $::rotate set invBilinear $::invBilinear @@ -78,7 +88,7 @@ On process "display" { return mix(vec4(0, 0, 0, 0), vec4(1, 1, 1, 1), opacity); }] - fn textExtent {text scale} { + fn textExtent {text scale font} { set em [* $scale 25.0] set x 0; set y 0 set width 0 @@ -111,14 +121,20 @@ On process "display" { set y0 [dict get $options y] } set scale [dict_getdef $options scale 1.0] + set font [dict_getdef $options font "PTSans-Regular"] set text [dict get $options text] set radians [dict get $options radians] + if {!([dict exists $::FontCache $font])} { + throw {DISPLAY FONT {font doesn't exist}} "$font doesn't exist" + } + set font [dict get $::FontCache $font] + set fontAtlas [font gpuAtlasImage $font] set fontAtlasSize [list [::image width [font atlasImage $font]] \ [::image height [font atlasImage $font]]] - set extent [vec2 rotate [textExtent $text $scale] $radians] + set extent [vec2 rotate [textExtent $text $scale $font] $radians] set em [* $scale 25.0] -- cgit v1.2.3 From 3e1ed38511ed5bbfc58f86c95eb62ba9761b3099 Mon Sep 17 00:00:00 2001 From: Omar Rizwan Date: Fri, 13 Oct 2023 18:24:29 -0400 Subject: arc: Re-add arc support --- virtual-programs/display/arc.folk | 39 +++++++++++++++++++++++++++++++++++++++ 1 file changed, 39 insertions(+) create mode 100644 virtual-programs/display/arc.folk (limited to 'virtual-programs') diff --git a/virtual-programs/display/arc.folk b/virtual-programs/display/arc.folk new file mode 100644 index 00000000..e2412bf0 --- /dev/null +++ b/virtual-programs/display/arc.folk @@ -0,0 +1,39 @@ +# 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 vertices[gl_VertexIndex]; +} { + #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]] + } +} -- cgit v1.2.3 From a798dca8ca19c2601413e85a316f73dd857a2c14 Mon Sep 17 00:00:00 2001 From: Omar Rizwan Date: Fri, 13 Oct 2023 19:37:14 -0400 Subject: fill,shapes,circle,connections: Breaking: Fix shapes Shapes all now work by wishes; connections has been ported to use these wishes. --- virtual-programs/connections.folk | 8 +-- virtual-programs/display/circle.folk | 4 +- virtual-programs/display/fill.folk | 11 ++-- virtual-programs/shapes.folk | 99 +++++++++++++----------------------- 4 files changed, 50 insertions(+), 72 deletions(-) (limited to 'virtual-programs') diff --git a/virtual-programs/connections.folk b/virtual-programs/connections.folk index c66fba1d..4e002910 100644 --- a/virtual-programs/connections.folk +++ b/virtual-programs/connections.folk @@ -17,8 +17,8 @@ When /anyone/ wishes /source/ is connected to /sink/ & \ set angle [expr {atan2(-[lindex $direction 1], [lindex $direction 0]) - 3.14159/2}] set color grey - Display::stroke [list $source $sink ] 2 $color - shape 3 $c 30 $angle $color true + Wish to draw a stroke with points [list $source $sink] width 2 color $color + Wish to draw a shape with sides 3 center $c radius 30 radians $angle color $color filled true } set speed 75 @@ -40,7 +40,7 @@ When /anyone/ wishes /source/ is dynamically connected to /sink/ & \ lassign [vec2 scale [vec2 add $source $sink] 0.5] cx cy - Display::stroke [list $source $sink ] 1 white + Wish to draw a stroke with points [list $source $sink] width 1 color white When the clock time is /t/ { @@ -50,7 +50,7 @@ When /anyone/ wishes /source/ is dynamically connected to /sink/ & \ 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))}] - shape 3 $c $s $angle white true + Wish to draw a shape with sides 3 center $c radius $s radians $angle color white filled true } } } diff --git a/virtual-programs/display/circle.folk b/virtual-programs/display/circle.folk index 2951f3a9..03e4def7 100644 --- a/virtual-programs/display/circle.folk +++ b/virtual-programs/display/circle.folk @@ -20,12 +20,12 @@ Wish the GPU compiles pipeline "circle" { When /someone/ wishes to draw a circle with /...options/ { set center [dict_getdef $options center ""] - if {center eq ""} { set center [list [dict get $options x] [dict get $options y]] } + 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 color [getColor [dict get $options color]] set filled [dict_getdef $options filled false] Wish the GPU draws pipeline "circle" with arguments \ - [list $center $radius $thickness $color $filled] + [list $center $radius $thickness $color [expr {$filled eq false ? 0 : 1}]] } diff --git a/virtual-programs/display/fill.folk b/virtual-programs/display/fill.folk index ae3626f4..f3057068 100644 --- a/virtual-programs/display/fill.folk +++ b/virtual-programs/display/fill.folk @@ -15,6 +15,7 @@ When /someone/ wishes to draw a triangle with /...options/ { } When /someone/ wishes to draw a quad with /...options/ { dict with options { + if {![info exists layer]} { set layer 0 } Wish the GPU draws pipeline "fillTriangle" with arguments \ [list $p1 $p2 $p3 [getColor $color]] layer $layer Wish the GPU draws pipeline "fillTriangle" with arguments \ @@ -29,9 +30,13 @@ 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} { - eval fillTriangle $points $color + Wish to draw a triangle with \ + p0 [lindex $points 0] p1 [lindex $points 1] p2 [lindex $points 2] \ + color $color } elseif {$num_points == 4} { - eval fillQuad $points $color + Wish to draw a quad with \ + p0 [lindex $points 0] p1 [lindex $points 1] p2 [lindex $points 2] p3 [lindex $points 3] \ + color $color } else { # Get the first point in the list as the "base" point of the triangles set p0 [lindex $points 0] @@ -40,7 +45,7 @@ When /someone/ wishes to draw a polygon with /...options/ { 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] + [list $p0 $p1 $p2 [getColor $color]] } } } diff --git a/virtual-programs/shapes.folk b/virtual-programs/shapes.folk index 08106475..f01ff965 100644 --- a/virtual-programs/shapes.folk +++ b/virtual-programs/shapes.folk @@ -1,7 +1,14 @@ -# numPoints 2 => line -# numPoints 3 => triangle -# numPoints 4 => square -proc shape {numPoints c r {angle 0} {color white} {filled false} args} { +# sides 2 => line +# sides 3 => triangle +# sides 4 => square +When /someone/ wishes to draw a shape with /...options/ { + set numPoints [dict get $options sides] + set c [dict get $options center] + set r [dict get $options radius] + set radians [dict_getdef $options radians 0] + set color [dict_getdef $options color white] + set filled [dict_getdef $options filled false] + set p [list 0 0] set center $p set points [list $p] @@ -19,24 +26,28 @@ proc shape {numPoints c r {angle 0} {color white} {filled false} args} { set points [lmap v $points { set v [vec2 sub $v $center] - set v [vec2 rotate $v $angle] + set v [vec2 rotate $v $radians] set v [vec2 add $v $c] set v }] if {$filled} { - Display::fillPolygon $points $color + Wish to draw a polygon with points $points color $color } else { - Display::stroke $points 1 $color + Wish to draw a stroke with points $points width 1 color $color } } - -When /someone/ wishes /p/ draws a /color/ /shape/ offset /offsetVector/ & /p/ has region /r/ { +set shapes [dict create triangle 3 square 4 pentagon 5 hexagon 6 \ + septagon 7 octagon 8 nonagon 9] +When /someone/ wishes /p/ draws /a/ /shape/ with /...options/ & /p/ has region /r/ { lassign [region centroid $r] x y set width [region width $r] set height [region height $r] - lassign $offsetVector offsetX offsetY + lassign [dict_getdef $options offset {0 0}] offsetX offsetY + set radius [dict_getdef $options radius 50] + set color [dict_getdef $options color white] + set filled [dict_getdef $options filled false] if {$offsetX != 0} { set x [expr {$x + $offsetX}] @@ -48,74 +59,36 @@ When /someone/ wishes /p/ draws a /color/ /shape/ offset /offsetVector/ & /p/ ha set angle [region angle $r] set p [list $x $y] - # puts "drawing a $shape at $x $y with width $width and height $height" - set radius 50 - switch -nocase $shape { - triangle { - shape 3 $p $radius $angle $color - } - square { - shape 4 $p $radius $angle $color - } - pentagon { - shape 5 $p $radius $angle $color - } - hexagon { - shape 6 $p $radius $angle $color - } - septagon { - shape 7 $p $radius $angle $color - } - octagon { - shape 8 $p $radius $angle $color - } - nonagon { - shape 9 $p $radius $angle $color - } - circle { - Display::circle $x $y $radius 5 $color - } - default { - shape 2 $p $radius $angle $color - } + if {$shape eq "circle"} { + Wish to draw a circle with center $p radius $radius thickness 5 color $color filled $filled + } elseif {[dict exists $shapes $shape]} { + Wish to draw a shape with sides [dict get $shapes $shape] \ + center $p radius $radius radians $angle color $color filled $filled + } else { + Wish to draw a shape with sides 2 \ + center $p radius $radius radians $angle color $color filled $filled } } -set defaultColor white - -When /someone/ wishes /p/ draws a /color/ /shape/ & /p/ has region /r/ { - Wish $p draws a $color $shape offset {0 0} -} - -When /someone/ wishes /p/ draws a /shape/ & /p/ has region /r/ { - Wish $p draws a $defaultColor $shape -} - -When /someone/ wishes /p/ draws a /shape/ offset /offsetVector/ { - Wish $p draws a $defaultColor $shape offset $offsetVector -} - Claim $this has demo { Wish $this draws a circle - Wish $this draws a skyblue triangle - Wish $this draws a green triangle offset {280 0} - Wish $this draws a gold pentagon offset {200 0} - Wish $this draws a red octagon offset {250 80} + Wish $this draws a triangle with color skyblue + Wish $this draws a triangle with color green offset {280 0} + Wish $this draws a pentagon with color gold offset {200 0} + Wish $this draws an octagon with color red offset {250 80} When the clock time is /t/ { set offsetVector [list [sin $t] [cos $t]] set offsetVector [::vec2::scale $offsetVector 105] - Wish $this draws a palegoldenrod circle offset $offsetVector + Wish $this draws a circle with color palegoldenrod offset $offsetVector } # This toggles a square between filled and unfilled - # TODO cwervo: Support `Wish $this draws a circle with options /optionsDict/` to make this cleaner - # optionsDisct: {size number?: 50, filled boolean?: false, color string?: white, thickness string? white } When $this has region /r/ & the clock time is /t/ { lassign [region centroid $r] x y - set fill [expr {round(sin($t) * 2) % 2 == 0 ? true : false}] + set fill [expr {round(sin($t) * 2) % 2 == 0}] set y [- $y 150] - shape 4 [list [- $x 100] $y] 0 60 white $fill + Wish to draw a shape with sides 4 center [list [- $x 100] $y] radius 60 color white filled $fill } Wish $this is outlined white -- cgit v1.2.3 From a056780c8209d37a1dc968e3f242710eed549f92 Mon Sep 17 00:00:00 2001 From: Omar Rizwan Date: Fri, 13 Oct 2023 19:56:25 -0400 Subject: shapes: Fix unadorned shape wish --- virtual-programs/shapes.folk | 7 ++++++- 1 file changed, 6 insertions(+), 1 deletion(-) (limited to 'virtual-programs') diff --git a/virtual-programs/shapes.folk b/virtual-programs/shapes.folk index f01ff965..83011524 100644 --- a/virtual-programs/shapes.folk +++ b/virtual-programs/shapes.folk @@ -39,7 +39,12 @@ When /someone/ wishes to draw a shape with /...options/ { } set shapes [dict create triangle 3 square 4 pentagon 5 hexagon 6 \ - septagon 7 octagon 8 nonagon 9] + septagon 7 octagon 8 nonagon 9] +When /someone/ wishes /p/ draws /a/ /shape/ { + # TODO: This is a hack because rest pattern doesn't match empty + # sequence at end. + Wish $p draws $a $shape with color white +} When /someone/ wishes /p/ draws /a/ /shape/ with /...options/ & /p/ has region /r/ { lassign [region centroid $r] x y set width [region width $r] -- cgit v1.2.3 From e54c2c25f27cabef3c6240caeac571b263ded564 Mon Sep 17 00:00:00 2001 From: Omar Rizwan Date: Fri, 13 Oct 2023 19:57:32 -0400 Subject: sprites: Fix to use wish --- virtual-programs/sprites.folk | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'virtual-programs') diff --git a/virtual-programs/sprites.folk b/virtual-programs/sprites.folk index 0e4fc87e..48f8a1b1 100644 --- a/virtual-programs/sprites.folk +++ b/virtual-programs/sprites.folk @@ -23,7 +23,7 @@ When /anyone/ wishes /p/ draws sprite /path/ with /frameCount/ frames and /colum set subimage [image subimage $im $x $y $spriteWidth $spriteHeight] set center [region centroid $r] set angle [region angle $r] - Wish display runs [list Display::image {*}$center $subimage $angle 1] + Wish to draw an image with center $center image $subimage radians $angle } } -- cgit v1.2.3 From df52094ecdb6cb3dc6e70e15c3ec7f14909e30fe Mon Sep 17 00:00:00 2001 From: Omar Rizwan Date: Fri, 13 Oct 2023 20:24:08 -0400 Subject: stroke: Use instances. Idk if this helps much --- virtual-programs/display/stroke.folk | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) (limited to 'virtual-programs') diff --git a/virtual-programs/display/stroke.folk b/virtual-programs/display/stroke.folk index 98eec038..f212f471 100644 --- a/virtual-programs/display/stroke.folk +++ b/virtual-programs/display/stroke.folk @@ -24,10 +24,11 @@ When /someone/ wishes to draw a stroke with /...options/ { set width [dict get $options width] set color [getColor [dict get $options color]] + set instances [list] for {set i 0} {$i < [expr {[llength $points] - 1}]} {incr i} { set from [lindex $points $i] set to [lindex $points [expr $i+1]] - Wish the GPU draws pipeline "line" with arguments \ - [list $from $to $width $color] + lappend instances [list $from $to $width $color] } + Wish the GPU draws pipeline "line" with instances $instances } -- cgit v1.2.3 From 594a90003b2c9565cac1452a9ad1e9fb10a0f80a Mon Sep 17 00:00:00 2001 From: Omar Rizwan Date: Mon, 16 Oct 2023 12:53:05 -0400 Subject: display: Catch missing shader --- virtual-programs/display.folk | 40 ++++++++++++++++++++++++---------------- 1 file changed, 24 insertions(+), 16 deletions(-) (limited to 'virtual-programs') diff --git a/virtual-programs/display.folk b/virtual-programs/display.folk index acfdd510..0af52e6b 100644 --- a/virtual-programs/display.folk +++ b/virtual-programs/display.folk @@ -113,25 +113,33 @@ Start process "display" { while true { set ::displayList [dict create] ;# Keys are layer numbers; values are lists of commands Step - foreach match [Statements::findMatches {/someone/ wishes the GPU draws pipeline /name/ with arguments /args/}] { - dict lappend ::displayList 0 [list Gpu::draw [dict get $::pipelines [dict get $match name]] {*}[dict get $match args]] + foreach match [Statements::findMatches {/wisher/ wishes the GPU draws pipeline /name/ with arguments /args/}] { + try { + dict lappend ::displayList 0 [list Gpu::draw [dict get $::pipelines [dict get $match name]] {*}[dict get $match args]] + } on error e { Say [dict get $match wisher] has error $e with info $::errorInfo } } - foreach match [Statements::findMatches {/someone/ wishes the GPU draws pipeline /name/ with arguments /args/ layer /layer/}] { - dict lappend ::displayList [dict get $match layer] \ - [list Gpu::draw [dict get $::pipelines [dict get $match name]] {*}[dict get $match args]] + foreach match [Statements::findMatches {/wisher/ wishes the GPU draws pipeline /name/ with arguments /args/ layer /layer/}] { + try { + dict lappend ::displayList [dict get $match layer] \ + [list Gpu::draw [dict get $::pipelines [dict get $match name]] {*}[dict get $match args]] + } on error e { Say [dict get $match wisher] has error $e with info $::errorInfo } } - foreach match [Statements::findMatches {/someone/ wishes the GPU draws pipeline /name/ with instances /instances/}] { - set pipeline [dict get $::pipelines [dict get $match name]] - foreach instance [dict get $match instances] { - dict lappend ::displayList 0 [list Gpu::draw $pipeline {*}$instance] - } + foreach match [Statements::findMatches {/wisher/ wishes the GPU draws pipeline /name/ with instances /instances/}] { + try { + set pipeline [dict get $::pipelines [dict get $match name]] + foreach instance [dict get $match instances] { + dict lappend ::displayList 0 [list Gpu::draw $pipeline {*}$instance] + } + } on error e { Say [dict get $match wisher] has error $e with info $::errorInfo } } - foreach match [Statements::findMatches {/someone/ wishes the GPU draws pipeline /name/ with instances /instances/ layer /layer/}] { - set layer [dict get $match layer] - set pipeline [dict get $::pipelines [dict get $match name]] - foreach instance [dict get $match instances] { - dict lappend ::displayList $layer [list Gpu::draw $pipeline {*}$instance] - } + foreach match [Statements::findMatches {/wisher/ wishes the GPU draws pipeline /name/ with instances /instances/ layer /layer/}] { + try { + set layer [dict get $match layer] + set pipeline [dict get $::pipelines [dict get $match name]] + foreach instance [dict get $match instances] { + dict lappend ::displayList $layer [list Gpu::draw $pipeline {*}$instance] + } + } on error e { Say [dict get $match wisher] has error $e with info $::errorInfo } } set renderTime [baretime { -- cgit v1.2.3 From 36fba23287ff2461e28e1087b26a8421ba0f2335 Mon Sep 17 00:00:00 2001 From: Omar Rizwan Date: Mon, 23 Oct 2023 17:55:33 -0400 Subject: shapes: Use explicit a/an instead of wildcard Permanently fixes overeager matching errors against image and sprite whens --- virtual-programs/shapes.folk | 10 +++++++--- 1 file changed, 7 insertions(+), 3 deletions(-) (limited to 'virtual-programs') diff --git a/virtual-programs/shapes.folk b/virtual-programs/shapes.folk index 83011524..10589f38 100644 --- a/virtual-programs/shapes.folk +++ b/virtual-programs/shapes.folk @@ -40,12 +40,13 @@ When /someone/ wishes to draw a shape with /...options/ { set shapes [dict create triangle 3 square 4 pentagon 5 hexagon 6 \ septagon 7 octagon 8 nonagon 9] -When /someone/ wishes /p/ draws /a/ /shape/ { +When /someone/ wishes /p/ draws a /shape/ { # TODO: This is a hack because rest pattern doesn't match empty # sequence at end. - Wish $p draws $a $shape with color white + Wish $p draws a $shape with color white } -When /someone/ wishes /p/ draws /a/ /shape/ with /...options/ & /p/ has region /r/ { +When /someone/ wishes /p/ draws an /shape/ { Wish $p draws a $shape } +When /someone/ wishes /p/ draws a /shape/ with /...options/ & /p/ has region /r/ { lassign [region centroid $r] x y set width [region width $r] set height [region height $r] @@ -74,6 +75,9 @@ When /someone/ wishes /p/ draws /a/ /shape/ with /...options/ & /p/ has region / center $p radius $radius radians $angle color $color filled $filled } } +When /someone/ wishes /p/ draws an /shape/ with /...options/ { + Wish $p draws a $shape with {*}$options +} Claim $this has demo { Wish $this draws a circle -- cgit v1.2.3 From 66ed01bd1b9dc4f01de964424f909d2533bd3c7f Mon Sep 17 00:00:00 2001 From: Omar Rizwan Date: Mon, 23 Oct 2023 18:43:10 -0400 Subject: display: Simplify GPU statement -> pipeline dispatch --- virtual-programs/display.folk | 35 +++++++++++++---------------------- 1 file changed, 13 insertions(+), 22 deletions(-) (limited to 'virtual-programs') diff --git a/virtual-programs/display.folk b/virtual-programs/display.folk index 0af52e6b..132f2322 100644 --- a/virtual-programs/display.folk +++ b/virtual-programs/display.folk @@ -113,33 +113,24 @@ Start process "display" { while true { set ::displayList [dict create] ;# Keys are layer numbers; values are lists of commands Step - foreach match [Statements::findMatches {/wisher/ wishes the GPU draws pipeline /name/ with arguments /args/}] { - try { - dict lappend ::displayList 0 [list Gpu::draw [dict get $::pipelines [dict get $match name]] {*}[dict get $match args]] - } on error e { Say [dict get $match wisher] has error $e with info $::errorInfo } - } - foreach match [Statements::findMatches {/wisher/ wishes the GPU draws pipeline /name/ with arguments /args/ layer /layer/}] { - try { - dict lappend ::displayList [dict get $match layer] \ - [list Gpu::draw [dict get $::pipelines [dict get $match name]] {*}[dict get $match args]] - } on error e { Say [dict get $match wisher] has error $e with info $::errorInfo } - } - foreach match [Statements::findMatches {/wisher/ wishes the GPU draws pipeline /name/ with instances /instances/}] { + foreach match [Statements::findMatches {/wisher/ wishes the GPU draws pipeline /name/ with /...options/}] { try { + set name [dict get $match name] set pipeline [dict get $::pipelines [dict get $match name]] - foreach instance [dict get $match instances] { - dict lappend ::displayList 0 [list Gpu::draw $pipeline {*}$instance] + + set options [dict get $match options] + set layer [dict_getdef $options layer 0] + if {[dict exists $options instances]} { + set instances [dict get $options instances] + } else { + set instances [list [dict get $options arguments]] } - } on error e { Say [dict get $match wisher] has error $e with info $::errorInfo } - } - foreach match [Statements::findMatches {/wisher/ wishes the GPU draws pipeline /name/ with instances /instances/ layer /layer/}] { - try { - set layer [dict get $match layer] - set pipeline [dict get $::pipelines [dict get $match name]] - foreach instance [dict get $match instances] { + foreach instance $instances { dict lappend ::displayList $layer [list Gpu::draw $pipeline {*}$instance] } - } on error e { Say [dict get $match wisher] has error $e with info $::errorInfo } + } on error e { + Say [dict get $match wisher] has error $e with info $::errorInfo + } } set renderTime [baretime { -- cgit v1.2.3 From 2cf62a0b248249a529a70e29455a448ebb81e28a Mon Sep 17 00:00:00 2001 From: Omar Rizwan Date: Mon, 23 Oct 2023 18:43:31 -0400 Subject: text: Simplify loop --- virtual-programs/display/text.folk | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) (limited to 'virtual-programs') diff --git a/virtual-programs/display/text.folk b/virtual-programs/display/text.folk index 95901380..9189e4c1 100644 --- a/virtual-programs/display/text.folk +++ b/virtual-programs/display/text.folk @@ -146,8 +146,7 @@ On process "display" { set lineNum 0 set instances [list] - for {set i 0} {$i < [string length $text]} {incr i} { - set char [string index $text $i] + foreach char [split $text ""] { if {$char eq "\n"} { incr lineNum lassign [vec2 add [list $x0 $y0] \ -- cgit v1.2.3 From eb5b9707ac37b0391473916cc9ecb6e31659ebf1 Mon Sep 17 00:00:00 2001 From: Omar Rizwan Date: Mon, 23 Oct 2023 19:20:39 -0400 Subject: display: Warn instead of error for deprecated methods Clean up camera/display/calibration reactivity slightly --- virtual-programs/display.folk | 77 ++++++++++++++++++++---------- virtual-programs/errors.folk | 10 +++- virtual-programs/tags-and-calibration.folk | 13 ++--- 3 files changed, 68 insertions(+), 32 deletions(-) (limited to 'virtual-programs') diff --git a/virtual-programs/display.folk b/virtual-programs/display.folk index 132f2322..15df565d 100644 --- a/virtual-programs/display.folk +++ b/virtual-programs/display.folk @@ -1,27 +1,3 @@ -namespace eval ::Display { - variable WIDTH - variable HEIGHT - variable LAYER 0 - if {$::isLaptop} { - set WIDTH 640; set HEIGHT 480 - } else { - regexp {mode "(\d+)x(\d+)"} [exec fbset] -> WIDTH HEIGHT - } - - # Create proxy versions of drawing primitives for the main Folk - # process (that will forward those draw commands to the display - # subprocess). - foreach func {stroke circle text fillTriangle fillQuad fillPolygon image} { - proc $func args { - set func [lindex [info level 0] 0] - error "$func has been removed; use GPU wishes/shaders" - } - } - - Claim the display Display has width $::Display::WIDTH height $::Display::HEIGHT -} - - namespace eval Colors { source "pi/Colors.tcl" } proc ::getColor {color} { if {[info exists Colors::$color]} { return [set Colors::$color] } \ @@ -149,9 +125,60 @@ Start process "display" { } } -set ::Display::displayTime none set ::displayTime none When the display time is /displayTime/ { set ::Display::displayTime $displayTime set ::displayTime $displayTime } + +namespace eval ::Display { + variable displayTime none + + variable WIDTH + variable HEIGHT + variable LAYER 0 + if {$::isLaptop} { + set WIDTH 640; set HEIGHT 480 + } else { + regexp {mode "(\d+)x(\d+)"} [exec fbset] -> WIDTH HEIGHT + } + + # TODO: Remove these / expel them to a shim page; these are only + # for backward compatibility now. + proc warnDeprecated {} { + upvar 2 this this + set func [lindex [info level -1] 0] + set w "$func was deprecated in Oct 2023; use GPU wishes/shaders" + Claim $this has warning $w with info $w + } + proc stroke {points width color} { + warnDeprecated + Wish to draw a stroke with points $points width $width color $color + } + proc circle {x y radius thickness color {filled false}} { + warnDeprecated + Wish to draw a circle with x $x y $y radius $radius thickness $thickness color $color filled $filled + } + proc text {x0 y0 scale text radians {font "PTSans-Regular"}} { + warnDeprecated + Wish to draw text with x $x0 y $y0 scale $scale text $text radians $radians font $font + } + proc fillTriangle {p0 p1 p2 color} { + warnDeprecated + Wish to draw a triangle with p0 $p0 p1 $p1 p2 $p2 color $color + } + proc fillQuad {p0 p1 p2 p3 color} { + warnDeprecated + Wish to draw a quad with p0 $p0 p1 $p1 p2 $p2 p3 $p3 color $color + } + proc fillPolygon {points color} { + warnDeprecated + Wish to draw a polygon with points $points color $color + } + proc image {x y im radians {scale 1.0}} { + warnDeprecated + Wish to draw an image with x $x y $y image $im radians $radians scale $scale + } + + Claim the display Display has width $::Display::WIDTH height $::Display::HEIGHT +} diff --git a/virtual-programs/errors.folk b/virtual-programs/errors.folk index 28028710..32e34e73 100644 --- a/virtual-programs/errors.folk +++ b/virtual-programs/errors.folk @@ -6,6 +6,14 @@ When /p/ has error /err/ with info /info/ { Wish $p is outlined red } } - Wish $p is titled $err } + +When /p/ has warning /w/ with info /info/ { + When the clock time is /t/ { + if {[expr {(int($t * 5)) % 2}] != 1} { + Wish $p is outlined yellow + } + } + Wish $p is titled $w +} diff --git a/virtual-programs/tags-and-calibration.folk b/virtual-programs/tags-and-calibration.folk index f6aeb812..7e1fb068 100644 --- a/virtual-programs/tags-and-calibration.folk +++ b/virtual-programs/tags-and-calibration.folk @@ -9,10 +9,11 @@ namespace import ::math::linearalgebra::add \ ::math::linearalgebra::solvePGauss When the camera frame is /f/ { - Claim camera Camera has width [dict get $f width] height [dict get $f height] + Claim the camera Camera has width [dict get $f width] height [dict get $f height] } -When camera /camera/ has width /cameraWidth/ height /cameraHeight/ { +When the display /display/ has width /displayWidth/ height /displayHeight/ &\ + the camera /camera/ has width /cameraWidth/ height /cameraHeight/ { puts "Evaluating calibration for $camera ($cameraWidth x $cameraHeight)" # camera (tag) point -> projection point # calibration for Hex @@ -27,10 +28,10 @@ When camera /camera/ has width /cameraWidth/ height /cameraHeight/ { set points [list] foreach correspondence $generatedCalibration::points { lassign $correspondence cx cy dx dy - lappend points [list [expr {double($cx)/$generatedCalibration::cameraWidth*$Camera::WIDTH}] \ - [expr {double($cy)/$generatedCalibration::cameraHeight*$Camera::HEIGHT}] \ - [expr {double($dx)/$generatedCalibration::displayWidth*$Display::WIDTH}] \ - [expr {double($dy)/$generatedCalibration::displayHeight*$Display::HEIGHT}]] + lappend points [list [expr {double($cx)/$generatedCalibration::cameraWidth*$cameraWidth}] \ + [expr {double($cy)/$generatedCalibration::cameraHeight*$cameraHeight}] \ + [expr {double($dx)/$generatedCalibration::displayWidth*$displayWidth}] \ + [expr {double($dy)/$generatedCalibration::displayHeight*$displayHeight}]] } } if {[llength $points] < 4} { -- cgit v1.2.3 From 7bb042fe71ec1532afb970b727241eaf24c7808d Mon Sep 17 00:00:00 2001 From: Omar Rizwan Date: Mon, 23 Oct 2023 19:28:27 -0400 Subject: web-editor: Hacks so slower glslc errors propagate to editor in time --- virtual-programs/new-program-web-editor.folk | 8 +++++--- virtual-programs/web-editor.folk | 9 +++++---- 2 files changed, 10 insertions(+), 7 deletions(-) (limited to 'virtual-programs') diff --git a/virtual-programs/new-program-web-editor.folk b/virtual-programs/new-program-web-editor.folk index a7c176cc..f972cfc7 100644 --- a/virtual-programs/new-program-web-editor.folk +++ b/virtual-programs/new-program-web-editor.folk @@ -152,12 +152,14 @@ Wish the web server handles route "/new" with handler { Assert web claims {${program}} has program code {${code}} if {$::isLaptop} { Step } `); - setTimeout(() => { - send(` + [500, 1000, 3000].forEach(timeout => { + setTimeout(() => { + send(` set errors [Statements::findMatches [list {${program}} has error /err/ with info /errorInfo/]] ::websocket::send $chan text [join [list "Error:" {*}[lmap e $errors {dict get $e errorInfo}]] "\n"] `); - }, 500); + }, timeout); + }); } let jobid; function handlePrint() { diff --git a/virtual-programs/web-editor.folk b/virtual-programs/web-editor.folk index 245b6043..fb899560 100644 --- a/virtual-programs/web-editor.folk +++ b/virtual-programs/web-editor.folk @@ -96,13 +96,14 @@ Wish the web server handles route {/page/(.*)$} with handler { send(`EditVirtualProgram file_name {${code}}`) } - - setTimeout(() => { - send(` + [500, 1000, 3000].forEach(timeout => { + setTimeout(() => { + send(` set errors [Statements::findMatches [list program_id has error /err/ with info /errorInfo/]] ::websocket::send $chan text [join [list "Error:" {*}[lmap e $errors {dict get $e errorInfo}]] "\n"] `); - }, 500); + }, 500); + }); } let jobid; -- cgit v1.2.3 From e4354267a33766d9dacd5731e660407fd60091c9 Mon Sep 17 00:00:00 2001 From: Omar Rizwan Date: Wed, 25 Oct 2023 17:35:12 -0400 Subject: text: Do text shaping in C --- virtual-programs/display/text.folk | 184 ++++++++++++++++++++++--------------- 1 file changed, 110 insertions(+), 74 deletions(-) (limited to 'virtual-programs') diff --git a/virtual-programs/display/text.folk b/virtual-programs/display/text.folk index 9189e4c1..451b9ce0 100644 --- a/virtual-programs/display/text.folk +++ b/virtual-programs/display/text.folk @@ -1,28 +1,121 @@ On process "display" { namespace eval font { + set cc [c create] + $cc include + defineImageType $cc + $cc struct GlyphInfo { + float advance; + + float planeLeft; + float planeBottom; + float planeRight; + float planeTop; + + float atlasLeft; + float atlasBottom; + float atlasRight; + float atlasTop; + } + $cc struct Font { + image_t atlasImage; + int gpuAtlasImage; + // TODO: This only handles ASCII, obviously. + GlyphInfo glyphInfos[128]; + } + proc load {name} { set csvFd [open "vendor/fonts/$name.csv" r]; set csv [read $csvFd]; close $csvFd - set glyphInfos [dict create] + set fields [list advance \ + planeLeft planeBottom planeRight planeTop \ + atlasLeft atlasBottom atlasRight atlasTop] + # HACK: Create list of null glyphs to initialize. + set glyphInfos [list] + for {set i 0} {$i < 128} {incr i} { + set glyphInfo [dict create] + foreach field $fields { dict set glyphInfo $field 0 } + lappend glyphInfos $glyphInfo + } + foreach line [split $csv "\n"] { - set info [lassign [split $line ,] glyph] - lassign $info advance \ - planeLeft planeBottom planeRight planeTop \ - atlasLeft atlasBottom atlasRight atlasTop - dict set glyphInfos $glyph \ - [list $advance \ - [list $planeLeft $planeBottom $planeRight $planeTop] \ - [list $atlasLeft $atlasBottom $atlasRight $atlasTop]] + set values [lassign [split $line ,] glyph] + if {![string is integer -strict $glyph]} { continue } + + set glyphInfo [dict create] + foreach field $fields value $values { + dict set glyphInfo $field $value + } + lset glyphInfos $glyph $glyphInfo } set im [image load "[pwd]/vendor/fonts/$name.png"] set gim [Gpu::ImageManager::copyImageToGpu $im] - return [list $glyphInfos $im $gim] + return [dict create atlasImage $im gpuAtlasImage $gim glyphInfos $glyphInfos] + } + $cc struct vec2f { float x; float y; } + $cc proc vec2f_add {vec2f a vec2f b} vec2f { + return (vec2f) { a.x + b.x, a.y + b.y }; } - proc hasGlyphInfo {font charCode} { dict exists [lindex $font 0] $charCode } - proc glyphInfo {font charCode} { dict get [lindex $font 0] $charCode } - proc atlasImage {font} { lindex $font 1 } - proc gpuAtlasImage {font} { lindex $font 2 } + $cc proc vec2f_rotate {vec2f a float radians} vec2f { + return (vec2f) { + a.x*cosf(radians) + a.y*sinf(radians), + -a.x*sinf(radians) + a.y*cosf(radians) + }; + } + $cc proc textExtent {Font* font char* text float scale} vec2f { + float em = scale * 25.0; + float x = 0; float y = 0; + float width = 0; + for (int i = 0; text[i] != 0; i++) { + int ch = text[i]; + if (ch == '\n') { + y = y + em; x = 0; continue; + } + if (ch >= sizeof(font->glyphInfos)/sizeof(font->glyphInfos[0])) { + ch = '?'; + } + GlyphInfo glyphInfo = font->glyphInfos[ch]; + x = x + glyphInfo.advance * em; + if (x > width) { width = x; } + } + return (vec2f) { width, y + em }; + } + $cc proc textShape {Font* font char* text + float x0 float y0 float scale float radians} Tcl_Obj* { + vec2f extent = vec2f_rotate(textExtent(font, text, scale), radians); + float em = scale * 25.0; + + vec2f p0 = { x0 - extent.x/2.0, y0 - extent.y/2.0 }; + vec2f p = p0; + + int lineNum = 0; + Tcl_Obj* instances = Tcl_NewListObj(0, NULL); // List of instances. + for (int i = 0; text[i] != 0; i++) { + int ch = text[i]; + if (ch == '\n') { + lineNum++; + p = vec2f_add(p0, vec2f_rotate((vec2f) {0, lineNum * em}, radians)); + continue; + } + if (ch >= sizeof(font->glyphInfos)/sizeof(font->glyphInfos[0])) { + ch = '?'; + } + GlyphInfo glyphInfo = font->glyphInfos[ch]; + if (ch != ' ') { + // Append to list of instances. + Tcl_Obj* instance = Tcl_ObjPrintf("%d {%d %d} {%f %f %f %f} {%f %f %f %f} {%f %f} %f %f", + font->gpuAtlasImage, + font->atlasImage.width, font->atlasImage.height, + glyphInfo.atlasLeft, glyphInfo.atlasBottom, glyphInfo.atlasRight, glyphInfo.atlasTop, + glyphInfo.planeLeft, glyphInfo.planeBottom, glyphInfo.planeRight, glyphInfo.planeTop, + p.x, p.y, radians, em); + Tcl_ListObjAppendElement(NULL, instances, instance); + } + p = vec2f_add(p, vec2f_rotate((vec2f) {glyphInfo.advance * em, 0}, radians)); + } + return instances; + } + $cc compile namespace export * namespace ensemble create @@ -88,31 +181,11 @@ On process "display" { return mix(vec4(0, 0, 0, 0), vec4(1, 1, 1, 1), opacity); }] - fn textExtent {text scale font} { - set em [* $scale 25.0] - set x 0; set y 0 - set width 0 - for {set i 0} {$i < [string length $text]} {incr i} { - set char [string index $text $i] - if {$char eq "\n"} { - set y [+ $y $em]; set x 0; continue - } - set charCode [scan $char %c] - if {[font hasGlyphInfo $font $charCode]} { - set glyphInfo [font glyphInfo $font $charCode] - } else { - set glyphInfo [font glyphInfo $font [scan ? %c]] - } - lassign $glyphInfo advance planeBounds atlasBounds - set x [+ $x [* $advance $em]] - if {$x > $width} { set width $x } - } - return [list $width [+ $y $em]] - } - Wish $::thisProcess receives statements like \ [list /someone/ wishes to draw text with /...options/] + set cc [c create] + When /someone/ wishes to draw text with /...options/ { if {[dict exists $options center]} { lassign [dict get $options center] x0 y0 @@ -130,44 +203,7 @@ On process "display" { } set font [dict get $::FontCache $font] - set fontAtlas [font gpuAtlasImage $font] - set fontAtlasSize [list [::image width [font atlasImage $font]] \ - [::image height [font atlasImage $font]]] - - set extent [vec2 rotate [textExtent $text $scale $font] $radians] - - set em [* $scale 25.0] - - # TODO: Add text alignment/anchor options (right now, this - # setup centers the text). - set x0 [expr {$x0 - [lindex $extent 0]/2}] - set y0 [expr {$y0 - [lindex $extent 1]/2}] - set x $x0; set y $y0 - - set lineNum 0 - set instances [list] - foreach char [split $text ""] { - if {$char eq "\n"} { - incr lineNum - lassign [vec2 add [list $x0 $y0] \ - [vec2 rotate [list 0 [* $lineNum $em]] $radians]] x y - continue - } - set charCode [scan $char %c] - if {[font hasGlyphInfo $font $charCode]} { - set glyphInfo [font glyphInfo $font $charCode] - } else { - set glyphInfo [font glyphInfo $font [scan ? %c]] - } - lassign $glyphInfo advance planeBounds atlasBounds - if {$char ne " "} { - lappend instances \ - [list $fontAtlas $fontAtlasSize \ - $atlasBounds $planeBounds [list $x $y] $radians $em] - } - lassign [vec2 add [list $x $y] \ - [vec2 rotate [list [* $advance $em] 0] $radians]] x y - } + set instances [font textShape $font $text $x0 $y0 $scale $radians] # We need to batch into one wish so we don't deal with n^2 # checks for existing statements for n glyphs. -- cgit v1.2.3 From f8d2bb768ffbfbf12fdb27df28ea4e1fc707584a Mon Sep 17 00:00:00 2001 From: Omar Rizwan Date: Wed, 25 Oct 2023 18:31:02 -0400 Subject: text: Try using Tcl objects in text shaping to prevent conversion Still slow (20fps for program list) --- virtual-programs/display/text.folk | 71 ++++++++++++++++++-------------------- 1 file changed, 33 insertions(+), 38 deletions(-) (limited to 'virtual-programs') diff --git a/virtual-programs/display/text.folk b/virtual-programs/display/text.folk index 451b9ce0..858a9dc7 100644 --- a/virtual-programs/display/text.folk +++ b/virtual-programs/display/text.folk @@ -3,48 +3,33 @@ On process "display" { set cc [c create] $cc include defineImageType $cc - $cc struct GlyphInfo { - float advance; - - float planeLeft; - float planeBottom; - float planeRight; - float planeTop; - - float atlasLeft; - float atlasBottom; - float atlasRight; - float atlasTop; - } $cc struct Font { image_t atlasImage; int gpuAtlasImage; // TODO: This only handles ASCII, obviously. - GlyphInfo glyphInfos[128]; + Tcl_Obj* glyphInfos[128]; } proc load {name} { set csvFd [open "vendor/fonts/$name.csv" r]; set csv [read $csvFd]; close $csvFd - set fields [list advance \ - planeLeft planeBottom planeRight planeTop \ - atlasLeft atlasBottom atlasRight atlasTop] + set fields [list ] # HACK: Create list of null glyphs to initialize. set glyphInfos [list] for {set i 0} {$i < 128} {incr i} { - set glyphInfo [dict create] - foreach field $fields { dict set glyphInfo $field 0 } - lappend glyphInfos $glyphInfo + lappend glyphInfos {} } foreach line [split $csv "\n"] { set values [lassign [split $line ,] glyph] if {![string is integer -strict $glyph]} { continue } - set glyphInfo [dict create] - foreach field $fields value $values { - dict set glyphInfo $field $value - } - lset glyphInfos $glyph $glyphInfo + lassign $values advance \ + planeLeft planeBottom planeRight planeTop \ + atlasLeft atlasBottom atlasRight atlasTop + lset glyphInfos $glyph \ + [list $advance \ + [list $planeLeft $planeBottom $planeRight $planeTop] \ + [list $atlasLeft $atlasBottom $atlasRight $atlasTop]] } set im [image load "[pwd]/vendor/fonts/$name.png"] @@ -74,14 +59,18 @@ On process "display" { if (ch >= sizeof(font->glyphInfos)/sizeof(font->glyphInfos[0])) { ch = '?'; } - GlyphInfo glyphInfo = font->glyphInfos[ch]; - x = x + glyphInfo.advance * em; + Tcl_Obj* glyphInfo = font->glyphInfos[ch]; + Tcl_Obj* advanceObj; Tcl_ListObjIndex(NULL, glyphInfo, 0, &advanceObj); + double advance; Tcl_GetDoubleFromObj(NULL, advanceObj, &advance); + x = x + advance * em; if (x > width) { width = x; } } return (vec2f) { width, y + em }; } $cc proc textShape {Font* font char* text float x0 float y0 float scale float radians} Tcl_Obj* { + Tcl_Obj* gpuAtlasImageSize = Tcl_ObjPrintf("%d %d", font->atlasImage.width, font->atlasImage.height); + vec2f extent = vec2f_rotate(textExtent(font, text, scale), radians); float em = scale * 25.0; @@ -100,18 +89,26 @@ On process "display" { if (ch >= sizeof(font->glyphInfos)/sizeof(font->glyphInfos[0])) { ch = '?'; } - GlyphInfo glyphInfo = font->glyphInfos[ch]; + Tcl_Obj* glyphInfo = font->glyphInfos[ch]; + Tcl_Obj* advanceObj; Tcl_ListObjIndex(NULL, glyphInfo, 0, &advanceObj); + double advance; Tcl_GetDoubleFromObj(NULL, advanceObj, &advance); if (ch != ' ') { // Append to list of instances. - Tcl_Obj* instance = Tcl_ObjPrintf("%d {%d %d} {%f %f %f %f} {%f %f %f %f} {%f %f} %f %f", - font->gpuAtlasImage, - font->atlasImage.width, font->atlasImage.height, - glyphInfo.atlasLeft, glyphInfo.atlasBottom, glyphInfo.atlasRight, glyphInfo.atlasTop, - glyphInfo.planeLeft, glyphInfo.planeBottom, glyphInfo.planeRight, glyphInfo.planeTop, - p.x, p.y, radians, em); + Tcl_Obj* planeBounds; Tcl_ListObjIndex(NULL, glyphInfo, 1, &planeBounds); + Tcl_Obj* atlasBounds; Tcl_ListObjIndex(NULL, glyphInfo, 2, &atlasBounds); + Tcl_Obj* pv[] = {Tcl_NewDoubleObj(p.x), Tcl_NewDoubleObj(p.y)}; + Tcl_Obj* pObj = Tcl_NewListObj(2, pv); + Tcl_Obj* args[] = { + Tcl_NewIntObj(font->gpuAtlasImage), + gpuAtlasImageSize, + atlasBounds, + planeBounds, + pObj, Tcl_NewDoubleObj(radians), Tcl_NewDoubleObj(em) + }; + Tcl_Obj* instance = Tcl_NewListObj(sizeof(args)/sizeof(args[0]), args); Tcl_ListObjAppendElement(NULL, instances, instance); } - p = vec2f_add(p, vec2f_rotate((vec2f) {glyphInfo.advance * em, 0}, radians)); + p = vec2f_add(p, vec2f_rotate((vec2f) {advance * em, 0}, radians)); } return instances; } @@ -184,9 +181,7 @@ On process "display" { Wish $::thisProcess receives statements like \ [list /someone/ wishes to draw text with /...options/] - set cc [c create] - - When /someone/ wishes to draw text with /...options/ { + When (non-capturing) /someone/ wishes to draw text with /...options/ { if {[dict exists $options center]} { lassign [dict get $options center] x0 y0 } else { -- cgit v1.2.3 From 80cc940c933cf852914b8503c7e0dec8bc980cf5 Mon Sep 17 00:00:00 2001 From: Jacob Haip Date: Wed, 25 Oct 2023 23:09:43 -0400 Subject: add freeImage proc to images.folk --- virtual-programs/images.folk | 6 ++++++ 1 file changed, 6 insertions(+) (limited to 'virtual-programs') diff --git a/virtual-programs/images.folk b/virtual-programs/images.folk index 844ca119..d8bcaf55 100644 --- a/virtual-programs/images.folk +++ b/virtual-programs/images.folk @@ -36,8 +36,10 @@ namespace eval ::image { $cc include if {[namespace exists ::Heap]} { $cc import ::Heap::cc folkHeapAlloc as folkHeapAlloc + $cc import ::Heap::cc folkHeapFree as folkHeapFree } else { $cc code { #define folkHeapAlloc malloc } + $cc code { #define folkHeapFree free } } $cc code { @@ -258,6 +260,10 @@ namespace eval ::image { return ret; } + $cc proc freeImage {image_t im} void { + folkHeapFree(im.data); + } + $cc proc freeJpeg {image_t im} void { // TODO: Free the JPEG. // ckfree(im.data); -- cgit v1.2.3 From dbaab88cd56c0247c6247b8d38f2ca56b79eb595 Mon Sep 17 00:00:00 2001 From: Omar Rizwan Date: Thu, 26 Oct 2023 08:05:26 -0400 Subject: display: Handle if this doesn't exist --- virtual-programs/display.folk | 1 + 1 file changed, 1 insertion(+) (limited to 'virtual-programs') diff --git a/virtual-programs/display.folk b/virtual-programs/display.folk index 15df565d..2853c065 100644 --- a/virtual-programs/display.folk +++ b/virtual-programs/display.folk @@ -147,6 +147,7 @@ namespace eval ::Display { # for backward compatibility now. proc warnDeprecated {} { upvar 2 this this + if {![info exists this]} {set this ""} set func [lindex [info level -1] 0] set w "$func was deprecated in Oct 2023; use GPU wishes/shaders" Claim $this has warning $w with info $w -- cgit v1.2.3 From ed868c6c93725bbc0cd0a71259880e0a4b4b94a5 Mon Sep 17 00:00:00 2001 From: Omar Rizwan Date: Thu, 26 Oct 2023 11:36:03 -0400 Subject: outline: Slight optimization --- virtual-programs/outline.folk | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) (limited to 'virtual-programs') diff --git a/virtual-programs/outline.folk b/virtual-programs/outline.folk index cdfe6fbd..1d6411cb 100644 --- a/virtual-programs/outline.folk +++ b/virtual-programs/outline.folk @@ -1,9 +1,12 @@ -proc loopRegion {edges vertices weight color} { +proc loopRegion {edges vertices width color} { + set instances [list] + set color [getColor $color] foreach edge $edges { set from [lindex $vertices [lindex $edge 0]] set to [lindex $vertices [lindex $edge 1]] - Wish to draw a stroke with points [list $from $to] width $weight color $color + lappend instances [list $from $to $width $color] } + Wish the GPU draws pipeline "line" with instances $instances } When the collected matches for [list /someone/ wishes /thing/ is outlined /color/] are /matches/ { -- cgit v1.2.3