Move display to virtual program

Mostly to make it easier to debug the error spam, but it's nice that
it's more consistent too

1 files changed, 83 insertions, 0 deletions

diff --git a/virtual-programs/display.folk b/virtual-programs/display.folk
new file mode 100644
index 00000000..ce7c0c2c
--- /dev/null
+++ b/virtual-programs/display.folk
@@ -0,0 +1,83 @@
+if {$::isLaptop} return
+
+namespace eval Display {
+    variable WIDTH
+    variable HEIGHT
+    variable LAYER 0
+    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
+    }
+
+    proc stroke {points width color} {
+        uplevel [list Wish display runs [list Display::stroke $points $width $color] on layer $Display::LAYER]
+    }
+
+    proc circle {x y radius thickness color} {
+        uplevel [list Wish display runs [list Display::circle $x $y $radius $thickness $color] on layer $Display::LAYER]
+    }
+
+    proc text args {
+        uplevel [list Wish display runs [list Display::text {*}$args] on layer $Display::LAYER]
+    }
+
+    proc fillTriangle args {
+        uplevel [list Wish display runs [list Display::fillTriangle {*}$args] on layer $Display::LAYER]
+    }
+
+    proc fillQuad args {
+        uplevel [list Wish display runs [list Display::fillQuad {*}$args] on layer $Display::LAYER]
+    }
+
+    proc fillPolygon args {
+        uplevel [list Wish display runs [list Display::fillPolygon {*}$args] on layer $Display::LAYER]
+    }
+
+    variable displayTime none
+}
+
+On process {
+    source pi/Display.tcl
+    Display::init
+    puts "Display tid: [getTid]"
+
+    # 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/]
+
+    forever {
+        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 [join [lmap sublist [lsort -command lcomp $displayList] {lindex $sublist 1}] "\n"]
+        append displayCommands "\ncommitThenClearStaging"
+        set displayTime [time $displayCommands]
+    }
+}