move programs/ -> virtual-programs/ in prep for printable programs

start working on print i guess

8 files changed, 117 insertions, 0 deletions

diff --git a/virtual-programs/archive/calibration-overlays.folk b/virtual-programs/archive/calibration-overlays.folk
new file mode 100644
index 00000000..07fa92cf
--- /dev/null
+++ b/virtual-programs/archive/calibration-overlays.folk
@@ -0,0 +1,12 @@
+set projectorPoints {
+	{2830 490}
+	{2830 2000}
+	{834 200}
+	{834 2000}
+}
+for {set i 0} {$i < [llength $projectorPoints]} {incr i} {
+	lassign [lindex $projectorPoints $i] px py
+	Claim "tag overlay $i" is a rectangle with x $px y $py width 20 height 20
+	Wish "tag overlay $i" is highlighted blue
+	Wish "tag overlay $i" is labelled "overlay $i ($px, $py)"
+}
\ No newline at end of file
diff --git a/virtual-programs/archive/points-up-test.folk b/virtual-programs/archive/points-up-test.folk
new file mode 100644
index 00000000..b0b90ae9
--- /dev/null
+++ b/virtual-programs/archive/points-up-test.folk
@@ -0,0 +1,8 @@
+Wish $this is highlighted blue
+
+Wish $this points up
+When $this points up at /target/ {
+	When $target has program code /code/ {
+		Wish $target is labelled "being pointed at"
+	}
+}
diff --git a/virtual-programs/archive/points-up.folk b/virtual-programs/archive/points-up.folk
new file mode 100644
index 00000000..24a3a4c9
--- /dev/null
+++ b/virtual-programs/archive/points-up.folk
@@ -0,0 +1,20 @@
+When /someone/ wishes /rect/ points up {
+    When $rect is a rectangle with x /x/ y /y/ width /width/ height /height/ {
+        set wx [expr {$x+$width/2}]
+        set wy [expr {$y-40}]
+        set ww 5
+        set wh 40
+        Claim $rect-whisker is a rectangle with x $wx y $wy width $ww height $wh
+        Wish $rect-whisker is highlighted green
+
+        When /target/ is a rectangle with x /tx/ y /ty/ width /tw/ height /th/ {
+            if {$target != $rect && \
+                    [rectanglesOverlap \
+                         [list $wx $wy] [list [expr {$wx+$ww}] [expr {$wy+$wh}]] \
+                         [list $tx $ty] [list [expr {$tx+$tw}] [expr {$ty+$th}]] \
+                         false]} {
+                Claim $rect points up at $target
+            }
+        }
+    }
+}
diff --git a/virtual-programs/highlight.folk b/virtual-programs/highlight.folk
new file mode 100644
index 00000000..81150127
--- /dev/null
+++ b/virtual-programs/highlight.folk
@@ -0,0 +1,8 @@
+When /rect/ is a rectangle with x /x/ y /y/ width /width/ height /height/ {
+    When /someone/ wishes $rect is highlighted /color/ {
+        # it's not really correct to just stick a side-effect in the
+        # When handler like this. but we did it in Realtalk, and it
+        # was ok, so whatever for now
+        Display::fillRect device $x $y [expr $x+$width] [expr $y+$height] $color
+    }
+}
diff --git a/virtual-programs/keyboard-character-log.folk b/virtual-programs/keyboard-character-log.folk
new file mode 100644
index 00000000..651fe716
--- /dev/null
+++ b/virtual-programs/keyboard-character-log.folk
@@ -0,0 +1,3 @@
+Wish $this is highlighted red
+
+Wish $this is labelled $::stepTime
\ No newline at end of file
diff --git a/virtual-programs/label.folk b/virtual-programs/label.folk
new file mode 100644
index 00000000..29db90c1
--- /dev/null
+++ b/virtual-programs/label.folk
@@ -0,0 +1,7 @@
+When /rect/ is a rectangle with x /x/ y /y/ width /width/ height /height/ {
+    When /someone/ wishes $rect is labelled /text/ {
+        set longestLineLength [tcl::mathfunc::max {*}[lmap line [split $text "\n"] {string length $line}]]
+        set fontSize [expr $width / $longestLineLength]
+        Display::text device [expr $x+$width/2] [expr $y+$height/2] $fontSize $text
+    }
+}
diff --git a/virtual-programs/print.folk b/virtual-programs/print.folk
new file mode 100644
index 00000000..24e5e8e2
--- /dev/null
+++ b/virtual-programs/print.folk
@@ -0,0 +1,3 @@
+When /someone/ wishes to print /code/ with job id /jobid/ {
+    
+}
\ No newline at end of file
diff --git a/virtual-programs/tags-and-calibration.folk b/virtual-programs/tags-and-calibration.folk
new file mode 100644
index 00000000..7aea3c98
--- /dev/null
+++ b/virtual-programs/tags-and-calibration.folk
@@ -0,0 +1,56 @@
+package require math::linearalgebra
+
+set points {
+	{803 508 2830 2000}
+	{313 68 834 200}
+	{364 506 834 2000}
+	{831 174 2830 490}
+}
+for {set i 0} {$i < [llength $points]} {incr i} {
+    lassign [lindex $points $i] x$i y$i u$i v$i
+}
+
+set A [subst {
+    {$x0 $y0 1 0   0   0 [expr -$x0*$u0] [expr -$y0*$u0]}
+    {$x1 $y1 1 0   0   0 [expr -$x1*$u1] [expr -$y1*$u1]}
+    {$x2 $y2 1 0   0   0 [expr -$x2*$u2] [expr -$y2*$u2]}
+    {$x3 $y3 1 0   0   0 [expr -$x3*$u3] [expr -$y3*$u3]}
+    {0   0   0 $x0 $y0 1 [expr -$x0*$v0] [expr -$y0*$v0]}
+    {0   0   0 $x1 $y1 1 [expr -$x1*$v1] [expr -$y1*$v1]}
+    {0   0   0 $x2 $y2 1 [expr -$x2*$v2] [expr -$y2*$v2]}
+    {0   0   0 $x3 $y3 1 [expr -$x3*$v3] [expr -$y3*$v3]}
+}]
+
+set b [list $u0 $u1 $u2 $u3 $v0 $v1 $v2 $v3]
+
+lassign [math::linearalgebra::solvePGauss $A $b] a0 a1 a2 b0 b1 b2 c0 c1
+
+set ::H [subst {
+    {$a0 $a1 $a2}
+    {$b0 $b1 $b2}
+    {$c0 $c1 1}
+}]
+
+proc cameraToProjector {cameraPoint} {
+    lassign [math::linearalgebra::matmul $::H [list [lindex $cameraPoint 0] [lindex $cameraPoint 1] 1]] Hx Hy Hz
+    set Hx [expr $Hx / $Hz]
+    set Hy [expr $Hy / $Hz]
+    return [list $Hx $Hy]
+}
+# Wish $this is highlighted white
+
+When tag /tag/ has center /c/ size /size/ {
+	lassign [cameraToProjector $c] px py
+	Wish $tag is labelled "tag $tag at $c"
+}
+
+When tag /tag/ has corners /corners/ {
+	set corners [lmap p $corners {cameraToProjector $p}]
+	Display::stroke [list {*}$corners [lindex $corners 0]] 2 green
+	foreach corner $corners {
+		lassign $corner x y
+		# Display::fillRect fb $x $y [expr $x+10] [expr $y+10] white
+		Display::text fb $x $y 10 $tag
+	}
+}
+