Merge pull request #44 from FolkComputer/osnr/regions

New region utilities

6 files changed, 20 insertions, 136 deletions

diff --git a/virtual-programs/label.folk b/virtual-programs/label.folk
index d18bdd02..eeaaf143 100644
--- a/virtual-programs/label.folk
+++ b/virtual-programs/label.folk
@@ -5,16 +5,8 @@ When /thing/ has region /region/ {
     set height [boxHeight $bbox]
 
 
-    set radians [lindex $region 2]
-    if {$radians eq ""} {set radians 0}
-
-    set upsidedown [expr {abs($radians) < 1.57}]
-    if ($upsidedown) {
-        set x [expr {$x + $width * 0.4}]
-        set y [expr {$y - $height * 0.2}]
-    } else {
-        set x [expr {$x - $width * 0.4}]
-    }
+    set radians [region angle $region]
+    set upsidedown [expr {$radians > 1.57 || $radians < -1.57}]
     if {$::isLaptop} {set upsidedown false}
 
     When the collected matches for [list /someone/ wishes $thing is labelled /text/] are /matches/ {
diff --git a/virtual-programs/new-program-web-editor.folk b/virtual-programs/new-program-web-editor.folk
index 5797365b..305dde8f 100644
--- a/virtual-programs/new-program-web-editor.folk
+++ b/virtual-programs/new-program-web-editor.folk
@@ -155,7 +155,7 @@ Wish the web server handles route "/new" with handler {
 	  setTimeout(() => {
 	    send(`
 set errors [Statements::findMatches [list {${program}} has error /err/ with info /errorInfo/]]
-join [list "Error:" {*}[lmap e $errors {dict get $e errorInfo}]] "\n"
+::websocket::send $chan text [join [list "Error:" {*}[lmap e $errors {dict get $e errorInfo}]] "\n"]
 `);
 	  }, 500);
 	}
diff --git a/virtual-programs/points-at.folk b/virtual-programs/points-at.folk
index 5c79cf1e..773d42b3 100644
--- a/virtual-programs/points-at.folk
+++ b/virtual-programs/points-at.folk
@@ -1,50 +1,28 @@
-set pi 3.1415926535897931
-
 When when /rect/ points /direction/ at /someone/ /lambda/ with environment /e/ {
   Wish $rect points $direction
 }
 
 When /someone/ wishes /rect/ points /direction/ & /rect/ has region /region/ {
-    lassign $region vertices edges
-    lassign $vertices a b c d
-
-    set cx [expr {([lindex $a 0] + [lindex $c 0])/2}]
-    set cy [expr {([lindex $a 1] + [lindex $c 1])/2}]
-
-    set width [vec2 distance $a $b]
-    set height [vec2 distance $a $d]
-
-    set radians [lindex $region 2]
-    if {$radians eq ""} {set radians 0}
-
-    set whisker_radians $radians
-    set fac -1.0
-    set whisker_size [expr {$width * $fac}]
-    set color green
-
     if {$direction eq "up"} {
-        set whisker_radians [expr {$radians + $pi / 2}]
-        set whisker_size [expr {$height * $fac}]
+        set whiskerRegion [region move [region scale $region width 0.01px] up 51%]
         set color blue
-    } 
-    if {$direction eq "left"} {
-        set whisker_radians [expr {$radians + $pi}]
+    } elseif {$direction eq "left"} {
+        set whiskerRegion [region move [region scale $region height 0.01px] left 51%]
         set color red
-    } 
-    if {$direction eq "down"} {
-        set whisker_radians [expr {$radians + $pi * 1.5}]
-        set whisker_size [expr {$height * $fac}]
+    } elseif {$direction eq "right"} {
+        set whiskerRegion [region move [region scale $region height 0.01px] right 51%]
+        set color green
+    } elseif {$direction eq "down"} {
+        set whiskerRegion [region move [region scale $region width 0.01px] down 51%]
         set color white
-    } 
-
-    set wx [expr {$cx + $whisker_size * [::tcl::mathfunc::cos [expr {-1 * $whisker_radians}]] }]
-    set wy [expr {$cy + $whisker_size * [::tcl::mathfunc::sin [expr {-1 * $whisker_radians}]] }]
-
-    Display::stroke [list [list $cx $cy] [list $wx $wy] ] 4 $color
+    }
+    set whisker [list $rect whisker $direction]
+    Claim $whisker has region $whiskerRegion
+    Wish $whisker is outlined $color
 
     When /target/ has region /r2/ {
-        if {$target != $rect && \
-                [region contains $r2 [list $wx $wy]]} {
+        if {$target != $rect && $target != $whisker && \
+                [region intersects $whiskerRegion $r2]} {
             Claim $rect points $direction at $target
         }
     }
diff --git a/virtual-programs/regions.folk b/virtual-programs/regions.folk
index 8f320b42..5de19b98 100644
--- a/virtual-programs/regions.folk
+++ b/virtual-programs/regions.folk
@@ -1,87 +1,3 @@
-namespace eval ::vec2 {
-    proc add {a b} {
-        list [+ [lindex $a 0] [lindex $b 0]] [+ [lindex $a 1] [lindex $b 1]]
-    }
-    proc sub {a b} {
-        list [- [lindex $a 0] [lindex $b 0]] [- [lindex $a 1] [lindex $b 1]]        
-    }
-    proc scale {s a} {
-        list [* $s [lindex $a 0]] [* $s [lindex $a 1]]
-    }
-    proc distance {a b} {
-        lassign $a ax ay
-        lassign $b bx by
-        expr {sqrt(pow($ax-$bx, 2) + pow($ay-$by, 2))}
-    }
-    proc normalize {a} {
-        set l2 [vec2 distance $a [list 0 0]]
-        vec2 scale [/ 1 $l2] $a
-    }
-    proc dot {a b} {
-        expr {[lindex $a 0]*[lindex $b 0] + [lindex $a 1]*[lindex $b 1]}
-    }
-    proc distanceToLineSegment {a v w} {
-        set l2 [vec2 distance $v $w]
-        if {$l2 == 0.0} {
-            return [distance $a $v]
-        }
-        set t [max 0 [min 1 [/ [dot [sub $a $v] [sub $w $v]] $l2]]]
-        set proj [add $v [scale $t [sub $w $v]]]
-        vec2 distance $a $proj
-    }
-    namespace export *
-    namespace ensemble create
-}
-
-namespace eval ::region {
-    proc new {vertices edges angle space} {
-        list region $vertices $edges $angle $space
-    }
-
-    proc vertices {r} { lindex $r 0 }
-    proc edges {r} { lindex $r 1 }
-
-    proc edgeToLineSegment {r e} {
-        list [lindex [vertices $r] [lindex $e 0]] [lindex [vertices $r] [lindex $e 1]]
-    }
-    proc distance {r1 r2} {
-	puts $r2
-        set minDist 1e9
-        foreach v1 [vertices $r1] e2 [edges $r2] {
-            set dist [vec2 distanceToLineSegment $v1 {*}[edgeToLineSegment $r2 $e2]]
-            if {$dist < $minDist} { set minDist $dist }
-        }
-        set minDist
-    }
-
-    proc contains {r1 p} {
-        lassign $r1 vertices edges
-        lassign $vertices a b c d
-
-        set ab [vec2 sub $b $a]
-        set ap [vec2 sub $p $a]
-        set bc [vec2 sub $c $b]
-        set bp [vec2 sub $p $b]
-        set dot_abap [vec2 dot $ab $ap]
-        set dot_bcbp [vec2 dot $bc $bp]
-
-        expr {0 <= $dot_abap && $dot_abap <= [vec2 dot $ab $ab] && \
-                0 <= $dot_bcbp && $dot_bcbp <= [vec2 dot $bc $bc]}
-    }
-
-   proc centroid {r1} {
-        # This only works for rectangular regions
-        lassign $r1 vertices edges
-        lassign $vertices a b c d
-
-        set vecsum [vec2 add [vec2 add [vec2 add $a $b] $c] $d]
-        vec2 scale 0.25 $vecsum
-    }
-
-    namespace export distance contains centroid
-    namespace ensemble create
-}
-
 When when the distance between /p1/ and /p2/ is /distanceVar/ /body/ with environment /e/ & /p1/ has region /r1/ & /p2/ has region /r2/ {
     Claim the distance between $p1 and $p2 is [region distance $r1 $r2]
 }
diff --git a/virtual-programs/tags-and-calibration.folk b/virtual-programs/tags-and-calibration.folk
index cf252de6..2ad6cb59 100644
--- a/virtual-programs/tags-and-calibration.folk
+++ b/virtual-programs/tags-and-calibration.folk
@@ -76,9 +76,6 @@ proc ::projectorToCamera {projectorPoint} {
 
 When (non-capturing) 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]
 }
 
 When (non-capturing) tag /tag/ is a tag {
@@ -116,7 +113,8 @@ When (non-capturing) tag /tag/ has corners /corners/ {
     }
     lappend edges [list [expr {[llength $corners] - 1}] 0]
 
-    set region [list $corners $edges [::tcl::mathfunc::atan2 {*}$vecRight]] 
+    set angle [expr {atan2(-[lindex $vecBottom 1], [lindex $vecBottom 0])}]
+    set region [list $corners $edges $angle]
 
     Claim $tag has region $region
 }
diff --git a/virtual-programs/web-editor.folk b/virtual-programs/web-editor.folk
index ae14f9b4..245b6043 100644
--- a/virtual-programs/web-editor.folk
+++ b/virtual-programs/web-editor.folk
@@ -100,7 +100,7 @@ Wish the web server handles route {/page/(.*)$} with handler {
             setTimeout(() => {
               send(`
 set errors [Statements::findMatches [list program_id has error /err/ with info /errorInfo/]]
-join [list "Error:" {*}[lmap e $errors {dict get $e errorInfo}]] "\n"
+::websocket::send $chan text [join [list "Error:" {*}[lmap e $errors {dict get $e errorInfo}]] "\n"]
 `);
             }, 500);
           }