From 1d51923528ad8815f3c6b03c95c92a0fd1fef076 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Andr=C3=A9s=20Cuervo?= <acwervo@gmail.com>
Date: Tue, 14 Mar 2023 15:27:12 -0400
Subject: Add polyline syntax, simplest shape

---
 virtual-programs/shapes.folk | 66 ++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 66 insertions(+)
 create mode 100644 virtual-programs/shapes.folk

(limited to 'virtual-programs')

diff --git a/virtual-programs/shapes.folk b/virtual-programs/shapes.folk
new file mode 100644
index 00000000..f0baa59b
--- /dev/null
+++ b/virtual-programs/shapes.folk
@@ -0,0 +1,66 @@
+Wish $this has filename "shapes.folk"
+
+# Tcl procs that depend on Display::stroke
+
+proc polyline {points {strokeWeight 5} {color white} args} {
+  set i 0
+  set pointsLength [llength $points]
+  set PL_less_one [expr {$pointsLength - 1}]
+  while {$i < $pointsLength} {
+      if {$i eq $PL_less_one} { return }
+      set current [lindex $points $i]
+      incr i
+      set next [lindex $points $i]
+      Display::stroke [list $current $next] $strokeWeight $color
+  }
+}
+
+proc rectangle {x y w h} {
+  set start [list $x $y]
+  set points [list $start]
+
+  puts [list [expr {$x + $w}] $y]
+
+  lappend points [list [expr {$x + $w}] $y]
+  lappend points [list [expr {$x + $w}] [expr {$y + $h}]]
+  lappend points [list $x [expr {$y + $h}]]
+  lappend points $start
+  polyline $points
+}
+
+# --- POLYLINE ---
+
+When /someone/ wishes /p/ has a polyline {
+  Wish $p is labelled "polyline!"
+  When $p has region /r/ {
+    polyline [lindex $r 0] 5 blue
+  }
+}
+
+set sizeDict [dict create small 1 medium 4 large 10]
+
+proc isSizeWord {word} {
+  expr {[lsearch [list small medium large] $word] >= 0}
+}
+
+When /someone/ wishes /p/ has a /attribute/ polyline {
+  Wish $p is labelled "ATTR: $attribute polyline"
+
+
+  When $p has region /r/ {
+    if {[isSizeWord $attribute]} {
+      polyline [lindex $r 0] [dict get $sizeDict $attribute] white
+      Wish $p is labelled [dict get $sizeDict $attribute]
+    } else {
+      polyline [lindex $r 0] 5 $attribute
+    }
+  }
+}
+
+When /someone/ wishes /p/ has a /attr1/ /attr2/ polyline {
+  Wish $p is labelled "$attr1 $attr2 polyline"
+  # TODO: make this less strict, rn assume $SIZE, $COLOR
+  When $p has region /r/ {
+    polyline [lindex $r 0] $attr1 $attr2
+  }
+}
-- 
cgit v1.2.3


From 301e4ebf308df30bd17e3653e6c206fc6141f1a0 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Andr=C3=A9s=20Cuervo?= <acwervo@gmail.com>
Date: Thu, 16 Mar 2023 13:25:12 -0400
Subject: Add rudimentary shapes & a little region docs helper

---
 virtual-programs/shapes.folk | 121 +++++++++++++++++++++++++++++++++++--------
 1 file changed, 99 insertions(+), 22 deletions(-)

(limited to 'virtual-programs')

diff --git a/virtual-programs/shapes.folk b/virtual-programs/shapes.folk
index f0baa59b..2e1e1589 100644
--- a/virtual-programs/shapes.folk
+++ b/virtual-programs/shapes.folk
@@ -1,7 +1,10 @@
 Wish $this has filename "shapes.folk"
 
-# Tcl procs that depend on Display::stroke
+set sizeDict [dict create small 1 medium 4 large 10]
 
+proc isSizeWord {word} {
+  expr {[lsearch [list small medium large] $word] >= 0}
+}
 proc polyline {points {strokeWeight 5} {color white} args} {
   set i 0
   set pointsLength [llength $points]
@@ -15,7 +18,9 @@ proc polyline {points {strokeWeight 5} {color white} args} {
   }
 }
 
