fix laser region camera code

this is a nice simplification now that Camera.folk is around

5 files changed, 45 insertions, 166 deletions

diff --git a/user-programs/haippi7/laser-camera.folk b/user-programs/haippi7/laser-camera.folk
new file mode 100644
index 00000000..09594fdc
--- /dev/null
+++ b/user-programs/haippi7/laser-camera.folk
@@ -0,0 +1,38 @@
+# Comment out the main virtual-programs/Camera.folk before running this
+
+if {$::isLaptop} return
+
+namespace eval ::Camera {
+    variable WIDTH 1280
+    variable HEIGHT 720
+}
+
+On process {
+    source pi/Camera.tcl
+    source vendor/blobdetect/blobdetect.tcl
+    Camera::init 1280 720
+
+    puts "Camera tid: [getTid]"
+    
+    while true {
+        set cameraTime [time {
+            set grayFrame [Camera::grayFrame]
+        }]
+        set aprilTime [time {
+            set threshold 128
+            set tags [::BlobDetect::detect $grayFrame $threshold]
+        }]
+        
+        Commit {
+            Claim the camera frame is $grayFrame
+
+            Claim the camera time is $cameraTime
+            Claim the AprilTag time is $aprilTime
+
+            foreach tag $tags {
+                Claim laser blob [dict get $tag id] has center [dict get $tag center] size [dict get $tag size]
+            }
+        }
+        Step
+    }
+}
diff --git a/user-programs/haippi7/laser-pi.tcl b/user-programs/haippi7/laser-pi.tcl
deleted file mode 100644
index 19b9702a..00000000
--- a/user-programs/haippi7/laser-pi.tcl
+++ /dev/null
@@ -1,161 +0,0 @@
-package require Thread
-proc errorproc {args} {puts "Thread error: $args"}
-thread::errorproc errorproc
-
-namespace eval Display {
-    variable WIDTH
-    variable HEIGHT
-    regexp {mode "(\d+)x(\d+)"} [exec fbset] -> WIDTH HEIGHT
-
-    variable displayThread [thread::create {
-        source pi/Display.tcl
-        Display::init
-        puts "Display tid: [getTid]"
-
-        set ::displayCount 0
-        thread::wait
-    }]
-    puts "Display thread id: $displayThread"
-
-    proc stroke {points width color} {
-        uplevel [list Wish display runs [list Display::stroke $points $width $color]]
-    }
-
-    proc text {fb x y fontSize text {radians 0}} {
-        uplevel [list Wish display runs [list Display::text $fb $x $y $fontSize $text $radians]]
-    }
-
-    variable displayTime none
-    proc commit {} {
-        set displayList [list]
-        foreach match [Statements::findMatches {/someone/ wishes display runs /command/}] {
-            lappend displayList [dict get $match command]
-        }
-
-        proc lcomp {a b} {expr {[lindex $a 0] == "Display::text"}}
-        incr ::displayCount
-        thread::send -head -async $Display::displayThread [format {
-            set newDisplayCount %d
-            if {$::displayCount > $newDisplayCount} {
-                # we've already displayed a newer frame
-                return
-            } else {
-                set ::displayCount $newDisplayCount
-            }
- 
-            # Draw the display list
-            set displayTime [time {
-                %s
-                commitThenClearStaging
-            }]
-            thread::send -async "%s" [subst {
-                set Display::displayTime "$displayTime"
-            }]
-        } $::displayCount \
-          [join [lsort -command lcomp $displayList] "\n"] \
-          [thread::id]]
-    }
-}
-
-# Camera thread
-namespace eval Camera {
-    variable WIDTH 1280
-    variable HEIGHT 720
-    variable statements [list]
-
-    variable cameraThread [thread::create [format {
-        source pi/Camera.tcl
-        source vendor/blobdetect/blobdetect.tcl
-        Camera::init %d %d
-        puts "Camera tid: [getTid]"
-
-        set grayFrames [list]
-        while true {
-            # Hack: we free old images. Really this should be done on
-            # the main thread when it's actually done with them.
-            if {[llength $grayFrames] > 10} {
-                freeImage [lindex $grayFrames 0]
-                set grayFrames [lreplace $grayFrames 0 0]
-            }
-            set cameraTime [time {
-                set grayFrame [Camera::grayFrame]
-                set threshold 128
-                set tags [::BlobDetect::detect $grayFrame $threshold]
-                lappend grayFrames $grayFrame
-            }]
-            set statements [list]
-            lappend statements [list camera claims the camera time is $cameraTime]
-            lappend statements [list camera claims the camera frame is $grayFrame]
-            foreach tag $tags {
-                lappend statements [list camera claims laser blob [dict get $tag id] has center [dict get $tag center] size [dict get $tag size]]
-            }
-
-            # send this script back to the main Folk thread
-            # puts "\n\nCommands\n-----\n[join $commands \"\n\"]"
-            thread::send -async "%s" [list set Camera::statements $statements]
-        }
-    } $WIDTH $HEIGHT [thread::id]]]
-    puts "Camera thread id: $cameraThread"
-
-    Assert when $::thisProcess has step count /c/ {
-        foreach stmt $Camera::statements {
-            Say {*}$stmt
-        }
-    }
-}
-
-set keyboardThread [thread::create [format {
-    source "pi/Keyboard.tcl"
-    source "lib/c.tcl"
-    source "pi/cUtils.tcl"
-    Keyboard::init
-    puts "Keyboard tid: [getTid]"
-
-    set chs [list]
-    while true {
-        lappend chs [Keyboard::getChar]
-
-        thread::send -async "%s" [subst {
-            Retract keyboard claims the keyboard character log is /something/
-            Assert keyboard claims the keyboard character log is "$chs"
-        }]
-    }
-} [thread::id]]]
-puts "Keyboard thread id: $keyboardThread"
-
-# also see how it's done in laptop.tcl
-set ::rootStatements [list]
-proc loadProgram {programFilename} {
-    # this is a proc so its variables don't leak
-    set fp [open $programFilename r]
-    lappend ::rootStatements [list root claims $programFilename has program code [read $fp]]
-    # set x 0; set y 100; set w 100; set h 100
-    # set vertices [list [list $x $y] \
-    #                   [list [expr {$x+$w}] $y] \
-    #                   [list [expr {$x+$w}] [expr {$y+$h}]] \
-    #                   [list $x [expr {$y+$h}]]]
-    # set edges [list [list 0 1] [list 1 2] [list 2 3] [list 3 0]]
-    # lappend ::rootStatements [list root claims $programFilename has region [list $vertices $edges]]
-    close $fp
-}
-foreach programFilename [glob virtual-programs/*.folk] {
-    loadProgram $programFilename
-}
-foreach programFilename [glob -nocomplain "user-programs/[info hostname]/*.folk"] {
-    loadProgram $programFilename
-}
-
-# so we can retract them all at once if a laptop connects:
-Assert when the collected matches for [list /someone/ is providing root statements] are /roots/ {
-    if {[llength $roots] == 0} {
-        foreach stmt $::rootStatements { Say {*}$stmt }
-    }
-}
-
-proc every {ms body} {
-    try $body
-    after $ms [list after idle [namespace code [info level 0]]]
-}
-every 32 { Step }
-
-vwait forever
diff --git a/user-programs/haippi7/laser-region-manager.folk b/user-programs/haippi7/laser-region-manager.folk
index cfca7d46..fc063e56 100644
--- a/user-programs/haippi7/laser-region-manager.folk
+++ b/user-programs/haippi7/laser-region-manager.folk
@@ -6,7 +6,8 @@ When the collected matches for [list /someone/ claims /something/ region /id/ da
         lappend regionDataJsStrList "\[[string map {"{" "\[" "}" "\]" " " ", "} $m]\]"
     }
     set jsArrayString "\[[join $regionDataJsStrList ", "]\]"
-    Wish the web server handles route "/laser-regions-test" with handler [list Evaluator::tryRunInSerializedEnvironment {
+    Wish the web server handles route "/laser-regions-test" with handler [list apply {{jsArrayString} {
+        upvar ^html ^html
         html [string map [list REGION_DATA $jsArrayString] {
         <html><head></head>
         <body>
@@ -149,5 +150,5 @@ ws.onmessage = (msg) => {
         </body>
         </html>
         }]
-  } [Evaluator::serializeEnvironment]]
+  }} $jsArrayString]
 }
\ No newline at end of file
diff --git a/user-programs/haippi7/laser-web-debug.folk b/user-programs/haippi7/laser-web-debug.folk
index 0f7b26a0..14168f8b 100644
--- a/user-programs/haippi7/laser-web-debug.folk
+++ b/user-programs/haippi7/laser-web-debug.folk
@@ -1,5 +1,6 @@
 When the collected matches for [list laser blob /t/ has center /c/ size /s/] are /matches/ {
-  Wish the web server handles route "/laser-web-debug" with handler [list Evaluator::tryRunInSerializedEnvironment {
+  Wish the web server handles route "/laser-web-debug" with handler [list apply {{matches} {
+    upvar ^html ^html
     set blobsHtml "<ol>"
     set blobsJson ""
     foreach match $matches {
@@ -73,5 +74,5 @@ Test1();
         </html>
 
     }]
-  } [Evaluator::serializeEnvironment]]
+  }} $matches]
 }
\ No newline at end of file
diff --git a/user-programs/haippi7/project-laser-dot.folk b/user-programs/haippi7/project-laser-dot.folk
index 29e8a66c..5b55ca30 100644
--- a/user-programs/haippi7/project-laser-dot.folk
+++ b/user-programs/haippi7/project-laser-dot.folk
@@ -1,4 +1,4 @@
 When laser blob /t/ has center /c/ size /s/ {
     lassign [::cameraToProjector $c] cx cy
-    Display::text device $cx $cy 12 "Laser blob" 0
+    Display::text device $cx $cy 1 "Laser blob" 0
 }
\ No newline at end of file