Merge branch 'main' into haip/laser-blob-tracking

3 files changed, 42 insertions, 19 deletions

diff --git a/virtual-programs/label.folk b/virtual-programs/label.folk
index 52bfae11..036e8752 100644
--- a/virtual-programs/label.folk
+++ b/virtual-programs/label.folk
@@ -23,3 +23,17 @@ When /thing/ has region /region/ {
 		}
 	}
 }
+
+proc text {coords text angle} {
+  Display::text Display::fb [lindex $coords 0] [lindex $coords 1] _ $text $angle
+}
+
+When /anyone/ wishes /p/ has halo message /message/ {
+  When $p has region /r/ {
+     lassign [lindex $r 0] a b c d
+     lassign $a x y
+     text $a $message 0
+     text $d $message 180
+     Wish $this is labelled TEST
+  }
+}
\ No newline at end of file
diff --git a/virtual-programs/shapes.folk b/virtual-programs/shapes.folk
index 176f765b..f5c913aa 100644
--- a/virtual-programs/shapes.folk
+++ b/virtual-programs/shapes.folk
@@ -40,11 +40,10 @@ proc regionToInnerRect {region} {
     lassign $vertices a b c d
     lassign $a aX aY
     lassign $c cX cY
-    set shrinkConstant 0.65
-    set width [expr {($cX - $aX) * $shrinkConstant}]
-    set height [expr {($cY - $aY) * $shrinkConstant}]
-    set x [expr {$aX + $width * 0.25}]
-    set y [expr {$aY + $height * 0.25}]
+    set width [expr {($cX - $aX)}]
+    set height [expr {($cY - $aY)}]
+    set x [expr {$aX + $width * 0.5}]
+    set y [expr {$aY + $height * 0.5}]
     return [list $x $y $width $height]
 }
 
@@ -53,7 +52,7 @@ proc regionToInnerRect {region} {
 # numPoints 2 => line
 # numPoints 3 => triangle
 # numPoints 4 => square
-proc shape {numPoints x y r {color white} args} {
+proc shape {numPoints x y r {color white} {filled false} args} {
   set start [list $x $y]
   set points [list $start]
   set i 0
@@ -64,13 +63,18 @@ proc shape {numPoints x y r {color white} args} {
     set y [expr {$y + $r * sin($angle)}]
     lappend points [list $x $y]
   }
-  polyline $points 5 $color
+  if {$filled} {
+    polyline $points 10 $color
+  } else {
+    polyline $points 2 $color
+  }
 }
 
 When /someone/ wishes /p/ draws a /color/ /shape/ offset /offsetVector/ & /p/ has region /r/ {
   lassign [regionToInnerRect $r] x y width height
   lassign $offsetVector offsetX offsetY
- 
+
+  set filled false
   if {$offsetX != 0} {
     set x [expr {$x + $offsetX}]
   }
@@ -81,21 +85,22 @@ When /someone/ wishes /p/ draws a /color/ /shape/ offset /offsetVector/ & /p/ ha
   puts "drawing $shape at $x $y"
 
   set adjustedWidth [expr {$width * 0.25}]
-  set x [expr { $x * 1.3}]
-  set y [expr { $y * 1.25}]
+  set x [expr { $x + $offsetX}]
+  set y [expr { $y + $offsetY}]
+
   switch -nocase $shape {
     triangle {
-      shape 3 $x $y $adjustedWidth $color
+      shape 3 $x $y $adjustedWidth $color $filled
     }
     square {
-      shape 4 $x $y $adjustedWidth $color
+      shape 4 $x $y $adjustedWidth $color $filled
     }
     # TODO: cwervo - fix magic numbers here
     circle {
-      shape 10 [expr {$x * 0.98}] $y [expr {$adjustedWidth * 0.4}] $color
+      shape 10 [expr {$x * 0.98}] $y [expr {$adjustedWidth * 0.4}] $color $filled
     }
     default {
-      shape 5 $x $y $adjustedWidth $color
+      shape 5 $x $y $adjustedWidth $color $filled
     }
   }
 }
@@ -112,4 +117,4 @@ When /someone/ wishes /p/ draws a /shape/ offset /offsetVector/ {
   Wish $p draws a white $shape offset $offsetVector 
 }
 
-# --- TODO: Wish table has ... ----
\ No newline at end of file
+# --- TODO: Wish table has ... ----
diff --git a/virtual-programs/tags-and-calibration.folk b/virtual-programs/tags-and-calibration.folk
index dd0622be..bc39033e 100644
--- a/virtual-programs/tags-and-calibration.folk
+++ b/virtual-programs/tags-and-calibration.folk
@@ -71,12 +71,12 @@ proc ::projectorToCamera {projectorPoint} {
 }
 # Wish $this is highlighted white
 
-When tag /tag/ has center /c/ size /size/ {
+Say when tag /tag/ has center /c/ size /size/ {
      Claim tag $tag is a tag
 
      lassign [cameraToProjector $c] px py
      Claim $tag is a rectangle with x [expr $px-20] y [expr $py-10] width [expr $size*2] height [expr $size*2]
-}
+} with environment {}
 
 When tag /tag/ is a tag {
      puts "Added tag $tag"
@@ -90,9 +90,9 @@ When tag /tag/ is a tag {
 }
 
 
-When tag /tag/ has corners /corners/ {
+Say when tag /tag/ has corners /corners/ {
 	set tagcorners [lmap p $corners {cameraToProjector $p}]
-	foreach tagcorner $tagcorners { Display::text fb {*}$tagcorner 10 "$tag" }
+	#foreach tagcorner $tagcorners { Display::text fb {*}$tagcorner 10 "$tag" }
 	set tagbottom [sub [lindex $tagcorners 1] [lindex $tagcorners 0]]
 	set tagright [sub [lindex $tagcorners 2] [lindex $tagcorners 1]]
 
@@ -105,4 +105,8 @@ When tag /tag/ has corners /corners/ {
 	lappend edges [list [expr {[llength $corners] - 1}] 0]
 	set region [list $corners $edges [::tcl::mathfunc::atan2 {*}$tagright]] 
 	Claim $tag has region $region
+} with environment {
+    %matmul ::math::linearalgebra::matmul
+    %sub ::math::linearalgebra::sub
+    %add ::math::linearalgebra::add
 }