-proc rectangle {x y w h} {
+# Use polyline to draw a rectangle
+
+proc rectangle {x y w h {strokeWeight 5} {color "white"}} {
   set start [list $x $y]
   set points [list $start]
 
@@ -25,42 +30,114 @@ proc rectangle {x y w h} {
   lappend points [list [expr {$x + $w}] [expr {$y + $h}]]
   lappend points [list $x [expr {$y + $h}]]
   lappend points $start
-  polyline $points
+  polyline $points $strokeWeight $color
 }
 
-# --- POLYLINE ---
-
-When /someone/ wishes /p/ has a polyline {
-  Wish $p is labelled "polyline!"
-  When $p has region /r/ {
-    polyline [lindex $r 0] 5 blue
-  }
+proc square {x y w {strokeWeight 5} {color "white"} args} {
+  rectangle $x $y $w $w $strokeWeight $color
+}
+# Use polyline to draw a triangle
+proc triangle {x y w h {strokeWeight 5} {color "white"}} {
+  set start [list $x $y]
+  set points [list $start]
+  lappend points [list [expr {$x + $w}] $y]
+  lappend points [list [expr {$x + $w / 2}] [expr {$y + $h}]]
+  lappend points $start
+  polyline $points $strokeWeight $color
 }
 
-set sizeDict [dict create small 1 medium 4 large 10]
+# --- RECTANGLE ---
 
-proc isSizeWord {word} {
-  expr {[lsearch [list small medium large] $word] >= 0}
+proc regionToInnerRect {region} {
+    set vertices [lindex $region 0]
+    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}]
+    return [list $x $y $width $height]
 }
 
-When /someone/ wishes /p/ has a /attribute/ polyline {
-  Wish $p is labelled "ATTR: $attribute polyline"
-
+When /someone/ wishes /p/ has a rectangle {
+  Wish $p has a white rectangle
+}
 
+When /someone/ wishes /p/ has a /attribute/ rectangle {
+  Wish $p is labelled "ATTR: $attribute rectangle "
   When $p has region /r/ {
+    lassign [regionToInnerRect $r] x y width height
+
     if {[isSizeWord $attribute]} {
-      polyline [lindex $r 0] [dict get $sizeDict $attribute] white
-      Wish $p is labelled [dict get $sizeDict $attribute]
+      rectangle $x $y $width $height [dict get $sizeDict $attribute] white
     } else {
-      polyline [lindex $r 0] 5 $attribute
+      rectangle $x $y $width $height 5 $attribute
     }
   }
 }
 
-When /someone/ wishes /p/ has a /attr1/ /attr2/ polyline {
-  Wish $p is labelled "$attr1 $attr2 polyline"
+When /someone/ wishes /p/ has a /attr1/ /attr2/ rectangle {
+  Wish $p is labelled "$attr1 $attr2 rectangle "
   # TODO: make this less strict, rn assume $SIZE, $COLOR
   When $p has region /r/ {
-    polyline [lindex $r 0] $attr1 $attr2
+    lassign [regionToInnerRect $r] x y width height
+    rectangle $x $y $width $height $attr1 $attr2
   }
 }
+
+proc trimParens {string} { string map {( "" ) ""} $string }
+
+When /someone/ wishes /p/ has a rectangle at /position/ {
+  When $p has region /r/ {
+    lassign [regionToInnerRect $r] x y width height
+    
+    lassign [split [trimParens $position] ,] posX posY
+    rectangle $posX $posY 100 100 5 red
+  }
+}
+
+# numPoints 2 => line
+# numPoints 3 => triangle
+# numPoints 4 => square
+proc shape {numPoints x y r {color white} args} {
+  set start [list $x $y]
+  set points [list $start]
+  set i 0
+  while {$i < $numPoints} {
+    incr i
+    set angle [expr {2 * 3.14159 * $i / $numPoints}]
+    set x [expr {$x + $r * cos($angle)}]
+    set y [expr {$y + $r * sin($angle)}]
+    lappend points [list $x $y]
+  }
+  polyline $points 5 $color
+}
+
+When /someone/ wishes /p/ has a circle {
+  When $p has region /r/ {
+    lassign [regionToInnerRect $r] x y width height
+    set radius [expr {$width * 0.035}]
+ 
+    set x [expr {$x + $width * 0.6}]
+    set y [expr {$y + $height * 0.1}]
+    shape 50 $x $y $radius green
+  }
+}
+
+# TODO: cwervo - extend this attr1 to be a bigger list, rn just color
+When /someone/ wishes /p/ has a /attr1/ triangle {
+  When $p has region /r/ {
+    lassign [regionToInnerRect $r] x y width height
+    set radius [expr {$width * 0.6}]
+ 
+    set x [expr {$x + $width * 0.8}]
+    set y [expr {$y + $height * 0.1}]
+    shape 3 $x $y $radius $attr1
+  }
+}
+
+When /someone/ wishes /p/ has a triangle {
+  Wish $p has a white triangle
+}
\ No newline at end of file
-- 
cgit v1.2.3


From 220da1a67bbf38f7bf28113dcbc20f04e0752d60 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Andr=C3=A9s=20Cuervo?= <acwervo@gmail.com>
Date: Thu, 16 Mar 2023 19:04:36 -0400
Subject: Change shapes syntax to 'draws shape offset {x y}'

---
 virtual-programs/shapes.folk | 110 ++++++++++++++++---------------------------
 1 file changed, 41 insertions(+), 69 deletions(-)

(limited to 'virtual-programs')

diff --git a/virtual-programs/shapes.folk b/virtual-programs/shapes.folk
index 2e1e1589..176f765b 100644
--- a/virtual-programs/shapes.folk
+++ b/virtual-programs/shapes.folk
@@ -18,8 +18,6 @@ proc polyline {points {strokeWeight 5} {color white} args} {
   }
 }
 
-# Use polyline to draw a rectangle
-
 proc rectangle {x y w h {strokeWeight 5} {color "white"}} {
   set start [list $x $y]
   set points [list $start]
@@ -36,17 +34,6 @@ proc rectangle {x y w h {strokeWeight 5} {color "white"}} {
 proc square {x y w {strokeWeight 5} {color "white"} args} {
   rectangle $x $y $w $w $strokeWeight $color
 }
-# Use polyline to draw a triangle
-proc triangle {x y w h {strokeWeight 5} {color "white"}} {
-  set start [list $x $y]
-  set points [list $start]
-  lappend points [list [expr {$x + $w}] $y]
-  lappend points [list [expr {$x + $w / 2}] [expr {$y + $h}]]
-  lappend points $start
-  polyline $points $strokeWeight $color
-}
-
-# --- RECTANGLE ---
 
 proc regionToInnerRect {region} {
     set vertices [lindex $region 0]
@@ -61,42 +48,7 @@ proc regionToInnerRect {region} {
     return [list $x $y $width $height]
 }
 
-When /someone/ wishes /p/ has a rectangle {
-  Wish $p has a white rectangle
-}
-
-When /someone/ wishes /p/ has a /attribute/ rectangle {
-  Wish $p is labelled "ATTR: $attribute rectangle "
-  When $p has region /r/ {
-    lassign [regionToInnerRect $r] x y width height
-
-    if {[isSizeWord $attribute]} {
-      rectangle $x $y $width $height [dict get $sizeDict $attribute] white
-    } else {
-      rectangle $x $y $width $height 5 $attribute
-    }
-  }
-}
-
-When /someone/ wishes /p/ has a /attr1/ /attr2/ rectangle {
-  Wish $p is labelled "$attr1 $attr2 rectangle "
-  # TODO: make this less strict, rn assume $SIZE, $COLOR
-  When $p has region /r/ {
-    lassign [regionToInnerRect $r] x y width height
-    rectangle $x $y $width $height $attr1 $attr2
-  }
-}
-
-proc trimParens {string} { string map {( "" ) ""} $string }
-
-When /someone/ wishes /p/ has a rectangle at /position/ {
-  When $p has region /r/ {
-    lassign [regionToInnerRect $r] x y width height
-    
-    lassign [split [trimParens $position] ,] posX posY
-    rectangle $posX $posY 100 100 5 red
-  }
-}
+# --- Wish $this has ... ----
 
 # numPoints 2 => line
 # numPoints 3 => triangle
@@ -115,29 +67,49 @@ proc shape {numPoints x y r {color white} args} {
   polyline $points 5 $color
 }
 
-When /someone/ wishes /p/ has a circle {
-  When $p has region /r/ {
-    lassign [regionToInnerRect $r] x y width height
-    set radius [expr {$width * 0.035}]
+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 x [expr {$x + $width * 0.6}]
-    set y [expr {$y + $height * 0.1}]
-    shape 50 $x $y $radius green
+  if {$offsetX != 0} {
+    set x [expr {$x + $offsetX}]
+  }
+  if {$offsetY != 0} {
+    set y [expr {$y + $offsetY}]
   }
-}
 
-# TODO: cwervo - extend this attr1 to be a bigger list, rn just color
-When /someone/ wishes /p/ has a /attr1/ triangle {
-  When $p has region /r/ {
-    lassign [regionToInnerRect $r] x y width height
-    set radius [expr {$width * 0.6}]
- 
-    set x [expr {$x + $width * 0.8}]
-    set y [expr {$y + $height * 0.1}]
-    shape 3 $x $y $radius $attr1
+  puts "drawing $shape at $x $y"
+
+  set adjustedWidth [expr {$width * 0.25}]
+  set x [expr { $x * 1.3}]
+  set y [expr { $y * 1.25}]
+  switch -nocase $shape {
+    triangle {
+      shape 3 $x $y $adjustedWidth $color
+    }
+    square {
+      shape 4 $x $y $adjustedWidth $color
+    }
+    # TODO: cwervo - fix magic numbers here
+    circle {
+      shape 10 [expr {$x * 0.98}] $y [expr {$adjustedWidth * 0.4}] $color
+    }
+    default {
+      shape 5 $x $y $adjustedWidth $color
+    }
   }
 }
 
-When /someone/ wishes /p/ has a triangle {
-  Wish $p has a white triangle
-}
\ No newline at end of file
+When /someone/ wishes /p/ draws a /color/ /shape/ & /p/ has region /r/ {
+  Wish $p draws a $color $shape offset {0 0}
+}
+
+When /someone/ wishes /p/ draws a /shape/ & /p/ has region /r/ {
+  Wish $p draws a white $shape
+}
+
+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
-- 
cgit v1.2.3