Merge branch 'main' into osnr/camera-pipeline

2 files changed, 71 insertions, 37 deletions

diff --git a/virtual-programs/images.folk b/virtual-programs/images.folk
index 42adeb10..e2af03af 100644
--- a/virtual-programs/images.folk
+++ b/virtual-programs/images.folk
@@ -1,31 +1,61 @@
-# Images
 
-Wish $this has filename "images.folk"
+# Example program, i.e the public API
+#
+# When $this has camera slice /slice/ {
+#     Wish $this displays camera slice $slice
+# }
 
+
+# Generic image class for sub-image manipulations
 namespace eval ::image {
-	proc width {im} { dict get $im width }
-	proc height {im} { dict get $im height }
-	proc subimage {im x y subwidth subheight} {
-		dict with im {
-			set x [expr {int($x)}]
-			set y [expr {int($y)}]
-			set subdata [expr {$data + ($y*$width + $x) *
-				$components}]
-			dict create \
-				width $subwidth height $subheight \
-				components $components \
-				bytesPerRow $bytesPerRow \
-				data [format 0x%x $subdata]
-		}
+    proc width {im} { dict get $im width }
+    proc height {im} { dict get $im height }
+    proc subimage {im x y subwidth subheight} {
+	dict with im {
+	    set x [expr {int($x)}]
+	    set y [expr {int($y)}]
+	    set subdata [expr {$data + ($y*$width + $x) * $components}]
+	    dict create \
+		width $subwidth \
+		height $subheight \
+		components $components \
+		bytesPerRow $bytesPerRow \
+		data [format 0x%x $subdata]
 	}
-	namespace export *
-	namespace ensemble create
+    }
+    namespace export *
+    namespace ensemble create
+}
+
+# Callback: extract out a camera slice
+When /someone/ wishes /p/ has camera slice & \
+     the camera frame is /f/ & \
+     /p/ has region /r/ {
+
+    # Convert region in projector coordinates to camera
+    lassign [regionToBbox $r] minX minY maxX maxY
+    lassign [projectorToCamera [list $minX $minY]] px0 py0
+    lassign [projectorToCamera [list $maxX $maxY]] px1 py1
+
+    # Clamp to image bounds
+    set x [expr {int(max($px0, 0))}]
+    set y [expr {int(max($py0, 0))}]
+    set w [expr {int(min(abs($px1 - $px0), [image width $f]))}]
+    set h [expr {int(min(abs($py1 - $py0), [image height $f]))}]
+
+    # Extract and claim the image for the page
+    set subimage [image subimage $f $x $y $w $h]
+    Claim $p has camera slice $subimage
+}
+
+# Auto-trigger callback for `when has camera slice` statements
+When when /p/ has camera slice /slice/ /lambda/ with environment /e/ {
+  Wish $p has camera slice
 }
 
-When /someone/ wishes /p/ has camera image & the camera frame is /f/ & /p/ has region /r/ {
-	lassign [regionToBbox $r] minX minY maxX maxY
-	set subimage [image subimage $f \
-		$minX $minY \
-		[expr {int($maxX - $minX)}] [expr {int($maxY - $minY)}]]
-	Claim $p has camera image $subimage
+# Display a camera slice
+When /someone/ wishes /p/ displays camera slice /slice/ & /p/ has region /r/ {
+  set origin [lindex $r 0 0]
+  set scale [expr {$Display::WIDTH / $Camera::WIDTH}]
+  Wish display runs [list Display::image {*}$origin $slice $scale]
 }
diff --git a/virtual-programs/label.folk b/virtual-programs/label.folk
index 29745a5a..3a5f7f38 100644
--- a/virtual-programs/label.folk
+++ b/virtual-programs/label.folk
@@ -3,26 +3,30 @@ Wish $this has filename "label.folk"
 When /thing/ has region /region/ {
     set bbox [regionToBbox $region]
     lassign [boxCentroid $bbox] x y
+    set width [boxWidth $bbox]
+    set height [boxHeight $bbox]
 
     set radians [lindex $region 2]
     if {$radians eq ""} {set radians 0}
 
-    set shouldFlip [expr {abs($radians) < 1.57}]
-    if {$::isLaptop} { set shouldFlip false }
+    set upsidedown [expr {abs($radians) < 1.57}]
+    if {$::isLaptop} {set upsidedown false}
 
     When the collected matches for [list /someone/ wishes $thing is labelled /text/] are /matches/ {
         set text [join [lmap match $matches {dict get $match text}] "\n"]
         if {$text eq ""} { return }
-
         set lines [split $text "\n"]
-        if {$shouldFlip} {set lines [lreverse $lines]}
-        set fontSize 1
+
+        set lines [expr {$upsidedown ? [lreverse $lines] : $lines}]
+        set scale 1
+        set fontSize [expr {18 * $scale}]
+
         for {set lineNum 0} {$lineNum < [llength $lines]} {incr lineNum} {
-            set ly [expr {$shouldFlip ? $y+$lineNum*$fontSize*18 : $y+$lineNum*$fontSize*18}]
-            Display::text device $x $ly $fontSize [lindex $lines $lineNum] $radians
+            set line [lindex  $lines $lineNum]
+            set ly [expr {$y + $lineNum * $fontSize}]
+            Display::text device $x $ly $scale $line $radians
         }
     }
-    # with environment [dict create x $x y $y radians $radians shouldFlip $shouldFlip]
 }
 
 fn text {coords text angle} {
@@ -30,8 +34,8 @@ fn text {coords text angle} {
 }
 
 When /anyone/ wishes /p/ has halo message /message/ & /p/ has region /r/ {
-	lassign [lindex $r 0] a b c d
-	lassign $a x y
-	text $a $message 0
-	text $d $message 180
-}
\ No newline at end of file
+        lassign [lindex $r 0] a b c d
+        lassign $a x y
+        text $a $message 0
+        text $d $message 180
+}