1 files changed, 93 insertions, 0 deletions
diff --git a/virtual-programs/display.folk b/virtual-programs/display.folk
new file mode 100644
index 00000000..d3f6b610
--- /dev/null
+++ b/virtual-programs/display.folk
@@ -0,0 +1,93 @@
+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/]
+    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 renderTime [baretime [list foreach command $displayCommands { {*}$command }]]
+        set commitTime [baretime commitThenClearStaging]
+
+        Commit { Claim the display time is "render $renderTime us + commit $commitTime us ($::stepTime)" }
+        Step
+    }
+}
+# TODO: remove this compatibility hack
+When the display time is /displayTime/ {
+    set ::Display::displayTime $displayTime
+}