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).

6 files changed, 359 insertions, 0 deletions

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
--- /dev/null
+++ b/virtual-programs/display/fns.folk
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
+        }
+    }
+}