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