From 9864b196b405231b00d74b3d4c78e4fbfe9136ae Mon Sep 17 00:00:00 2001 From: Mason Jones <20848827+smj-edison@users.noreply.github.com> Date: Fri, 7 Feb 2025 11:13:27 -0800 Subject: [PATCH 01/35] Don't add confusing params to config example, tweak params too --- setup.folk.default | 4 ++-- virtual-programs/camera-usb.folk | 2 +- virtual-programs/display.folk | 4 ++-- 3 files changed, 5 insertions(+), 5 deletions(-) diff --git a/setup.folk.default b/setup.folk.default index b43adab4..1ef1dfb1 100644 --- a/setup.folk.default +++ b/setup.folk.default @@ -1,6 +1,6 @@ # Copy this file to ~/folk-live/setup.folk and edit it to make # changes. -Assert $this wishes $::thisNode uses camera "/dev/video0" with width 1280 height 720 bufferCount 4 +Assert $this wishes $::thisNode uses camera "/dev/video0" with width 1280 height 720 -Assert $this wishes $::thisNode uses display 0 with swapchainPadding 1 +Assert $this wishes $::thisNode uses display 0 diff --git a/virtual-programs/camera-usb.folk b/virtual-programs/camera-usb.folk index a17f3ce3..f14ad8b0 100644 --- a/virtual-programs/camera-usb.folk +++ b/virtual-programs/camera-usb.folk @@ -301,7 +301,7 @@ When /someone/ wishes $::thisNode uses camera /cameraPath/ with /...options/ { set width [dict get $options width] set height [dict get $options height] - set bufferCount [dict_getdef $options bufferCount 4] + set bufferCount [dict_getdef $options bufferCount 2] if {[dict exists $options crop]} { set crop [dict get $options crop] diff --git a/virtual-programs/display.folk b/virtual-programs/display.folk index 5e6bdebb..0f1f0747 100644 --- a/virtual-programs/display.folk +++ b/virtual-programs/display.folk @@ -1640,9 +1640,9 @@ Start-display-process { Wish $::thisProcess shares statements like \ [list /someone/ has error /err/ with info /errorInfo/] - # for backwards compatibility + # If swapchain padding isn't indicated, default to this When /someone/ wishes $::thisNode uses display /displayIdx/ { - Wish $::thisNode uses display $displayIdx with swapchainPadding 1 + Wish $::thisNode uses display $displayIdx with swapchainPadding 0 } When /someone/ wishes $::thisNode uses display /displayIdx/ with /...options/ { From 8d21f8137dc7f85ea1b7580d0349be3aa90629a9 Mon Sep 17 00:00:00 2001 From: Mason Jones <20848827+smj-edison@users.noreply.github.com> Date: Mon, 10 Feb 2025 20:23:53 -0800 Subject: [PATCH 02/35] Add bidirectional editor support --- lib/folk.js | 93 +++++++++++----- virtual-programs/editor-control.folk | 152 +++++++++++++++++++++++++++ 2 files changed, 220 insertions(+), 25 deletions(-) create mode 100644 virtual-programs/editor-control.folk diff --git a/lib/folk.js b/lib/folk.js index b64e4f46..3575f77f 100644 --- a/lib/folk.js +++ b/lib/folk.js @@ -24,8 +24,8 @@ const eatBrace = (str) => { if (bc === 0) { return [ - str.slice(0, i+1), - str.slice(i+1), + str.slice(0, i + 1), + str.slice(i + 1), ]; } } @@ -118,8 +118,8 @@ const loadDict = (str) => { if (list.length % 2 !== 0) throw new Error('uneven element count in dict'); const obj = {}; - for (let i = 0; i < list.length; i+= 2) - obj[list[i]] = list[i+1]; + for (let i = 0; i < list.length; i += 2) + obj[list[i]] = list[i + 1]; return obj; }; @@ -141,7 +141,7 @@ const dump = (val) => { return dumpString(val.toString()); } else if (typeof val == 'object') { const core = Object.entries(val) - .map(([k, v]) => dump(k) + ' ' + dump(v)); + .map(([k, v]) => dump(k) + ' ' + dump(v)); return '{' + core.join(' ') + '}'; } @@ -170,18 +170,21 @@ class FolkWSChannel { this.prefix = prefix; this.callback = callback; this.ws.channels[prefix] = this; + this.retractKey = null; } stop() { + this.ws.ws.send(`Retract ${this.retractKey}`); if (this.ws.channels[this.prefix] !== this) return; delete this.ws.channels[this.prefix]; } } class FolkWS { - constructor(statusEl=null, url=null) { + constructor(statusEl = null, url = null) { this.channels = {}; this.i = 0; + this.assertSeq = 0; this._connect(statusEl, url); } @@ -247,12 +250,21 @@ class FolkWS { } // Evaluates inside a match context dependent on the WS connection: async send(message) { - await this.evaluate(tcl`Assert when websocket $chan is connected [list {this __seq} ${message}] with environment [list $chan [incr ::__seq]]`); + const seqNumber = this.assertSeq++; + const assertBody = tcl`when websocket $chan is connected [list {this __seq} ${message}] with environment [list $chan ${seqNumber}]`; + await this.evaluate(`Assert ${assertBody}`); + + const retractKey = assertBody; + return retractKey; } // Evaluates inside a persistent match context that replaces any // previous hold with same key: async hold(key, program, on = '$chan') { - await this.evaluate(tcl`Hold (non-capturing) (on ${on}) ${key} ${program}`); + if (on !== null) { + await this.evaluate(tcl`Hold (non-capturing) (on ${on}) ${key} ${program}`); + } else { + await this.evaluate(tcl`Hold (non-capturing) ${key} ${program}`); + } } async watchCollected(statement, onChange) { @@ -270,36 +282,67 @@ class FolkWS { async watch(statement, callbacks) { const channel = this.createChannel((message) => { - const [ action, match, matchId ] = loadList(message); + const [action, match, matchId] = loadList(message); const callback = callbacks[action]; callback && callback(loadDict(match), matchId); }); - await this.send(tcl` - set varNamesWillBeBound [list] - foreach word ${statement} { - if {[set varName [trie scanVariable $word]] != "false"} { + const retractKey = await this.send(tcl` + # for the top level Say + set outerVarNames [list] + # for inner When's + set innerVarNames [list] + set statement ${statement} + set body { + set matches [dict create] + foreach varName $names { + set val [set $varName] + dict append matches $varName $val + } + emit ${channel.prefix} [list add $matches $::matchId] + On unmatch { + emit ${channel.prefix} [list remove $matches $::matchId] + } + } + for {set i 0} {$i < [llength $statement]} {incr i} { + set word [lindex $statement $i] + if {$word eq "&"} { + # Desugar this join into nested Whens. + set remainingStatement [lrange $statement $i+1 end] + set statement [lrange $statement 0 $i-1] + for {set j 0} {$j < [llength $remainingStatement]} {incr j} { + set remainingWord [lindex $remainingStatement $j] + if {[set varName [trie scanVariable $remainingWord]] != "false"} { + if {$varName ni $statement::blanks && $varName ni $statement::negations} { + if {[string range $varName 0 2] eq "..."} { + set varName [string range $varName 3 end] + } + lappend innerVarNames $varName + } + } + if {[regexp {^/([^/ ]+)/$} $remainingWord -> remainingVarName] && + $remainingVarName in $outerVarNames} { + lset remainingStatement $j \\$$remainingVarName + } + } + set body [list When {*}$remainingStatement $body] + break + } elseif {[set varName [trie scanVariable $word]] != "false"} { if {$varName ni $statement::blanks && $varName ni $statement::negations} { if {[string range $varName 0 2] eq "..."} { set varName [string range $varName 3 end] } - lappend varNamesWillBeBound $varName + lappend outerVarNames $varName } } } - Say when {*}${statement} {{this names args} { - set matches [dict create] - foreach varName $names val $args { - dict append matches $varName $val - } - - emit ${channel.prefix} [list add $matches $::matchId] - On unmatch { - emit ${channel.prefix} [list remove $matches $::matchId] - } - }} with environment [list $this $varNamesWillBeBound] + # join both variable names to be sent along the websocket in the innermost When + set combinedVarNames [concat $outerVarNames $innerVarNames] + Say when {*}$statement [list [list this names {*}$outerVarNames] $body] with environment [list $this $combinedVarNames] `); + channel.retractKey = retractKey; + return channel; } } diff --git a/virtual-programs/editor-control.folk b/virtual-programs/editor-control.folk new file mode 100644 index 00000000..4f8f1504 --- /dev/null +++ b/virtual-programs/editor-control.folk @@ -0,0 +1,152 @@ +When /page/ has editor code /editorCode/ & /page/ has program code /programCode/ { + Claim $page has base64 editor code [binary encode base64 $editorCode] \ + program code [binary encode base64 $programCode] +} + +Wish the web server handles route "/editor-control" with handler { + html { + + + + + Editor copy/paste + + + + Status +

+ Select a keyboard: +

+ + + + + } +} \ No newline at end of file From 89dfad07cfe26d4e4b28a97e875d4d5da7f919c5 Mon Sep 17 00:00:00 2001 From: Mason Jones <20848827+smj-edison@users.noreply.github.com> Date: Mon, 10 Feb 2025 20:53:45 -0800 Subject: [PATCH 03/35] Make saving work from webpage --- virtual-programs/editor-control.folk | 52 +++++++++++++++++++--------- 1 file changed, 35 insertions(+), 17 deletions(-) diff --git a/virtual-programs/editor-control.folk b/virtual-programs/editor-control.folk index 4f8f1504..cb27992c 100644 --- a/virtual-programs/editor-control.folk +++ b/virtual-programs/editor-control.folk @@ -25,6 +25,7 @@ const textarea = document.querySelector("#code"); var currentKeyboard = null; var programCode = ""; // not the same as editor code +var cursorPosition = [0, 0]; // temporarily disable event processing after sending new code to prevent recursive event sends var allowLocalEventsToProcess = true; @@ -49,9 +50,29 @@ function disableLocalEventProcessing(durationMs) { }, durationMs); } +function updateProgramCode() { + disableRemoteEventProcessing(500); + + const { page, kbPath } = currentKeyboard; + + const currentCode = textarea.value; + programCode = currentCode; + + const id = page + kbPath; + ws.evaluate(tcl` + Hold (non-capturing) (on virtual-programs/editor.folk) ${"cursor" + kbPath} { + Claim the ${kbPath} cursor is [list ${cursorPosition[0]} ${cursorPosition[1]}] + Hold (on virtual-programs/editor.folk) ${"code" + kbPath} { + Claim ${id} has program code [binary decode base64 ${btoa(currentCode)}] + Claim ${id} has editor code [binary decode base64 ${btoa(currentCode)}] + } + } + `); +} + function updateCursorAndCode(ev) { if (!allowLocalEventsToProcess) return; - disableRemoteEventProcessing(100); + disableRemoteEventProcessing(500); const { page, kbPath } = currentKeyboard; @@ -63,6 +84,8 @@ function updateCursorAndCode(ev) { const y = linesBefore.length - 1; const x = linesBefore[linesBefore.length - 1].length; + cursorPosition = [x, y]; + const id = page + kbPath; ws.evaluate(tcl` Hold (non-capturing) (on virtual-programs/editor.folk) ${"cursor" + kbPath} { @@ -77,8 +100,14 @@ function updateCursorAndCode(ev) { textarea.addEventListener("input", updateCursorAndCode); textarea.addEventListener("selectionchange", updateCursorAndCode); +textarea.addEventListener("keydown", ev => { + if(ev.keyCode === 83 /* s */ && (navigator.platform.match("Mac") ? ev.metaKey : ev.ctrlKey)) { + ev.preventDefault(); + updateProgramCode(); + } +}); -var lastKeyboard; +var lastKeyboard; // to clean up the previous keyboard when another is picked async function selectKeyboard({ page, kbPath }) { if (lastKeyboard) lastKeyboard.stop(); @@ -88,7 +117,7 @@ async function selectKeyboard({ page, kbPath }) { lastKeyboard = await ws.watch(`${id} has base64 editor code /editorCode/ program code /programCode/ & the ${kbPath} cursor is /cursor/`, { add: ({ editorCode, programCode: _programCode, cursor }) => { if (!allowRemoteEventsToProcess) return; - disableLocalEventProcessing(100); + disableLocalEventProcessing(500); programCode = atob(_programCode); @@ -99,6 +128,8 @@ async function selectKeyboard({ page, kbPath }) { let [x, y] = loadList(cursor); x = parseInt(x); y = parseInt(y); + cursorPosition = [x, y]; + const lines = editorCode.split("\n"); let pos = 0; @@ -132,21 +163,8 @@ ws.watchCollected("/page/ is an editor & /page/ is a keyboard with path /kbPath/ keyboardSelect.addEventListener("input", (ev) => { selectKeyboard(JSON.parse(ev.target.value)); }); - -var editorMatches; -var selectedKeyboard; - -function updateTextarea() { - if (!editorMatches) return; - const editor = editorMatches.find(x => x.editor === selectedKeyboard); - - if (editor) { - code.innerText = editor.code; - console.log(editor.code); - } -} } -} \ No newline at end of file +} From 5b0c0d57bb9b44279a8a2405c114fb1d3d4226e0 Mon Sep 17 00:00:00 2001 From: Mason Jones <20848827+smj-edison@users.noreply.github.com> Date: Mon, 10 Feb 2025 20:22:54 -0800 Subject: [PATCH 04/35] Add support for groups --- virtual-programs/group.folk | 39 +++++++++++++++++++++++++++++++++++++ 1 file changed, 39 insertions(+) create mode 100644 virtual-programs/group.folk diff --git a/virtual-programs/group.folk b/virtual-programs/group.folk new file mode 100644 index 00000000..b470fa1e --- /dev/null +++ b/virtual-programs/group.folk @@ -0,0 +1,39 @@ +# load all programs +When group /group/ contains /...programs/ { + Wish tag $group is stabilized + foreach program $programs { + # HACK: claim 'tag' specifically so it doesn't run twice + Claim tag $program has a program + } +} + +# figure out the text to display below +When group /group/ contains /...programs/ &\ + the collected matches for [list /someone/ wishes /program/ is titled /title/] are /matches/ { + set programTitles [dict create] + + foreach match $matches { + set programId [dict get $match program] + + if {[lsearch $programs $programId] != -1} { + dict set programTitles $programId [dict get $match title] + } + } + + set programTitleText "" + + foreach program $programs { + set title [dict_getdef $programTitles $program "(no title)"] + append programTitleText \n $program ": " $title + } + + Claim group $group has program titles $programTitleText +} + +# display said text +When group /group/ has program titles /programTitles/ &\ + /group/ has region /r/ { + set radians [region angle $r] + set pos [region topleft [region move $r down 40px right 15px]] + Wish to draw text with position $pos text $programTitles scale 0.7 radians $radians anchor topleft +} \ No newline at end of file From 89661cc1f64ea72929a46df26b3c2f0fd6b3279f Mon Sep 17 00:00:00 2001 From: Mason Jones <20848827+smj-edison@users.noreply.github.com> Date: Fri, 21 Feb 2025 11:41:13 -0800 Subject: [PATCH 05/35] Remove unneeded code --- lib/folk.js | 6 +----- 1 file changed, 1 insertion(+), 5 deletions(-) diff --git a/lib/folk.js b/lib/folk.js index 3575f77f..d55d8941 100644 --- a/lib/folk.js +++ b/lib/folk.js @@ -260,11 +260,7 @@ class FolkWS { // Evaluates inside a persistent match context that replaces any // previous hold with same key: async hold(key, program, on = '$chan') { - if (on !== null) { - await this.evaluate(tcl`Hold (non-capturing) (on ${on}) ${key} ${program}`); - } else { - await this.evaluate(tcl`Hold (non-capturing) ${key} ${program}`); - } + await this.evaluate(tcl`Hold (non-capturing) (on ${on}) ${key} ${program}`); } async watchCollected(statement, onChange) { From 1d7abf832d174118f2d4a1976ada27e76061a0bb Mon Sep 17 00:00:00 2001 From: Omar Rizwan Date: Mon, 24 Feb 2025 16:56:55 -0500 Subject: [PATCH 06/35] Add exposure slider to /calibrate and exposure wish to camera.folk Fixes #196 --- virtual-programs/calibrate/calibrate.folk | 33 +++++++++++++++++------ virtual-programs/camera-usb.folk | 28 +++++++++++++++++++ 2 files changed, 53 insertions(+), 8 deletions(-) diff --git a/virtual-programs/calibrate/calibrate.folk b/virtual-programs/calibrate/calibrate.folk index c78aa531..52f219e5 100644 --- a/virtual-programs/calibrate/calibrate.folk +++ b/virtual-programs/calibrate/calibrate.folk @@ -384,6 +384,9 @@ Wish the web server handles route "/calibrate$" with handler [list apply {{UNIT_ [list /someone/ claims the default program geometry is /defaultGeom/]] 0] defaultGeom] fn defaultGeomGet {key} { return [string map {mm ""} [dict get $defaultGeom $key]] } + set camera [dict get [lindex [Statements::findMatches \ + [list /someone/ claims camera /camera/ has width /cameraWidth/ height /cameraHeight/]] 0] camera] + upvar ^html ^html html [csubst { @@ -464,15 +467,15 @@ Wish the web server handles route "/calibrate$" with handler [list apply {{UNIT_ }); -

Once you start calibration, you'll see some AprilTags get automatically projected on your table. Move your board to the projected tags so that at least one projected tag sits inside the gap between printed AprilTags, wait a second for the projected tags to refit into the grid, +

Once you start calibration, you'll see some AprilTags get automatically projected on your table. Move your board to the projected tags so that at least one projected tag sits inside the gap between printed AprilTags, wait a second for the projected tags to refit into the grid, then hold the board still for a few seconds until the pose is recorded.

-

Example video of Andrés calibration the Folk0 system (playing at 2x speed).

+

Example video of Andrés calibrating the folk0 system (2x speed)

-

Are the projected tags too big to fit in the gaps between printed tags? Adjust this slider to reset & adjust the default projected tag size: +

Are the projected tags too big to fit in the gaps between printed tags? Adjust this slider to reset & adjust the default projected tag size:

+ +

Once you've recorded the first pose, slowly drag the board around your space, going slow enough for the projected AprilTags to catch up with the printed AprilTags and fit into the gaps on your board. When you've moved the board at least a full board-length away from the first pose, try to slant it 45 degrees or so off the table and hold it still again to capture another pose.

Repeat this process of dragging the board around and capturing a new pose. You'll need to record 10 different @@ -671,10 +692,6 @@ When camera /camera/ has width /cameraWidth/ height /cameraHeight/ &\ # TODO: restore old camera resolution later } - # HACK: hard-coded for now; assumes dark room. Won't work on USB - # webcams yet, either (just Pi). - Wish camera $camera uses exposure time 16000 us - set tagSideLength 1.0 set tagOuterLength [expr {$tagSideLength * 10/6}] set pad $tagSideLength diff --git a/virtual-programs/camera-usb.folk b/virtual-programs/camera-usb.folk index f14ad8b0..e1a83d94 100644 --- a/virtual-programs/camera-usb.folk +++ b/virtual-programs/camera-usb.folk @@ -261,6 +261,24 @@ set makeCamera { folkHeapFree(image.data); } + camc proc setExposure {camera_t* camera int value} void { + struct v4l2_control c; + + c.id = V4L2_CID_EXPOSURE_AUTO; + c.value = V4L2_EXPOSURE_MANUAL; + FOLK_ENSURE(xioctl(camera->fd, VIDIOC_S_CTRL, &c) == 0); + + c.id = V4L2_CID_EXPOSURE_ABSOLUTE; + c.value = value; + FOLK_ENSURE(xioctl(camera->fd, VIDIOC_S_CTRL, &c) == 0); + } + camc proc setExposureAuto {camera_t* camera} void { + struct v4l2_control c; + c.id = V4L2_CID_EXPOSURE_AUTO; + c.value = V4L2_EXPOSURE_APERTURE_PRIORITY; + FOLK_ENSURE(xioctl(camera->fd, VIDIOC_S_CTRL, &c) == 0); + } + if {$::tcl_platform(os) eq "Darwin"} { c loadlib "/opt/homebrew/lib/libjpeg.dylib" } else { @@ -324,6 +342,8 @@ When /someone/ wishes $::thisNode uses camera /cameraPath/ with /...options/ { Wish $::thisProcess shares statements like \ [list /someone/ claims camera $cameraPath /...anything/] + Wish $::thisProcess receives statements like \ + [list /someone/ wishes camera $cameraPath uses exposure time /exposureTimeUs/ us] namespace eval Camera $makeCamera set camera [Camera::new $cameraPath $width $height $bufferCount] @@ -333,6 +353,14 @@ When /someone/ wishes $::thisNode uses camera /cameraPath/ with /...options/ { puts "camera-usb: $cameraPath ($options) (tid [getTid]) booted at [clock milliseconds]" + When /someone/ wishes camera $cameraPath uses exposure time /exposureTimeUs/ us { + if {$exposureTimeUs eq "auto"} { + Camera::setExposureAuto $camera + } else { + Camera::setExposure $camera [expr {int($exposureTimeUs / 100)}] + } + } + set ::oldFrames [list] When $::thisProcess has step count /c/ { set frame [Camera::grayFrame $camera] From a30c545d3f19d870f30f6cb422332602e70d7b36 Mon Sep 17 00:00:00 2001 From: Omar Rizwan Date: Mon, 24 Feb 2025 18:06:03 -0500 Subject: [PATCH 07/35] calibrate: Max out exposure at 2x 60Hz; hold the wish properly --- virtual-programs/calibrate/calibrate.folk | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/virtual-programs/calibrate/calibrate.folk b/virtual-programs/calibrate/calibrate.folk index 52f219e5..e7abf785 100644 --- a/virtual-programs/calibrate/calibrate.folk +++ b/virtual-programs/calibrate/calibrate.folk @@ -490,12 +490,12 @@ Wish the web server handles route "/calibrate$" with handler [list apply {{UNIT_

Use this camera preview to debug why printed and/or projected tags aren't being recognized (maybe overexposure, maybe your camera isn't in a good position):


Is the projection too bright and washing out the camera? Adjust this slider to adjust camera exposure: - +

+ +

Use this camera preview to debug why printed and/or projected tags aren't being recognized (maybe overexposure, maybe your camera isn't in a good position): +


+ + -

Use this camera preview to debug why printed and/or projected tags aren't being recognized (maybe overexposure, maybe your camera isn't in a good position):


- -

Is the projection too bright and washing out the camera? Adjust this slider to adjust camera exposure: - - 10000 us -

- + +

Is the projection too bright and washing out the camera? +
+ Adjust camera exposure: + + μs +

+ +

Once you've recorded the first pose, slowly drag the board around your space, going slow enough for the projected AprilTags to catch up with the printed AprilTags and fit into the gaps on your board. When you've moved the board at least a full board-length away from the first pose, try to slant it 45 degrees or so off the table and hold it still again to capture another pose.

From 4e0d50fc74b6e954f3dfbd24768148fd915f390e Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andr=C3=A9s=20Cuervo?= Date: Mon, 3 Mar 2025 15:02:15 -0500 Subject: [PATCH 11/35] Fix shape rotation relative to parent region --- virtual-programs/shapes.folk | 30 ++++++++++++++---------------- 1 file changed, 14 insertions(+), 16 deletions(-) diff --git a/virtual-programs/shapes.folk b/virtual-programs/shapes.folk index 2245336a..a1d71f8e 100644 --- a/virtual-programs/shapes.folk +++ b/virtual-programs/shapes.folk @@ -48,37 +48,35 @@ When /someone/ wishes /p/ draws a /shape/ { } When /someone/ wishes /p/ draws an /shape/ { Wish $p draws a $shape } When /someone/ wishes /p/ draws a /shape/ with /...options/ & /p/ has region /r/ { - lassign [region centroid $r] x y + lassign [region centroid $r] cx cy + set angle [region angle $r] + set width [region width $r] set height [region height $r] - lassign [dict_getdef $options offset {0 0}] offsetX offsetY set radius [dict_getdef $options radius 50] set color [dict_getdef $options color white] set filled [dict_getdef $options filled false] set thickness [dict_getdef $options thickness 5] set layer [dict_getdef $options layer 0] - - if {$offsetX != 0} { - set x [expr {$x + $offsetX}] - } - if {$offsetY != 0} { - set y [expr {$y + $offsetY}] - } - - set angle [region angle $r] - set p [list $x $y] + + lassign [dict_getdef $options offset {0 0}] offsetX offsetY + set rawOffset [list $offsetX $offsetY] + + set rotatedOffset [vec2 rotate $rawOffset $angle] + + set finalCenter [vec2 add [list $cx $cy] $rotatedOffset] if {$shape eq "circle"} { Wish to draw a circle with \ - center $p radius $radius thickness $thickness \ + center $finalCenter radius $radius thickness $thickness \ color $color filled $filled layer $layer } elseif {[dict exists $shapes $shape]} { Wish to draw a shape with sides [dict get $shapes $shape] \ - center $p radius $radius radians $angle \ + center $finalCenter radius $radius radians $angle \ color $color filled $filled layer $layer } else { Wish to draw a shape with sides 2 \ - center $p radius $radius radians $angle \ + center $finalCenter radius $radius radians $angle \ color $color filled $filled layer $layer } } @@ -108,4 +106,4 @@ Claim $this has demo { } Wish $this is outlined white -} +} \ No newline at end of file From f894082d06b2cef7f6b33b5b02cbd912ccfbbf3c Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andr=C3=A9s=20Cuervo?= Date: Mon, 3 Mar 2025 15:24:04 -0500 Subject: [PATCH 12/35] Fix var clashing and clean-up shape functions Additional improvements: - Streamlined shape generation logic - Ensured consistent parameter handling - Added proper width parameter support for shape outlines --- virtual-programs/shapes.folk | 52 +++++++++++++++++++----------------- 1 file changed, 28 insertions(+), 24 deletions(-) diff --git a/virtual-programs/shapes.folk b/virtual-programs/shapes.folk index a1d71f8e..2b615941 100644 --- a/virtual-programs/shapes.folk +++ b/virtual-programs/shapes.folk @@ -1,6 +1,8 @@ -# sides 2 => line -# sides 3 => triangle -# sides 4 => square +# Dictionary mapping shape names to number of sides +set shapes [dict create triangle 3 square 4 pentagon 5 hexagon 6 \ + septagon 7 octagon 8 nonagon 9] + +# Core shape drawing function - creates regular polygons When /someone/ wishes to draw a shape with /...options/ { set numPoints [dict get $options sides] set c [dict get $options center] @@ -9,9 +11,10 @@ When /someone/ wishes to draw a shape with /...options/ { set color [dict_getdef $options color white] set filled [dict_getdef $options filled false] set layer [dict_getdef $options layer 0] + set width [dict_getdef $options width 1] set p [list 0 0] - set center $p + set centerPoint $p set points [list $p] set incr [expr {2 * 3.14159 / $numPoints}] @@ -19,14 +22,13 @@ When /someone/ wishes to draw a shape with /...options/ { for {set i 0} {$i < $numPoints} {incr i} { set p [vec2 add $p [vec2 scale [list [expr {cos($a)}] [expr {sin($a)}]] $r]] lappend points $p - # Accumulate center - set center [vec2 add $center $p] + set centerPoint [vec2 add $centerPoint $p] set a [expr {$a + $incr}] } - set center [vec2 scale $center [expr {1.0/$numPoints}]] + set centerPoint [vec2 scale $centerPoint [expr {1.0/$numPoints}]] set points [lmap v $points { - set v [vec2 sub $v $center] + set v [vec2 sub $v $centerPoint] set v [vec2 rotate $v $radians] set v [vec2 add $v $c] set v @@ -35,37 +37,38 @@ When /someone/ wishes to draw a shape with /...options/ { if {$filled} { Wish to draw a polygon with points $points color $color layer $layer } else { - Wish to draw a stroke with points $points width 1 color $color layer $layer + Wish to draw a stroke with points $points width $width color $color layer $layer } } -set shapes [dict create triangle 3 square 4 pentagon 5 hexagon 6 \ - septagon 7 octagon 8 nonagon 9] When /someone/ wishes /p/ draws a /shape/ { - # TODO: This is a hack because rest pattern doesn't match empty - # sequence at end. Wish $p draws a $shape with color white } -When /someone/ wishes /p/ draws an /shape/ { Wish $p draws a $shape } + +When /someone/ wishes /p/ draws an /shape/ { + Wish $p draws a $shape +} + When /someone/ wishes /p/ draws a /shape/ with /...options/ & /p/ has region /r/ { + # Get the region's properties lassign [region centroid $r] cx cy set angle [region angle $r] - set width [region width $r] - set height [region height $r] + # Extract parameters set radius [dict_getdef $options radius 50] set color [dict_getdef $options color white] set filled [dict_getdef $options filled false] set thickness [dict_getdef $options thickness 5] set layer [dict_getdef $options layer 0] + # Rotate offset vector by region's angle for consistent positioning lassign [dict_getdef $options offset {0 0}] offsetX offsetY - set rawOffset [list $offsetX $offsetY] - - set rotatedOffset [vec2 rotate $rawOffset $angle] + set rotatedOffset [vec2 rotate [list $offsetX $offsetY] $angle] + # Calculate final center position set finalCenter [vec2 add [list $cx $cy] $rotatedOffset] + # Draw appropriate shape if {$shape eq "circle"} { Wish to draw a circle with \ center $finalCenter radius $radius thickness $thickness \ @@ -73,13 +76,14 @@ When /someone/ wishes /p/ draws a /shape/ with /...options/ & /p/ has region /r/ } elseif {[dict exists $shapes $shape]} { Wish to draw a shape with sides [dict get $shapes $shape] \ center $finalCenter radius $radius radians $angle \ - color $color filled $filled layer $layer + color $color filled $filled width $thickness layer $layer } else { Wish to draw a shape with sides 2 \ center $finalCenter radius $radius radians $angle \ - color $color filled $filled layer $layer + color $color filled $filled width $thickness layer $layer } } + When /someone/ wishes /p/ draws an /shape/ with /...options/ { Wish $p draws a $shape with {*}$options } @@ -87,9 +91,9 @@ When /someone/ wishes /p/ draws an /shape/ with /...options/ { Claim $this has demo { Wish $this draws a circle Wish $this draws a triangle with color skyblue - Wish $this draws a triangle with color green offset {280 0} - Wish $this draws a pentagon with color gold offset {200 0} - Wish $this draws an octagon with color red offset {250 80} + Wish $this draws a triangle with color green offset {-280 0} + Wish $this draws a pentagon with color gold offset {-200 0} + Wish $this draws an octagon with color magenta offset {-250 80} When the clock time is /t/ { set offsetVector [list [sin $t] [cos $t]] From 2b9c697db7693adff88a8aa93cdc7c716182ef8a Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andr=C3=A9s=20Cuervo?= Date: Mon, 3 Mar 2025 16:04:06 -0500 Subject: [PATCH 13/35] Add rect shifting --- virtual-programs/shapes.folk | 108 ++++++++++++++++++++++++++++++++++- 1 file changed, 107 insertions(+), 1 deletion(-) diff --git a/virtual-programs/shapes.folk b/virtual-programs/shapes.folk index 2b615941..1922b689 100644 --- a/virtual-programs/shapes.folk +++ b/virtual-programs/shapes.folk @@ -41,6 +41,41 @@ When /someone/ wishes to draw a shape with /...options/ { } } +# Rectangle drawing function with rotation around regional center +When /someone/ wishes to draw a rect with /...options/ { + set c [dict get $options center] + set width [dict_getdef $options width 100] + set height [dict_getdef $options height 100] + set radians [dict_getdef $options radians 0] + set color [dict_getdef $options color white] + set filled [dict_getdef $options filled false] + set strokeWidth [dict_getdef $options strokeWidth 1] + set layer [dict_getdef $options layer 0] + + set halfWidth [expr {$width / 2.0}] + set halfHeight [expr {$height / 2.0}] + + set points [list \ + [list [expr {-$halfWidth}] [expr {-$halfHeight}]] \ + [list [expr {$halfWidth}] [expr {-$halfHeight}]] \ + [list [expr {$halfWidth}] [expr {$halfHeight}]] \ + [list [expr {-$halfWidth}] [expr {$halfHeight}]] \ + [list [expr {-$halfWidth}] [expr {-$halfHeight}]] \ + ] + + set points [lmap v $points { + set v [vec2 rotate $v $radians] + set v [vec2 add $v $c] + set v + }] + + if {$filled} { + Wish to draw a polygon with points $points color $color layer $layer + } else { + Wish to draw a stroke with points $points width $strokeWidth color $color layer $layer + } +} + When /someone/ wishes /p/ draws a /shape/ { Wish $p draws a $shape with color white } @@ -53,6 +88,8 @@ When /someone/ wishes /p/ draws a /shape/ with /...options/ & /p/ has region /r/ # Get the region's properties lassign [region centroid $r] cx cy set angle [region angle $r] + set width [region width $r] + set height [region height $r] # Extract parameters set radius [dict_getdef $options radius 50] @@ -73,28 +110,97 @@ When /someone/ wishes /p/ draws a /shape/ with /...options/ & /p/ has region /r/ Wish to draw a circle with \ center $finalCenter radius $radius thickness $thickness \ color $color filled $filled layer $layer + } elseif {$shape eq "rect"} { + set rectWidth [dict_getdef $options width $width] + set rectHeight [dict_getdef $options height $height] + Wish to draw a rect with \ + center $finalCenter width $rectWidth height $rectHeight radians $angle \ + color $color filled $filled strokeWidth $thickness layer $layer } elseif {[dict exists $shapes $shape]} { Wish to draw a shape with sides [dict get $shapes $shape] \ center $finalCenter radius $radius radians $angle \ color $color filled $filled width $thickness layer $layer } else { + # Default to a line (2 sides) if shape not recognized Wish to draw a shape with sides 2 \ center $finalCenter radius $radius radians $angle \ color $color filled $filled width $thickness layer $layer } } +# Handle "an" grammar variant with options When /someone/ wishes /p/ draws an /shape/ with /...options/ { Wish $p draws a $shape with {*}$options } +# Specialized rectangle drawing with consistent positioning and rotation +When /someone/ wishes /p/ draw a rect with width /w/ height /h/ shifted /direction/ /pct/ { + When $p has region /r/ { + # Get the region's properties + lassign [region centroid $r] cx cy + set angle [region angle $r] + + # Strip percentage sign if present and convert to decimal + set pctValue [string map {% ""} $pct] + set pctFraction [expr {$pctValue / 100.0}] + + # Determine the direction vector based on region width/height + set width [region width $r] + set offset 0 + + if {$direction eq "right"} { + set offset [expr {$width * $pctFraction}] + set offsetVec [list $offset 0] + } elseif {$direction eq "left"} { + set offset [expr {-$width * $pctFraction}] + set offsetVec [list $offset 0] + } elseif {$direction eq "up"} { + set height [region height $r] + set offset [expr {-$height * $pctFraction}] + set offsetVec [list 0 $offset] + } elseif {$direction eq "down"} { + set height [region height $r] + set offset [expr {$height * $pctFraction}] + set offsetVec [list 0 $offset] + } else { + # Default to right if invalid direction + set offset [expr {$width * $pctFraction}] + set offsetVec [list $offset 0] + } + + # Rotate the offset vector based on region's angle + set rotatedOffset [vec2 rotate $offsetVec $angle] + + # Calculate final center position + set finalCenter [vec2 add [list $cx $cy] $rotatedOffset] + + # Draw the rectangle with same rotation as region + Wish to draw a rect with center $finalCenter width $w height $h radians $angle color white + } +} + +# Simplified syntax for drawing rectangles relative to a region +When /someone/ wishes /p/ draws a rect with width /w/ height /h/ { + When $p has region /r/ { + lassign [region centroid $r] cx cy + set angle [region angle $r] + Wish to draw a rect with center [list $cx $cy] width $w height $h radians $angle color white + } +} + Claim $this has demo { Wish $this draws a circle Wish $this draws a triangle with color skyblue Wish $this draws a triangle with color green offset {-280 0} Wish $this draws a pentagon with color gold offset {-200 0} Wish $this draws an octagon with color magenta offset {-250 80} - + + # Rectangle examples + Wish $this draws a rect with width 150 height 75 color cyan filled true offset {-250 -250} + Wish $this draw a rect with width 85 height 110 shifted right 150% + Wish $this draw a rect with width 85 height 110 shifted left 100% + + # Animated circle When the clock time is /t/ { set offsetVector [list [sin $t] [cos $t]] set offsetVector [::vec2::scale $offsetVector 105] From cb8245d47b4779a5bb85ecf1f2391c395290a4c5 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andr=C3=A9s=20Cuervo?= Date: Mon, 3 Mar 2025 16:36:35 -0500 Subject: [PATCH 14/35] Use region utils, refactor shape drawing options - Enhance rectangle drawing to use region utilities for consistency - Improve shifted-shape handling with common pattern and region movement - Unify rendering path with dict-based option passing - Expand demo examples to cover directional positioning --- virtual-programs/shapes.folk | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/virtual-programs/shapes.folk b/virtual-programs/shapes.folk index 1922b689..10417169 100644 --- a/virtual-programs/shapes.folk +++ b/virtual-programs/shapes.folk @@ -193,7 +193,7 @@ Claim $this has demo { Wish $this draws a triangle with color skyblue Wish $this draws a triangle with color green offset {-280 0} Wish $this draws a pentagon with color gold offset {-200 0} - Wish $this draws an octagon with color magenta offset {-250 80} + Wish $this draws an octagon with color red offset {-250 80} # Rectangle examples Wish $this draws a rect with width 150 height 75 color cyan filled true offset {-250 -250} From 3a6aea9a5b5298fea9fa0282f0f2d78e270bbb40 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andr=C3=A9s=20Cuervo?= Date: Mon, 3 Mar 2025 18:52:43 -0500 Subject: [PATCH 15/35] Shape syntax simplified, made shifting easier --- virtual-programs/shapes.folk | 222 ++++++++++++++++------------------- 1 file changed, 103 insertions(+), 119 deletions(-) diff --git a/virtual-programs/shapes.folk b/virtual-programs/shapes.folk index 10417169..b94cf14b 100644 --- a/virtual-programs/shapes.folk +++ b/virtual-programs/shapes.folk @@ -1,8 +1,5 @@ -# Dictionary mapping shape names to number of sides -set shapes [dict create triangle 3 square 4 pentagon 5 hexagon 6 \ - septagon 7 octagon 8 nonagon 9] +set shapes [dict create triangle 3 square 4 pentagon 5 hexagon 6 septagon 7 octagon 8 nonagon 9] -# Core shape drawing function - creates regular polygons When /someone/ wishes to draw a shape with /...options/ { set numPoints [dict get $options sides] set c [dict get $options center] @@ -13,25 +10,20 @@ When /someone/ wishes to draw a shape with /...options/ { set layer [dict_getdef $options layer 0] set width [dict_getdef $options width 1] - set p [list 0 0] - set centerPoint $p - set points [list $p] - - set incr [expr {2 * 3.14159 / $numPoints}] - set a [expr {$incr + 3.14159}] + set points {{0 0}} + set centerPoint {0 0} + set angle [expr {2 * 3.14159 / $numPoints + 3.14159}] + set angleIncr [expr {2 * 3.14159 / $numPoints}] + for {set i 0} {$i < $numPoints} {incr i} { - set p [vec2 add $p [vec2 scale [list [expr {cos($a)}] [expr {sin($a)}]] $r]] + set p [vec2 add [lindex $points end] [vec2 scale [list [expr {cos($angle)}] [expr {sin($angle)}]] $r]] lappend points $p set centerPoint [vec2 add $centerPoint $p] - set a [expr {$a + $incr}] + set angle [expr {$angle + $angleIncr}] } - set centerPoint [vec2 scale $centerPoint [expr {1.0/$numPoints}]] - + set points [lmap v $points { - set v [vec2 sub $v $centerPoint] - set v [vec2 rotate $v $radians] - set v [vec2 add $v $c] - set v + vec2 add [vec2 rotate [vec2 sub $v [vec2 scale $centerPoint [expr {1.0/$numPoints}]]] $radians] $c }] if {$filled} { @@ -41,38 +33,33 @@ When /someone/ wishes to draw a shape with /...options/ { } } -# Rectangle drawing function with rotation around regional center When /someone/ wishes to draw a rect with /...options/ { set c [dict get $options center] - set width [dict_getdef $options width 100] - set height [dict_getdef $options height 100] + set w [dict_getdef $options width 100] + set h [dict_getdef $options height 100] set radians [dict_getdef $options radians 0] set color [dict_getdef $options color white] set filled [dict_getdef $options filled false] - set strokeWidth [dict_getdef $options strokeWidth 1] + set width [dict_getdef $options strokeWidth 1] set layer [dict_getdef $options layer 0] - set halfWidth [expr {$width / 2.0}] - set halfHeight [expr {$height / 2.0}] + set hw [expr {$w / 2.0}] + set hh [expr {$h / 2.0}] - set points [list \ - [list [expr {-$halfWidth}] [expr {-$halfHeight}]] \ - [list [expr {$halfWidth}] [expr {-$halfHeight}]] \ - [list [expr {$halfWidth}] [expr {$halfHeight}]] \ - [list [expr {-$halfWidth}] [expr {$halfHeight}]] \ - [list [expr {-$halfWidth}] [expr {-$halfHeight}]] \ - ] - - set points [lmap v $points { - set v [vec2 rotate $v $radians] - set v [vec2 add $v $c] - set v + set points [lmap v [list \ + [list [expr {-$hw}] [expr {-$hh}]] \ + [list [expr {$hw}] [expr {-$hh}]] \ + [list [expr {$hw}] [expr {$hh}]] \ + [list [expr {-$hw}] [expr {$hh}]] \ + [list [expr {-$hw}] [expr {-$hh}]] \ + ] { + vec2 add [vec2 rotate $v $radians] $c }] if {$filled} { Wish to draw a polygon with points $points color $color layer $layer } else { - Wish to draw a stroke with points $points width $strokeWidth color $color layer $layer + Wish to draw a stroke with points $points width $width color $color layer $layer } } @@ -85,134 +72,131 @@ When /someone/ wishes /p/ draws an /shape/ { } When /someone/ wishes /p/ draws a /shape/ with /...options/ & /p/ has region /r/ { - # Get the region's properties lassign [region centroid $r] cx cy set angle [region angle $r] - set width [region width $r] - set height [region height $r] - # Extract parameters set radius [dict_getdef $options radius 50] set color [dict_getdef $options color white] set filled [dict_getdef $options filled false] set thickness [dict_getdef $options thickness 5] set layer [dict_getdef $options layer 0] - # Rotate offset vector by region's angle for consistent positioning - lassign [dict_getdef $options offset {0 0}] offsetX offsetY - set rotatedOffset [vec2 rotate [list $offsetX $offsetY] $angle] - - # Calculate final center position - set finalCenter [vec2 add [list $cx $cy] $rotatedOffset] + lassign [dict_getdef $options offset {0 0}] ox oy + set center [vec2 add [list $cx $cy] [vec2 rotate [list $ox $oy] $angle]] - # Draw appropriate shape if {$shape eq "circle"} { - Wish to draw a circle with \ - center $finalCenter radius $radius thickness $thickness \ + Wish to draw a circle with center $center radius $radius thickness $thickness \ color $color filled $filled layer $layer } elseif {$shape eq "rect"} { - set rectWidth [dict_getdef $options width $width] - set rectHeight [dict_getdef $options height $height] - Wish to draw a rect with \ - center $finalCenter width $rectWidth height $rectHeight radians $angle \ - color $color filled $filled strokeWidth $thickness layer $layer + set w [dict_getdef $options width [region width $r]] + set h [dict_getdef $options height [region height $r]] + Wish to draw a rect with center $center width $w height $h radians $angle \ + color $color filled $filled thickness $thickness layer $layer } elseif {[dict exists $shapes $shape]} { - Wish to draw a shape with sides [dict get $shapes $shape] \ - center $finalCenter radius $radius radians $angle \ - color $color filled $filled width $thickness layer $layer + Wish to draw a shape with sides [dict get $shapes $shape] center $center radius $radius \ + radians $angle color $color filled $filled width $thickness layer $layer } else { - # Default to a line (2 sides) if shape not recognized - Wish to draw a shape with sides 2 \ - center $finalCenter radius $radius radians $angle \ - color $color filled $filled width $thickness layer $layer + Wish to draw a shape with sides 2 center $center radius $radius \ + radians $angle color $color filled $filled width $thickness layer $layer } } -# Handle "an" grammar variant with options When /someone/ wishes /p/ draws an /shape/ with /...options/ { Wish $p draws a $shape with {*}$options } -# Specialized rectangle drawing with consistent positioning and rotation -When /someone/ wishes /p/ draw a rect with width /w/ height /h/ shifted /direction/ /pct/ { - When $p has region /r/ { - # Get the region's properties - lassign [region centroid $r] cx cy - set angle [region angle $r] - - # Strip percentage sign if present and convert to decimal - set pctValue [string map {% ""} $pct] - set pctFraction [expr {$pctValue / 100.0}] +proc shift_region {region direction pct} { + set pct [expr {[string map {% ""} $pct] / 100.0}] + set w [region width $region] + set h [region height $region] - # Determine the direction vector based on region width/height - set width [region width $r] - set offset 0 + switch $direction { + "right" { region move $region right [expr {$w * $pct}]px } + "left" { region move $region left [expr {$w * $pct}]px } + "up" { region move $region up [expr {$h * $pct}]px } + "down" { region move $region down [expr {$h * $pct}]px } + default { region move $region right [expr {$w * $pct}]px } + } +} + +When /someone/ wishes /p/ draw a rect with width /w/ height /h/ shift /direction/ /pct/ { + When $p has region /r/ { + set shifted [shift_region $r $direction $pct] + lassign [region centroid $shifted] cx cy + Wish to draw a rect with center [list $cx $cy] width $w height $h radians [region angle $r] color white + } +} + +When /someone/ wishes /p/ draw a /shape/ with radius /rad/ shift /direction/ /pct/ { + When $p has region /r/ { + set shifted [shift_region $r $direction $pct] + lassign [region centroid $shifted] cx cy - if {$direction eq "right"} { - set offset [expr {$width * $pctFraction}] - set offsetVec [list $offset 0] - } elseif {$direction eq "left"} { - set offset [expr {-$width * $pctFraction}] - set offsetVec [list $offset 0] - } elseif {$direction eq "up"} { - set height [region height $r] - set offset [expr {-$height * $pctFraction}] - set offsetVec [list 0 $offset] - } elseif {$direction eq "down"} { - set height [region height $r] - set offset [expr {$height * $pctFraction}] - set offsetVec [list 0 $offset] + if {[dict exists $shapes $shape]} { + Wish to draw a shape with sides [dict get $shapes $shape] center [list $cx $cy] radius $rad color white } else { - # Default to right if invalid direction - set offset [expr {$width * $pctFraction}] - set offsetVec [list $offset 0] + Wish $p draws a $shape with center [list $cx $cy] radius $rad color white } - - # Rotate the offset vector based on region's angle - set rotatedOffset [vec2 rotate $offsetVec $angle] - - # Calculate final center position - set finalCenter [vec2 add [list $cx $cy] $rotatedOffset] - - # Draw the rectangle with same rotation as region - Wish to draw a rect with center $finalCenter width $w height $h radians $angle color white } } -# Simplified syntax for drawing rectangles relative to a region -When /someone/ wishes /p/ draws a rect with width /w/ height /h/ { - When $p has region /r/ { - lassign [region centroid $r] cx cy - set angle [region angle $r] - Wish to draw a rect with center [list $cx $cy] width $w height $h radians $angle color white +When /someone/ wishes /p/ draw a rect with width /w/ height /h/ { + Wish to draw a rect with center {0 0} width $w height $h radians 0 color white +} + +When /someone/ wishes /p/ draw a /shape/ with radius /rad/ { + if {[dict exists $shapes $shape]} { + Wish to draw a shape with sides [dict get $shapes $shape] center {0 0} radius $rad color white + } else { + Wish to draw a $shape with center {0 0} radius $rad color white } } Claim $this has demo { + # Center circle Wish $this draws a circle - Wish $this draws a triangle with color skyblue - Wish $this draws a triangle with color green offset {-280 0} - Wish $this draws a pentagon with color gold offset {-200 0} - Wish $this draws an octagon with color red offset {-250 80} - # Rectangle examples - Wish $this draws a rect with width 150 height 75 color cyan filled true offset {-250 -250} - Wish $this draw a rect with width 85 height 110 shifted right 150% - Wish $this draw a rect with width 85 height 110 shifted left 100% + # Grid of shapes with varying thickness + set baseX -850 + set baseY -200 + set gridSpacing 130 + + # Row 1: Regular polygons with different colors and thickness + Wish $this draws a triangle with color skyblue width 2 offset [list $baseX [expr {$baseY}]] + Wish $this draws a square with color green width 4 offset [list [expr {$baseX + $gridSpacing}] [expr {$baseY}]] + Wish $this draws a pentagon with color gold width 6 offset [list [expr {$baseX + $gridSpacing*2}] [expr {$baseY}]] + Wish $this draws a hexagon with color orange width 8 offset [list [expr {$baseX + $gridSpacing*3}] [expr {$baseY}]] + + # Row 2: Filled shapes + Wish $this draws a triangle with color skyblue filled true offset [list $baseX [expr {$baseY + $gridSpacing}]] + Wish $this draws a square with color green filled true offset [list [expr {$baseX + $gridSpacing}] [expr {$baseY + $gridSpacing}]] + Wish $this draws a pentagon with color gold filled true offset [list [expr {$baseX + $gridSpacing*2}] [expr {$baseY + $gridSpacing}]] + Wish $this draws a hexagon with color orange filled true offset [list [expr {$baseX + $gridSpacing*3}] [expr {$baseY + $gridSpacing}]] + + # Row 3: Shifting examples + Wish $this draw a triangle with radius 40 shift right 50% + Wish $this draw a square with radius 40 shift left 50% + Wish $this draw a pentagon with radius 40 shift up 50% + Wish $this draw a hexagon with radius 40 shift down 50% + + # Row 4: Rectangles with different properties + Wish $this draws a rect with width 80 height 50 color cyan thickness 3 offset [list $baseX [expr {$baseY + $gridSpacing*3}]] + Wish $this draws a rect with width 80 height 50 color magenta filled true offset [list [expr {$baseX + $gridSpacing}] [expr {$baseY + $gridSpacing*3}]] + Wish $this draw a rect with width 80 height 50 shift right 50% + Wish $this draw a rect with width 80 height 50 shift left 50% - # Animated circle + # Animated elements When the clock time is /t/ { set offsetVector [list [sin $t] [cos $t]] set offsetVector [::vec2::scale $offsetVector 105] Wish $this draws a circle with color palegoldenrod offset $offsetVector } - # This toggles a square between filled and unfilled When $this has region /r/ & the clock time is /t/ { lassign [region centroid $r] x y set fill [expr {round(sin($t) * 2) % 2 == 0}] set y [- $y 150] - Wish to draw a shape with sides 4 center [list [- $x 100] $y] radius 60 color white filled $fill + Wish to draw a square with center [list [- $x 100] $y] radius 60 color white filled $fill } Wish $this is outlined white From 8732ec0620acb5906b9bc2ebc49a33233e652a51 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andr=C3=A9s=20Cuervo?= Date: Fri, 7 Mar 2025 00:12:34 -0500 Subject: [PATCH 16/35] Fix single object "draw shape" typo in shapes.folk --- virtual-programs/shapes.folk | 20 ++++++++++---------- 1 file changed, 10 insertions(+), 10 deletions(-) diff --git a/virtual-programs/shapes.folk b/virtual-programs/shapes.folk index b94cf14b..c257f541 100644 --- a/virtual-programs/shapes.folk +++ b/virtual-programs/shapes.folk @@ -119,7 +119,7 @@ proc shift_region {region direction pct} { } } -When /someone/ wishes /p/ draw a rect with width /w/ height /h/ shift /direction/ /pct/ { +When /someone/ wishes /p/ draws a rect with width /w/ height /h/ shift /direction/ /pct/ { When $p has region /r/ { set shifted [shift_region $r $direction $pct] lassign [region centroid $shifted] cx cy @@ -127,7 +127,7 @@ When /someone/ wishes /p/ draw a rect with width /w/ height /h/ shift /direction } } -When /someone/ wishes /p/ draw a /shape/ with radius /rad/ shift /direction/ /pct/ { +When /someone/ wishes /p/ draws a /shape/ with radius /rad/ shift /direction/ /pct/ { When $p has region /r/ { set shifted [shift_region $r $direction $pct] lassign [region centroid $shifted] cx cy @@ -140,11 +140,11 @@ When /someone/ wishes /p/ draw a /shape/ with radius /rad/ shift /direction/ /pc } } -When /someone/ wishes /p/ draw a rect with width /w/ height /h/ { +When /someone/ wishes /p/ draws a rect with width /w/ height /h/ { Wish to draw a rect with center {0 0} width $w height $h radians 0 color white } -When /someone/ wishes /p/ draw a /shape/ with radius /rad/ { +When /someone/ wishes /p/ draws a /shape/ with radius /rad/ { if {[dict exists $shapes $shape]} { Wish to draw a shape with sides [dict get $shapes $shape] center {0 0} radius $rad color white } else { @@ -174,16 +174,16 @@ Claim $this has demo { Wish $this draws a hexagon with color orange filled true offset [list [expr {$baseX + $gridSpacing*3}] [expr {$baseY + $gridSpacing}]] # Row 3: Shifting examples - Wish $this draw a triangle with radius 40 shift right 50% - Wish $this draw a square with radius 40 shift left 50% - Wish $this draw a pentagon with radius 40 shift up 50% - Wish $this draw a hexagon with radius 40 shift down 50% + Wish $this draws a triangle with radius 40 shift right 50% + Wish $this draws a square with radius 40 shift left 50% + Wish $this draws a pentagon with radius 40 shift up 50% + Wish $this draws a hexagon with radius 40 shift down 50% # Row 4: Rectangles with different properties Wish $this draws a rect with width 80 height 50 color cyan thickness 3 offset [list $baseX [expr {$baseY + $gridSpacing*3}]] Wish $this draws a rect with width 80 height 50 color magenta filled true offset [list [expr {$baseX + $gridSpacing}] [expr {$baseY + $gridSpacing*3}]] - Wish $this draw a rect with width 80 height 50 shift right 50% - Wish $this draw a rect with width 80 height 50 shift left 50% + Wish $this draws a rect with width 80 height 50 shift right 50% + Wish $this draws a rect with width 80 height 50 shift left 50% # Animated elements When the clock time is /t/ { From 2b8ae033521d537061cbcab0c5eacd53de99af93 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andr=C3=A9s=20Cuervo?= Date: Mon, 10 Mar 2025 19:56:51 -0400 Subject: [PATCH 17/35] Add point and polyline drawing to shapes --- virtual-programs/shapes.folk | 48 ++++++++++++++++++++++++++++++++++++ 1 file changed, 48 insertions(+) diff --git a/virtual-programs/shapes.folk b/virtual-programs/shapes.folk index c257f541..94100f90 100644 --- a/virtual-programs/shapes.folk +++ b/virtual-programs/shapes.folk @@ -152,6 +152,54 @@ When /someone/ wishes /p/ draws a /shape/ with radius /rad/ { } } +proc get_transform_info {region} { + set angle [region angle $region] + set center [region centroid $region] + return [list $center $angle] +} + +proc transform_points {points center angle} { + set transformedPoints {} + foreach point $points { + lappend transformedPoints [vec2 add $center [vec2 rotate $point $angle]] + } + return $transformedPoints +} + +When /someone/ wishes /page/ draws a set of points /points/ with /...options/ & /page/ has region /r/ { + set radius [dict_getdef $options radius 5] + set color [dict_getdef $options color white] + set filled [dict_getdef $options filled true] + set thickness [dict_getdef $options thickness 2] + set layer [dict_getdef $options layer 0] + + lassign [get_transform_info $r] center angle + + foreach point [transform_points $points $center $angle] { + Wish to draw a circle with center $point radius $radius thickness $thickness \ + color $color filled $filled layer $layer + } +} + +When /someone/ wishes /page/ draws a polyline /points/ with /...options/ & /page/ has region /r/ { + set color [dict_getdef $options color white] + set thickness [dict_getdef $options thickness 2] + set layer [dict_getdef $options layer 0] + set dashed [dict_getdef $options dashed false] + set dashlength [dict_getdef $options dashlength 20] + set dashoffset [dict_getdef $options dashoffset 0] + + lassign [get_transform_info $r] center angle + set transformedPoints [transform_points $points $center $angle] + + if {$dashed} { + Wish to draw a dashed stroke with points $transformedPoints color $color width $thickness \ + dashlength $dashlength dashoffset $dashoffset layer $layer + } else { + Wish to draw a stroke with points $transformedPoints color $color width $thickness layer $layer + } +} + Claim $this has demo { # Center circle Wish $this draws a circle From 99cd4d049d946f884d32c14430cff2dcbe7a8185 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andr=C3=A9s=20Cuervo?= Date: Mon, 10 Mar 2025 21:50:33 -0400 Subject: [PATCH 18/35] Add points & polyline; format shapes.folk --- virtual-programs/shapes.folk | 178 +++++++++++++++++------------------ 1 file changed, 89 insertions(+), 89 deletions(-) diff --git a/virtual-programs/shapes.folk b/virtual-programs/shapes.folk index 94100f90..1b83794c 100644 --- a/virtual-programs/shapes.folk +++ b/virtual-programs/shapes.folk @@ -14,24 +14,24 @@ When /someone/ wishes to draw a shape with /...options/ { set centerPoint {0 0} set angle [expr {2 * 3.14159 / $numPoints + 3.14159}] set angleIncr [expr {2 * 3.14159 / $numPoints}] - + for {set i 0} {$i < $numPoints} {incr i} { set p [vec2 add [lindex $points end] [vec2 scale [list [expr {cos($angle)}] [expr {sin($angle)}]] $r]] lappend points $p set centerPoint [vec2 add $centerPoint $p] set angle [expr {$angle + $angleIncr}] } - + set points [lmap v $points { - vec2 add [vec2 rotate [vec2 sub $v [vec2 scale $centerPoint [expr {1.0/$numPoints}]]] $radians] $c - }] + vec2 add [vec2 rotate [vec2 sub $v [vec2 scale $centerPoint [expr {1.0/$numPoints}]]] $radians] $c + }] - if {$filled} { - Wish to draw a polygon with points $points color $color layer $layer - } else { - Wish to draw a stroke with points $points width $width color $color layer $layer + if {$filled} { + Wish to draw a polygon with points $points color $color layer $layer + } else { + Wish to draw a stroke with points $points width $width color $color layer $layer + } } -} When /someone/ wishes to draw a rect with /...options/ { set c [dict get $options center] @@ -42,24 +42,24 @@ When /someone/ wishes to draw a rect with /...options/ { set filled [dict_getdef $options filled false] set width [dict_getdef $options strokeWidth 1] set layer [dict_getdef $options layer 0] - + set hw [expr {$w / 2.0}] set hh [expr {$h / 2.0}] - + set points [lmap v [list \ - [list [expr {-$hw}] [expr {-$hh}]] \ - [list [expr {$hw}] [expr {-$hh}]] \ - [list [expr {$hw}] [expr {$hh}]] \ - [list [expr {-$hw}] [expr {$hh}]] \ - [list [expr {-$hw}] [expr {-$hh}]] \ - ] { + [list [expr {-$hw}] [expr {-$hh}]] \ + [list [expr {$hw}] [expr {-$hh}]] \ + [list [expr {$hw}] [expr {$hh}]] \ + [list [expr {-$hw}] [expr {$hh}]] \ + [list [expr {-$hw}] [expr {-$hh}]] \ + ] { vec2 add [vec2 rotate $v $radians] $c - }] - + }] + if {$filled} { - Wish to draw a polygon with points $points color $color layer $layer + Wish to draw a polygon with points $points color $color layer $layer } else { - Wish to draw a stroke with points $points width $width color $color layer $layer + Wish to draw a stroke with points $points width $width color $color layer $layer } } @@ -74,30 +74,30 @@ When /someone/ wishes /p/ draws an /shape/ { When /someone/ wishes /p/ draws a /shape/ with /...options/ & /p/ has region /r/ { lassign [region centroid $r] cx cy set angle [region angle $r] - + set radius [dict_getdef $options radius 50] set color [dict_getdef $options color white] set filled [dict_getdef $options filled false] set thickness [dict_getdef $options thickness 5] set layer [dict_getdef $options layer 0] - + lassign [dict_getdef $options offset {0 0}] ox oy set center [vec2 add [list $cx $cy] [vec2 rotate [list $ox $oy] $angle]] if {$shape eq "circle"} { - Wish to draw a circle with center $center radius $radius thickness $thickness \ - color $color filled $filled layer $layer + Wish to draw a circle with center $center radius $radius thickness $thickness \ + color $color filled $filled layer $layer } elseif {$shape eq "rect"} { - set w [dict_getdef $options width [region width $r]] - set h [dict_getdef $options height [region height $r]] - Wish to draw a rect with center $center width $w height $h radians $angle \ - color $color filled $filled thickness $thickness layer $layer + set w [dict_getdef $options width [region width $r]] + set h [dict_getdef $options height [region height $r]] + Wish to draw a rect with center $center width $w height $h radians $angle \ + color $color filled $filled thickness $thickness layer $layer } elseif {[dict exists $shapes $shape]} { - Wish to draw a shape with sides [dict get $shapes $shape] center $center radius $radius \ - radians $angle color $color filled $filled width $thickness layer $layer + Wish to draw a shape with sides [dict get $shapes $shape] center $center radius $radius \ + radians $angle color $color filled $filled width $thickness layer $layer } else { - Wish to draw a shape with sides 2 center $center radius $radius \ - radians $angle color $color filled $filled width $thickness layer $layer + Wish to draw a shape with sides 2 center $center radius $radius \ + radians $angle color $color filled $filled width $thickness layer $layer } } @@ -106,17 +106,17 @@ When /someone/ wishes /p/ draws an /shape/ with /...options/ { } proc shift_region {region direction pct} { - set pct [expr {[string map {% ""} $pct] / 100.0}] - set w [region width $region] - set h [region height $region] - - switch $direction { - "right" { region move $region right [expr {$w * $pct}]px } - "left" { region move $region left [expr {$w * $pct}]px } - "up" { region move $region up [expr {$h * $pct}]px } - "down" { region move $region down [expr {$h * $pct}]px } - default { region move $region right [expr {$w * $pct}]px } - } + set pct [expr {[string map {% ""} $pct] / 100.0}] + set w [region width $region] + set h [region height $region] + + switch $direction { + "right" { region move $region right [expr {$w * $pct}]px } + "left" { region move $region left [expr {$w * $pct}]px } + "up" { region move $region up [expr {$h * $pct}]px } + "down" { region move $region down [expr {$h * $pct}]px } + default { region move $region right [expr {$w * $pct}]px } + } } When /someone/ wishes /p/ draws a rect with width /w/ height /h/ shift /direction/ /pct/ { @@ -131,11 +131,11 @@ When /someone/ wishes /p/ draws a /shape/ with radius /rad/ shift /direction/ /p When $p has region /r/ { set shifted [shift_region $r $direction $pct] lassign [region centroid $shifted] cx cy - + if {[dict exists $shapes $shape]} { - Wish to draw a shape with sides [dict get $shapes $shape] center [list $cx $cy] radius $rad color white + Wish to draw a shape with sides [dict get $shapes $shape] center [list $cx $cy] radius $rad color white } else { - Wish $p draws a $shape with center [list $cx $cy] radius $rad color white + Wish $p draws a $shape with center [list $cx $cy] radius $rad color white } } } @@ -153,86 +153,86 @@ When /someone/ wishes /p/ draws a /shape/ with radius /rad/ { } proc get_transform_info {region} { - set angle [region angle $region] - set center [region centroid $region] - return [list $center $angle] + set angle [region angle $region] + set center [region centroid $region] + return [list $center $angle] } proc transform_points {points center angle} { - set transformedPoints {} - foreach point $points { - lappend transformedPoints [vec2 add $center [vec2 rotate $point $angle]] - } - return $transformedPoints + set transformedPoints {} + foreach point $points { + lappend transformedPoints [vec2 add $center [vec2 rotate $point $angle]] + } + return $transformedPoints } When /someone/ wishes /page/ draws a set of points /points/ with /...options/ & /page/ has region /r/ { - set radius [dict_getdef $options radius 5] - set color [dict_getdef $options color white] - set filled [dict_getdef $options filled true] - set thickness [dict_getdef $options thickness 2] - set layer [dict_getdef $options layer 0] - - lassign [get_transform_info $r] center angle - - foreach point [transform_points $points $center $angle] { - Wish to draw a circle with center $point radius $radius thickness $thickness \ - color $color filled $filled layer $layer - } + set radius [dict_getdef $options radius 5] + set color [dict_getdef $options color white] + set filled [dict_getdef $options filled true] + set thickness [dict_getdef $options thickness 2] + set layer [dict_getdef $options layer 0] + + lassign [get_transform_info $r] center angle + + foreach point [transform_points $points $center $angle] { + Wish to draw a circle with center $point radius $radius thickness $thickness \ + color $color filled $filled layer $layer + } } When /someone/ wishes /page/ draws a polyline /points/ with /...options/ & /page/ has region /r/ { - set color [dict_getdef $options color white] - set thickness [dict_getdef $options thickness 2] - set layer [dict_getdef $options layer 0] - set dashed [dict_getdef $options dashed false] - set dashlength [dict_getdef $options dashlength 20] - set dashoffset [dict_getdef $options dashoffset 0] - - lassign [get_transform_info $r] center angle - set transformedPoints [transform_points $points $center $angle] - - if {$dashed} { - Wish to draw a dashed stroke with points $transformedPoints color $color width $thickness \ - dashlength $dashlength dashoffset $dashoffset layer $layer - } else { - Wish to draw a stroke with points $transformedPoints color $color width $thickness layer $layer - } + set color [dict_getdef $options color white] + set thickness [dict_getdef $options thickness 2] + set layer [dict_getdef $options layer 0] + set dashed [dict_getdef $options dashed false] + set dashlength [dict_getdef $options dashlength 20] + set dashoffset [dict_getdef $options dashoffset 0] + + lassign [get_transform_info $r] center angle + set transformedPoints [transform_points $points $center $angle] + + if {$dashed} { + Wish to draw a dashed stroke with points $transformedPoints color $color width $thickness \ + dashlength $dashlength dashoffset $dashoffset layer $layer + } else { + Wish to draw a stroke with points $transformedPoints color $color width $thickness layer $layer + } } Claim $this has demo { # Center circle Wish $this draws a circle - + # Grid of shapes with varying thickness set baseX -850 set baseY -200 set gridSpacing 130 - + # Row 1: Regular polygons with different colors and thickness Wish $this draws a triangle with color skyblue width 2 offset [list $baseX [expr {$baseY}]] Wish $this draws a square with color green width 4 offset [list [expr {$baseX + $gridSpacing}] [expr {$baseY}]] Wish $this draws a pentagon with color gold width 6 offset [list [expr {$baseX + $gridSpacing*2}] [expr {$baseY}]] Wish $this draws a hexagon with color orange width 8 offset [list [expr {$baseX + $gridSpacing*3}] [expr {$baseY}]] - + # Row 2: Filled shapes Wish $this draws a triangle with color skyblue filled true offset [list $baseX [expr {$baseY + $gridSpacing}]] Wish $this draws a square with color green filled true offset [list [expr {$baseX + $gridSpacing}] [expr {$baseY + $gridSpacing}]] Wish $this draws a pentagon with color gold filled true offset [list [expr {$baseX + $gridSpacing*2}] [expr {$baseY + $gridSpacing}]] Wish $this draws a hexagon with color orange filled true offset [list [expr {$baseX + $gridSpacing*3}] [expr {$baseY + $gridSpacing}]] - + # Row 3: Shifting examples Wish $this draws a triangle with radius 40 shift right 50% Wish $this draws a square with radius 40 shift left 50% Wish $this draws a pentagon with radius 40 shift up 50% Wish $this draws a hexagon with radius 40 shift down 50% - + # Row 4: Rectangles with different properties Wish $this draws a rect with width 80 height 50 color cyan thickness 3 offset [list $baseX [expr {$baseY + $gridSpacing*3}]] Wish $this draws a rect with width 80 height 50 color magenta filled true offset [list [expr {$baseX + $gridSpacing}] [expr {$baseY + $gridSpacing*3}]] Wish $this draws a rect with width 80 height 50 shift right 50% Wish $this draws a rect with width 80 height 50 shift left 50% - + # Animated elements When the clock time is /t/ { set offsetVector [list [sin $t] [cos $t]] From c385aaef18c840a984e6bc9fd18798fdd197b743 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andr=C3=A9s=20Cuervo?= Date: Thu, 13 Mar 2025 11:18:30 -0400 Subject: [PATCH 19/35] Standardize on angle and thickness for shape args --- virtual-programs/shapes.folk | 20 ++++++++++---------- 1 file changed, 10 insertions(+), 10 deletions(-) diff --git a/virtual-programs/shapes.folk b/virtual-programs/shapes.folk index 1b83794c..8d809392 100644 --- a/virtual-programs/shapes.folk +++ b/virtual-programs/shapes.folk @@ -4,7 +4,7 @@ When /someone/ wishes to draw a shape with /...options/ { set numPoints [dict get $options sides] set c [dict get $options center] set r [dict get $options radius] - set radians [dict_getdef $options radians 0] + set angle [dict_getdef $options angle 0] set color [dict_getdef $options color white] set filled [dict_getdef $options filled false] set layer [dict_getdef $options layer 0] @@ -23,7 +23,7 @@ When /someone/ wishes to draw a shape with /...options/ { } set points [lmap v $points { - vec2 add [vec2 rotate [vec2 sub $v [vec2 scale $centerPoint [expr {1.0/$numPoints}]]] $radians] $c + vec2 add [vec2 rotate [vec2 sub $v [vec2 scale $centerPoint [expr {1.0/$numPoints}]]] $angle] $c }] if {$filled} { @@ -37,10 +37,10 @@ When /someone/ wishes to draw a rect with /...options/ { set c [dict get $options center] set w [dict_getdef $options width 100] set h [dict_getdef $options height 100] - set radians [dict_getdef $options radians 0] + set angle [dict_getdef $options angle 0] set color [dict_getdef $options color white] set filled [dict_getdef $options filled false] - set width [dict_getdef $options strokeWidth 1] + set width [dict_getdef $options thickness 1] set layer [dict_getdef $options layer 0] set hw [expr {$w / 2.0}] @@ -53,7 +53,7 @@ When /someone/ wishes to draw a rect with /...options/ { [list [expr {-$hw}] [expr {$hh}]] \ [list [expr {-$hw}] [expr {-$hh}]] \ ] { - vec2 add [vec2 rotate $v $radians] $c + vec2 add [vec2 rotate $v $angle] $c }] if {$filled} { @@ -90,14 +90,14 @@ When /someone/ wishes /p/ draws a /shape/ with /...options/ & /p/ has region /r/ } elseif {$shape eq "rect"} { set w [dict_getdef $options width [region width $r]] set h [dict_getdef $options height [region height $r]] - Wish to draw a rect with center $center width $w height $h radians $angle \ + Wish to draw a rect with center $center width $w height $h angle $angle \ color $color filled $filled thickness $thickness layer $layer } elseif {[dict exists $shapes $shape]} { Wish to draw a shape with sides [dict get $shapes $shape] center $center radius $radius \ - radians $angle color $color filled $filled width $thickness layer $layer + angle $angle color $color filled $filled width $thickness layer $layer } else { Wish to draw a shape with sides 2 center $center radius $radius \ - radians $angle color $color filled $filled width $thickness layer $layer + angle $angle color $color filled $filled width $thickness layer $layer } } @@ -123,7 +123,7 @@ When /someone/ wishes /p/ draws a rect with width /w/ height /h/ shift /directio When $p has region /r/ { set shifted [shift_region $r $direction $pct] lassign [region centroid $shifted] cx cy - Wish to draw a rect with center [list $cx $cy] width $w height $h radians [region angle $r] color white + Wish to draw a rect with center [list $cx $cy] width $w height $h angle [region angle $r] color white } } @@ -141,7 +141,7 @@ When /someone/ wishes /p/ draws a /shape/ with radius /rad/ shift /direction/ /p } When /someone/ wishes /p/ draws a rect with width /w/ height /h/ { - Wish to draw a rect with center {0 0} width $w height $h radians 0 color white + Wish to draw a rect with center {0 0} width $w height $h angle 0 color white } When /someone/ wishes /p/ draws a /shape/ with radius /rad/ { From 20b54bda1e8f236a2a5eadcfd62dde63a8277d0c Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andr=C3=A9s=20Cuervo?= Date: Thu, 13 Mar 2025 11:40:34 -0400 Subject: [PATCH 20/35] Refactor shapes to use offsets simplify structure --- virtual-programs/shapes.folk | 357 +++++++++++++++++++++-------------- 1 file changed, 217 insertions(+), 140 deletions(-) diff --git a/virtual-programs/shapes.folk b/virtual-programs/shapes.folk index 8d809392..d4f680b0 100644 --- a/virtual-programs/shapes.folk +++ b/virtual-programs/shapes.folk @@ -1,65 +1,160 @@ set shapes [dict create triangle 3 square 4 pentagon 5 hexagon 6 septagon 7 octagon 8 nonagon 9] -When /someone/ wishes to draw a shape with /...options/ { - set numPoints [dict get $options sides] - set c [dict get $options center] - set r [dict get $options radius] - set angle [dict_getdef $options angle 0] - set color [dict_getdef $options color white] - set filled [dict_getdef $options filled false] - set layer [dict_getdef $options layer 0] - set width [dict_getdef $options width 1] - - set points {{0 0}} - set centerPoint {0 0} - set angle [expr {2 * 3.14159 / $numPoints + 3.14159}] - set angleIncr [expr {2 * 3.14159 / $numPoints}] - - for {set i 0} {$i < $numPoints} {incr i} { - set p [vec2 add [lindex $points end] [vec2 scale [list [expr {cos($angle)}] [expr {sin($angle)}]] $r]] - lappend points $p - set centerPoint [vec2 add $centerPoint $p] - set angle [expr {$angle + $angleIncr}] +proc process_offset {offset region} { + if {![info exists region]} { + return $offset } - - set points [lmap v $points { - vec2 add [vec2 rotate [vec2 sub $v [vec2 scale $centerPoint [expr {1.0/$numPoints}]]] $angle] $c - }] - - if {$filled} { - Wish to draw a polygon with points $points color $color layer $layer - } else { - Wish to draw a stroke with points $points width $width color $color layer $layer + + set w [region width $region] + set h [region height $region] + + if {[llength $offset] == 2 && + ![string match *%* $offset] && + ![string is alpha -strict [lindex $offset 0]]} { + return $offset + } + + # Handle simple percentage string: "50%" + if {[string match *%* $offset] && [llength $offset] == 1} { + set pct [expr {[string map {% ""} $offset] / 100.0}] + return [list [expr {$w * $pct}] 0] # Default to horizontal offset + } + + # Handle directional strings: "right", "left", "up", "down" + if {$offset eq "right"} { + return [list [expr {$w * 0.5}] 0] + } elseif {$offset eq "left"} { + return [list [expr {-$w * 0.5}] 0] + } elseif {$offset eq "up"} { + return [list 0 [expr {-$h * 0.5}]] + } elseif {$offset eq "down"} { + return [list 0 [expr {$h * 0.5}]] + } + + # Handle directional percentage: "right 50%", "left 25%", etc. + if {[llength $offset] == 2 && [string is alpha -strict [lindex $offset 0]]} { + set direction [lindex $offset 0] + set amount [lindex $offset 1] + + if {[string match *%* $amount]} { + set pct [expr {[string map {% ""} $amount] / 100.0}] + + switch $direction { + "right" { return [list [expr {$w * $pct}] 0] } + "left" { return [list [expr {-$w * $pct}] 0] } + "up" { return [list 0 [expr {-$h * $pct}]] } + "down" { return [list 0 [expr {$h * $pct}]] } + default { return [list 0 0] } + } + } + } + + # Handle x y vector where one or both components have percentage notation + if {[llength $offset] == 2} { + lassign $offset ox oy + + if {[string match *%* $ox]} { + set pct [expr {[string map {% ""} $ox] / 100.0}] + set ox [expr {$w * $pct}] } + + if {[string match *%* $oy]} { + set pct [expr {[string map {% ""} $oy] / 100.0}] + set oy [expr {$h * $pct}] + } + + return [list $ox $oy] } + + # Default fallback + return $offset +} -When /someone/ wishes to draw a rect with /...options/ { - set c [dict get $options center] - set w [dict_getdef $options width 100] - set h [dict_getdef $options height 100] - set angle [dict_getdef $options angle 0] +When /someone/ wishes to draw a shape with /...options/ { + set isRect 0 + if {[dict exists $options type] && [dict get $options type] eq "rect"} { + set isRect 1 + } + + set c [dict_getdef $options center {0 0}] + set color [dict_getdef $options color white] set filled [dict_getdef $options filled false] - set width [dict_getdef $options thickness 1] + set thickness [dict_getdef $options thickness 1] set layer [dict_getdef $options layer 0] - - set hw [expr {$w / 2.0}] - set hh [expr {$h / 2.0}] - - set points [lmap v [list \ - [list [expr {-$hw}] [expr {-$hh}]] \ - [list [expr {$hw}] [expr {-$hh}]] \ - [list [expr {$hw}] [expr {$hh}]] \ - [list [expr {-$hw}] [expr {$hh}]] \ - [list [expr {-$hw}] [expr {-$hh}]] \ + set angle [dict_getdef $options angle 0] + + if {$isRect} { + set w [dict_getdef $options width 100] + set h [dict_getdef $options height 100] + + set hw [expr {$w / 2.0}] + set hh [expr {$h / 2.0}] + + set points [lmap v [list \ + [list [expr {-$hw}] [expr {-$hh}]] \ + [list [expr {$hw}] [expr {-$hh}]] \ + [list [expr {$hw}] [expr {$hh}]] \ + [list [expr {-$hw}] [expr {$hh}]] \ + [list [expr {-$hw}] [expr {-$hh}]] \ ] { vec2 add [vec2 rotate $v $angle] $c }] + } else { + set numPoints [dict_getdef $options sides 4] + if {[dict exists $options shape] && [dict exists $shapes [dict get $options shape]]} { + set numPoints [dict get $shapes [dict get $options shape]] + } + set r [dict_getdef $options radius 50] + + set points {{0 0}} + set centerPoint {0 0} + set polyAngle [expr {2 * 3.14159 / $numPoints + 3.14159}] + set angleIncr [expr {2 * 3.14159 / $numPoints}] + + for {set i 0} {$i < $numPoints} {incr i} { + set p [vec2 add [lindex $points end] [vec2 scale [list [expr {cos($polyAngle)}] [expr {sin($polyAngle)}]] $r]] + lappend points $p + set centerPoint [vec2 add $centerPoint $p] + set polyAngle [expr {$polyAngle + $angleIncr}] + } + + set points [lmap v $points { + vec2 add [vec2 rotate [vec2 sub $v [vec2 scale $centerPoint [expr {1.0/$numPoints}]]] $angle] $c + }] + } + + if {$filled} { + Wish to draw a polygon with points $points color $color layer $layer + } else { + Wish to draw a stroke with points $points width $thickness color $color layer $layer + } +} +When /someone/ wishes to draw a circle with /...options/ { + set center [dict_getdef $options center {0 0}] + set radius [dict_getdef $options radius 50] + set color [dict_getdef $options color white] + set thickness [dict_getdef $options thickness 2] + set filled [dict_getdef $options filled false] + set layer [dict_getdef $options layer 0] + + set numPoints 36 + set points {} + + for {set i 0} {$i < $numPoints} {incr i} { + set angle [expr {2 * 3.14159 * $i / $numPoints}] + set x [expr {$radius * cos($angle)}] + set y [expr {$radius * sin($angle)}] + lappend points [vec2 add [list $x $y] $center] + } + + lappend points [lindex $points 0] + if {$filled} { Wish to draw a polygon with points $points color $color layer $layer } else { - Wish to draw a stroke with points $points width $width color $color layer $layer + Wish to draw a stroke with points $points width $thickness color $color layer $layer } } @@ -67,6 +162,7 @@ When /someone/ wishes /p/ draws a /shape/ { Wish $p draws a $shape with color white } +# Handle "a" vs "an" grammar variations When /someone/ wishes /p/ draws an /shape/ { Wish $p draws a $shape } @@ -74,96 +170,55 @@ When /someone/ wishes /p/ draws an /shape/ { When /someone/ wishes /p/ draws a /shape/ with /...options/ & /p/ has region /r/ { lassign [region centroid $r] cx cy set angle [region angle $r] - - set radius [dict_getdef $options radius 50] + set color [dict_getdef $options color white] set filled [dict_getdef $options filled false] set thickness [dict_getdef $options thickness 5] set layer [dict_getdef $options layer 0] - - lassign [dict_getdef $options offset {0 0}] ox oy - set center [vec2 add [list $cx $cy] [vec2 rotate [list $ox $oy] $angle]] - + + set offset [dict_getdef $options offset {0 0}] + set offset [process_offset $offset $r] + + set center [vec2 add [list $cx $cy] [vec2 rotate $offset $angle]] + if {$shape eq "circle"} { + set radius [dict_getdef $options radius 50] + Wish to draw a circle with center $center radius $radius thickness $thickness \ color $color filled $filled layer $layer + } elseif {$shape eq "rect"} { set w [dict_getdef $options width [region width $r]] set h [dict_getdef $options height [region height $r]] - Wish to draw a rect with center $center width $w height $h angle $angle \ + + Wish to draw a shape with type rect center $center width $w height $h angle $angle \ color $color filled $filled thickness $thickness layer $layer + } elseif {[dict exists $shapes $shape]} { + set radius [dict_getdef $options radius 50] + Wish to draw a shape with sides [dict get $shapes $shape] center $center radius $radius \ - angle $angle color $color filled $filled width $thickness layer $layer + angle $angle color $color filled $filled thickness $thickness layer $layer + } else { - Wish to draw a shape with sides 2 center $center radius $radius \ - angle $angle color $color filled $filled width $thickness layer $layer + set radius [dict_getdef $options radius 50] + + Wish to draw a shape with sides 4 center $center radius $radius \ + angle $angle color $color filled $filled thickness $thickness layer $layer } } +# Pass through options for "an" version When /someone/ wishes /p/ draws an /shape/ with /...options/ { Wish $p draws a $shape with {*}$options } -proc shift_region {region direction pct} { - set pct [expr {[string map {% ""} $pct] / 100.0}] - set w [region width $region] - set h [region height $region] - - switch $direction { - "right" { region move $region right [expr {$w * $pct}]px } - "left" { region move $region left [expr {$w * $pct}]px } - "up" { region move $region up [expr {$h * $pct}]px } - "down" { region move $region down [expr {$h * $pct}]px } - default { region move $region right [expr {$w * $pct}]px } - } -} - -When /someone/ wishes /p/ draws a rect with width /w/ height /h/ shift /direction/ /pct/ { - When $p has region /r/ { - set shifted [shift_region $r $direction $pct] - lassign [region centroid $shifted] cx cy - Wish to draw a rect with center [list $cx $cy] width $w height $h angle [region angle $r] color white - } -} - -When /someone/ wishes /p/ draws a /shape/ with radius /rad/ shift /direction/ /pct/ { - When $p has region /r/ { - set shifted [shift_region $r $direction $pct] - lassign [region centroid $shifted] cx cy - - if {[dict exists $shapes $shape]} { - Wish to draw a shape with sides [dict get $shapes $shape] center [list $cx $cy] radius $rad color white - } else { - Wish $p draws a $shape with center [list $cx $cy] radius $rad color white - } - } -} - When /someone/ wishes /p/ draws a rect with width /w/ height /h/ { - Wish to draw a rect with center {0 0} width $w height $h angle 0 color white + Wish $p draws a rect with width $w height $h } When /someone/ wishes /p/ draws a /shape/ with radius /rad/ { - if {[dict exists $shapes $shape]} { - Wish to draw a shape with sides [dict get $shapes $shape] center {0 0} radius $rad color white - } else { - Wish to draw a $shape with center {0 0} radius $rad color white - } -} - -proc get_transform_info {region} { - set angle [region angle $region] - set center [region centroid $region] - return [list $center $angle] -} - -proc transform_points {points center angle} { - set transformedPoints {} - foreach point $points { - lappend transformedPoints [vec2 add $center [vec2 rotate $point $angle]] - } - return $transformedPoints + Wish $p draws a $shape with radius $rad } When /someone/ wishes /page/ draws a set of points /points/ with /...options/ & /page/ has region /r/ { @@ -172,11 +227,21 @@ When /someone/ wishes /page/ draws a set of points /points/ with /...options/ & set filled [dict_getdef $options filled true] set thickness [dict_getdef $options thickness 2] set layer [dict_getdef $options layer 0] - - lassign [get_transform_info $r] center angle - - foreach point [transform_points $points $center $angle] { - Wish to draw a circle with center $point radius $radius thickness $thickness \ + + lassign [region centroid $r] cx cy + set angle [region angle $r] + set center [list $cx $cy] + + if {[dict exists $options offset]} { + set offset [dict get $options offset] + set offset [process_offset $offset $r] + set center [vec2 add $center [vec2 rotate $offset $angle]] + } + + foreach point $points { + set pointPos [vec2 add $center [vec2 rotate $point $angle]] + + Wish to draw a circle with center $pointPos radius $radius thickness $thickness \ color $color filled $filled layer $layer } } @@ -188,10 +253,22 @@ When /someone/ wishes /page/ draws a polyline /points/ with /...options/ & /page set dashed [dict_getdef $options dashed false] set dashlength [dict_getdef $options dashlength 20] set dashoffset [dict_getdef $options dashoffset 0] - - lassign [get_transform_info $r] center angle - set transformedPoints [transform_points $points $center $angle] - + + lassign [region centroid $r] cx cy + set angle [region angle $r] + set center [list $cx $cy] + + if {[dict exists $options offset]} { + set offset [dict get $options offset] + set offset [process_offset $offset $r] + set center [vec2 add $center [vec2 rotate $offset $angle]] + } + + set transformedPoints {} + foreach point $points { + lappend transformedPoints [vec2 add $center [vec2 rotate $point $angle]] + } + if {$dashed} { Wish to draw a dashed stroke with points $transformedPoints color $color width $thickness \ dashlength $dashlength dashoffset $dashoffset layer $layer @@ -203,49 +280,49 @@ When /someone/ wishes /page/ draws a polyline /points/ with /...options/ & /page Claim $this has demo { # Center circle Wish $this draws a circle - + # Grid of shapes with varying thickness set baseX -850 set baseY -200 set gridSpacing 130 - + # Row 1: Regular polygons with different colors and thickness - Wish $this draws a triangle with color skyblue width 2 offset [list $baseX [expr {$baseY}]] - Wish $this draws a square with color green width 4 offset [list [expr {$baseX + $gridSpacing}] [expr {$baseY}]] - Wish $this draws a pentagon with color gold width 6 offset [list [expr {$baseX + $gridSpacing*2}] [expr {$baseY}]] - Wish $this draws a hexagon with color orange width 8 offset [list [expr {$baseX + $gridSpacing*3}] [expr {$baseY}]] - + Wish $this draws a triangle with color skyblue thickness 2 offset [list $baseX [expr {$baseY}]] + Wish $this draws a square with color green thickness 4 offset [list [expr {$baseX + $gridSpacing}] [expr {$baseY}]] + Wish $this draws a pentagon with color gold thickness 6 offset [list [expr {$baseX + $gridSpacing*2}] [expr {$baseY}]] + Wish $this draws a hexagon with color orange thickness 8 offset [list [expr {$baseX + $gridSpacing*3}] [expr {$baseY}]] + # Row 2: Filled shapes Wish $this draws a triangle with color skyblue filled true offset [list $baseX [expr {$baseY + $gridSpacing}]] Wish $this draws a square with color green filled true offset [list [expr {$baseX + $gridSpacing}] [expr {$baseY + $gridSpacing}]] Wish $this draws a pentagon with color gold filled true offset [list [expr {$baseX + $gridSpacing*2}] [expr {$baseY + $gridSpacing}]] Wish $this draws a hexagon with color orange filled true offset [list [expr {$baseX + $gridSpacing*3}] [expr {$baseY + $gridSpacing}]] - - # Row 3: Shifting examples - Wish $this draws a triangle with radius 40 shift right 50% - Wish $this draws a square with radius 40 shift left 50% - Wish $this draws a pentagon with radius 40 shift up 50% - Wish $this draws a hexagon with radius 40 shift down 50% - + + # Row 3: Directional offset examples (replacing shift) + Wish $this draws a triangle with radius 40 offset "right 50%" + Wish $this draws a square with radius 40 offset "left 50%" + Wish $this draws a pentagon with radius 40 offset "up 50%" + Wish $this draws a hexagon with radius 40 offset "down 50%" + # Row 4: Rectangles with different properties Wish $this draws a rect with width 80 height 50 color cyan thickness 3 offset [list $baseX [expr {$baseY + $gridSpacing*3}]] Wish $this draws a rect with width 80 height 50 color magenta filled true offset [list [expr {$baseX + $gridSpacing}] [expr {$baseY + $gridSpacing*3}]] - Wish $this draws a rect with width 80 height 50 shift right 50% - Wish $this draws a rect with width 80 height 50 shift left 50% - + Wish $this draws a rect with width 80 height 50 offset "right 50%" + Wish $this draws a rect with width 80 height 50 offset "left 50%" + # Animated elements When the clock time is /t/ { set offsetVector [list [sin $t] [cos $t]] set offsetVector [::vec2::scale $offsetVector 105] Wish $this draws a circle with color palegoldenrod offset $offsetVector } - + When $this has region /r/ & the clock time is /t/ { lassign [region centroid $r] x y set fill [expr {round(sin($t) * 2) % 2 == 0}] set y [- $y 150] - Wish to draw a square with center [list [- $x 100] $y] radius 60 color white filled $fill + Wish to draw a shape with sides 4 center [list [- $x 100] $y] radius 60 color white filled $fill } - + Wish $this is outlined white } \ No newline at end of file From add6b0e0695795c35a5160587d5143713db544ed Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andr=C3=A9s=20Cuervo?= Date: Thu, 13 Mar 2025 12:06:17 -0400 Subject: [PATCH 21/35] Remove conflicting When --- virtual-programs/shapes.folk | 27 --------------------------- 1 file changed, 27 deletions(-) diff --git a/virtual-programs/shapes.folk b/virtual-programs/shapes.folk index d4f680b0..aeceda8e 100644 --- a/virtual-programs/shapes.folk +++ b/virtual-programs/shapes.folk @@ -131,33 +131,6 @@ When /someone/ wishes to draw a shape with /...options/ { } } -When /someone/ wishes to draw a circle with /...options/ { - set center [dict_getdef $options center {0 0}] - set radius [dict_getdef $options radius 50] - set color [dict_getdef $options color white] - set thickness [dict_getdef $options thickness 2] - set filled [dict_getdef $options filled false] - set layer [dict_getdef $options layer 0] - - set numPoints 36 - set points {} - - for {set i 0} {$i < $numPoints} {incr i} { - set angle [expr {2 * 3.14159 * $i / $numPoints}] - set x [expr {$radius * cos($angle)}] - set y [expr {$radius * sin($angle)}] - lappend points [vec2 add [list $x $y] $center] - } - - lappend points [lindex $points 0] - - if {$filled} { - Wish to draw a polygon with points $points color $color layer $layer - } else { - Wish to draw a stroke with points $points width $thickness color $color layer $layer - } -} - When /someone/ wishes /p/ draws a /shape/ { Wish $p draws a $shape with color white } From 911003d2d53e9ee75cd02abdd8d754a8c9350cad Mon Sep 17 00:00:00 2001 From: RobF Date: Thu, 24 Apr 2025 18:36:14 +1200 Subject: [PATCH 22/35] Add wishes page draws text --- virtual-programs/shapes.folk | 64 ++++++++++++++++++++++++++++-------- 1 file changed, 50 insertions(+), 14 deletions(-) diff --git a/virtual-programs/shapes.folk b/virtual-programs/shapes.folk index aeceda8e..ed3142a3 100644 --- a/virtual-programs/shapes.folk +++ b/virtual-programs/shapes.folk @@ -38,7 +38,7 @@ proc process_offset {offset region} { if {[string match *%* $amount]} { set pct [expr {[string map {% ""} $amount] / 100.0}] - + switch $direction { "right" { return [list [expr {$w * $pct}] 0] } "left" { return [list [expr {-$w * $pct}] 0] } @@ -140,6 +140,22 @@ When /someone/ wishes /p/ draws an /shape/ { Wish $p draws a $shape } +When /someone/ wishes /p/ draws text /text/ with /...options/ & /p/ has region /r/ { + # As shapes.folk but for text. + lassign [region centroid $r] cx cy + set angle [region angle $r] + + set color [dict_getdef $options color white] + set scale [dict_getdef $options scale 1.0] + set layer [dict_getdef $options layer 0] + + set offset [dict_getdef $options offset {0 0}] + set offset [::process_offset $offset $r] + set center [vec2 add [list $cx $cy] [vec2 rotate $offset $angle]] + + Wish to draw text with position $center scale $scale text $text color $color radians $angle +} + When /someone/ wishes /p/ draws a /shape/ with /...options/ & /p/ has region /r/ { lassign [region centroid $r] cx cy set angle [region angle $r] @@ -258,6 +274,12 @@ Claim $this has demo { set baseX -850 set baseY -200 set gridSpacing 130 + + # Row 0: Title + Wish $this draws text "triangle" with color skyblue offset [list $baseX [expr {$baseY - ($gridSpacing / 2.0)}]] scale 0.9 + Wish $this draws text "square" with color green offset [list [expr {$baseX + $gridSpacing}] [expr {$baseY - ($gridSpacing / 2.0)}]] scale 0.9 + Wish $this draws text "pentagon" with color gold offset [list [expr {$baseX + $gridSpacing*2}] [expr {$baseY - ($gridSpacing / 2.0)}]] scale 0.9 + Wish $this draws text "hexagon" with color orange offset [list [expr {$baseX + $gridSpacing*3}] [expr {$baseY - ($gridSpacing / 2.0)}]] scale 0.9 # Row 1: Regular polygons with different colors and thickness Wish $this draws a triangle with color skyblue thickness 2 offset [list $baseX [expr {$baseY}]] @@ -270,12 +292,12 @@ Claim $this has demo { Wish $this draws a square with color green filled true offset [list [expr {$baseX + $gridSpacing}] [expr {$baseY + $gridSpacing}]] Wish $this draws a pentagon with color gold filled true offset [list [expr {$baseX + $gridSpacing*2}] [expr {$baseY + $gridSpacing}]] Wish $this draws a hexagon with color orange filled true offset [list [expr {$baseX + $gridSpacing*3}] [expr {$baseY + $gridSpacing}]] - + # Row 3: Directional offset examples (replacing shift) - Wish $this draws a triangle with radius 40 offset "right 50%" - Wish $this draws a square with radius 40 offset "left 50%" - Wish $this draws a pentagon with radius 40 offset "up 50%" - Wish $this draws a hexagon with radius 40 offset "down 50%" + Wish $this draws a triangle with radius 40 offset "right 50%" color skyblue + Wish $this draws a square with radius 40 offset "left 50%" color green + Wish $this draws a pentagon with radius 40 offset "up 50%" color gold + Wish $this draws a hexagon with radius 40 offset "down 50%" color orange # Row 4: Rectangles with different properties Wish $this draws a rect with width 80 height 50 color cyan thickness 3 offset [list $baseX [expr {$baseY + $gridSpacing*3}]] @@ -283,19 +305,33 @@ Claim $this has demo { Wish $this draws a rect with width 80 height 50 offset "right 50%" Wish $this draws a rect with width 80 height 50 offset "left 50%" - # Animated elements - When the clock time is /t/ { - set offsetVector [list [sin $t] [cos $t]] - set offsetVector [::vec2::scale $offsetVector 105] - Wish $this draws a circle with color palegoldenrod offset $offsetVector +# Animated elements + When $this has region /r/ & the clock time is /t/ { + lassign [region angle $r] angle + for {set i 0} {$i < 8} {incr i} { + set offsetVector [list [sin [+ [- $i $t] $angle]] [* 2 [cos [+ [- $i $t] $angle]]]] + set vector [::vec2::scale $offsetVector [+ [* $i $i] 15]] + Wish $this draws a circle with radius $i color palegoldenrod offset $vector + } } When $this has region /r/ & the clock time is /t/ { lassign [region centroid $r] x y - set fill [expr {round(sin($t) * 2) % 2 == 0}] + set fillVal [expr {round(sin($t) * 2)}] + set fill [expr {$fillVal % 2 == 0}] + set y [- $y 150] + Wish to draw a shape with sides 4 center [list [- $x 200] $y] radius 60 color white filled $fill + Wish to draw text with position [list [- $x 200] [+ $y 14]] scale 1.5 text "$fillVal" color red + } + + When $this has region /r/ & the clock time is /t/ { + lassign [region centroid $r] x y + set fillVal [expr {round($t * 2)}] + set fill [expr {$fillVal % 2 == 0}] set y [- $y 150] - Wish to draw a shape with sides 4 center [list [- $x 100] $y] radius 60 color white filled $fill + Wish to draw a shape with sides 4 center [list [+ $x 200] $y] radius 60 color white filled $fill + Wish to draw text with position [list [+ $x 200] [+ $y 14]] scale 1.5 text "$fill" color red } Wish $this is outlined white -} \ No newline at end of file +} From 33b4a92b9bccb7af13d0bd8eeab14f7bf328eed0 Mon Sep 17 00:00:00 2001 From: RobF Date: Mon, 28 Apr 2025 14:15:32 +1200 Subject: [PATCH 23/35] wish highlights region --- virtual-programs/shapes/region.folk | 126 ++++++++++++++++++++++++++++ 1 file changed, 126 insertions(+) create mode 100644 virtual-programs/shapes/region.folk diff --git a/virtual-programs/shapes/region.folk b/virtual-programs/shapes/region.folk new file mode 100644 index 00000000..6a1e8f61 --- /dev/null +++ b/virtual-programs/shapes/region.folk @@ -0,0 +1,126 @@ +# Creates a id "${p}:${index}" and assigns region. +# Extra regions can be used to create sensitive areas other pages can collect. +When /someone/ wishes /p/ adds region with /...options/ & /p/ has region /r/ { + lassign [region centroid $r] cx cy + set angle [region angle $r] + + set index [dict_getdef $options index 0] + set height [dict_getdef $options height 55] + set width [dict_getdef $options width 55] + set outline [dict_getdef $options outline false] + + set offset [dict_getdef $options offset {0 0}] + set offset [::process_offset $offset $r] + set center [vec2 add [list $cx $cy] [vec2 rotate $offset $angle]] + + # draw a small debug box within the setting. + # if {$outline} { + # Wish $p draws a rect with color orange thickness 1 width [expr {$width + 3}] height [expr {$height + 3}] offset $offset + #} + + # compute points offset from $p + set hw [expr {$width / 2.0}] + set hh [expr {$height / 2.0}] + set points [lmap v [list \ + [list [expr {-$hw}] [expr {-$hh}]] \ + [list [expr {$hw}] [expr {-$hh}]] \ + [list [expr {$hw}] [expr {$hh}]] \ + [list [expr {-$hw}] [expr {$hh}]] \ + [list [expr {-$hw}] [expr {-$hh}]] \ + ] { + vec2 add $v $offset + }] + + # compute points in table coordinates + set tablePoints [lmap v [list \ + [list [expr {-$hw}] [expr {-$hh}]] \ + [list [expr {$hw}] [expr {-$hh}]] \ + [list [expr {$hw}] [expr {$hh}]] \ + [list [expr {-$hw}] [expr {$hh}]] \ + [list [expr {-$hw}] [expr {-$hh}]] \ + ] { + vec2 add $center [vec2 rotate $v $angle] + }] + + # debug: display little red dots around the region on table points. +# if {$outline} { +# lassign $tablePoints tp1 tp2 tp3 tp4 +# Wish to draw a circle with center $tp1 radius 5 thickness 2 \ +# color red filled true +# Wish to draw a circle with center $tp2 radius 5 thickness 2 \ +# color red filled true +# Wish to draw a circle with center $tp3 radius 5 thickness 2 \ +# color red filled true +# Wish to draw a circle with center $tp4 radius 5 thickness 2 \ +# color red filled true +# } + + set edges [list] + for {set i 0} {$i < [llength $tablePoints]} {incr i} { + if {$i > 0} { lappend edges [list [expr {$i - 1}] $i] } + } + lappend edges [list [expr {[llength $tablePoints] - 1}] 0] + + # Create new region in table points + set indexedRegion [region create $tablePoints $edges $angle] + Claim $p has indexedRegion with index $index region $indexedRegion + Claim "${p}:${index}" has region $indexedRegion + + # debug: display dashed line around the points + if {$outline} { + Wish region $indexedRegion has highlight $outline with color red + } +} + +When /someone/ wishes region /r/ has boundingbox /highlighted/ with color /color/ { + + if {$highlighted} { + lassign [regionToBbox $r] bMinX bMinY bMaxX bMaxY + + # minpoint on a circle + set mx [expr {($bMaxX + $bMinX) / 2}] + set my [expr {($bMaxY + $bMinY) / 2}] + + # direction vector + set dx [expr {$bMaxX - $bMinX}] + set dy [expr {$bMaxY - $bMinY}] + + # radius - half hypotenuse + set length [expr {sqrt($dx * $dx + $dy * $dy)}] + set r [expr {$length / 2}] + + # normal vector + set nx [- $dy] + set ny $dx + set ux [expr {$nx / $length}] + set uy [expr {$ny / $length}] + + # up + set upX [expr {$mx + $r * $ux}] + set upY [expr {$my + $r * $uy}] + set downX [expr {$mx - $r * $ux}] + set downY [expr {$my - $r * $uy}] + + Display::stroke [list [list $bMinX $bMinY] [list $bMaxX $bMaxY]] 3 blue + Display::stroke [list [list $upX $upY] [list $downX $downY]] 3 red + + } +} + +When /someone/ wishes region /r/ has highlight /highlighted/ with /...options/ { + + set color [dict_getdef $options color white] + set thickness [dict_getdef $options thickness 2] + set layer [dict_getdef $options layer 0] + set dashed [dict_getdef $options dashed false] + set dashlength [dict_getdef $options dashlength 20] + set dashoffset [dict_getdef $options dashoffset 0] + + if {$highlighted} { + set verts [region vertices $r] + set edges [region edges $r] + lappend verts [lindex $verts 0] + Wish to draw a dashed stroke with points $verts color $color width $thickness dashlength $dashlength dashoffset $dashoffset layer $layer + } +} + From 5db94b22a10698fde6de04aa33ffa3a08f6e6b4a Mon Sep 17 00:00:00 2001 From: RobF Date: Mon, 28 Apr 2025 14:53:39 +1200 Subject: [PATCH 24/35] PR --- virtual-programs/shapes/region.folk | 91 ++++++++--------------------- 1 file changed, 25 insertions(+), 66 deletions(-) diff --git a/virtual-programs/shapes/region.folk b/virtual-programs/shapes/region.folk index 6a1e8f61..5666974e 100644 --- a/virtual-programs/shapes/region.folk +++ b/virtual-programs/shapes/region.folk @@ -7,29 +7,16 @@ When /someone/ wishes /p/ adds region with /...options/ & /p/ has region /r/ { set index [dict_getdef $options index 0] set height [dict_getdef $options height 55] set width [dict_getdef $options width 55] - set outline [dict_getdef $options outline false] + set highlight [dict_getdef $options highlight false] + set color [dict_getdef $options color red] set offset [dict_getdef $options offset {0 0}] set offset [::process_offset $offset $r] set center [vec2 add [list $cx $cy] [vec2 rotate $offset $angle]] - # draw a small debug box within the setting. - # if {$outline} { - # Wish $p draws a rect with color orange thickness 1 width [expr {$width + 3}] height [expr {$height + 3}] offset $offset - #} - # compute points offset from $p set hw [expr {$width / 2.0}] set hh [expr {$height / 2.0}] - set points [lmap v [list \ - [list [expr {-$hw}] [expr {-$hh}]] \ - [list [expr {$hw}] [expr {-$hh}]] \ - [list [expr {$hw}] [expr {$hh}]] \ - [list [expr {-$hw}] [expr {$hh}]] \ - [list [expr {-$hw}] [expr {-$hh}]] \ - ] { - vec2 add $v $offset - }] # compute points in table coordinates set tablePoints [lmap v [list \ @@ -42,24 +29,11 @@ When /someone/ wishes /p/ adds region with /...options/ & /p/ has region /r/ { vec2 add $center [vec2 rotate $v $angle] }] - # debug: display little red dots around the region on table points. -# if {$outline} { -# lassign $tablePoints tp1 tp2 tp3 tp4 -# Wish to draw a circle with center $tp1 radius 5 thickness 2 \ -# color red filled true -# Wish to draw a circle with center $tp2 radius 5 thickness 2 \ -# color red filled true -# Wish to draw a circle with center $tp3 radius 5 thickness 2 \ -# color red filled true -# Wish to draw a circle with center $tp4 radius 5 thickness 2 \ -# color red filled true -# } - set edges [list] for {set i 0} {$i < [llength $tablePoints]} {incr i} { if {$i > 0} { lappend edges [list [expr {$i - 1}] $i] } } - lappend edges [list [expr {[llength $tablePoints] - 1}] 0] + lappend edges [list [expr {[llength $tablePoints] - 1}] [lindex $tablePoints 0]] # Create new region in table points set indexedRegion [region create $tablePoints $edges $angle] @@ -67,43 +41,8 @@ When /someone/ wishes /p/ adds region with /...options/ & /p/ has region /r/ { Claim "${p}:${index}" has region $indexedRegion # debug: display dashed line around the points - if {$outline} { - Wish region $indexedRegion has highlight $outline with color red - } -} - -When /someone/ wishes region /r/ has boundingbox /highlighted/ with color /color/ { - - if {$highlighted} { - lassign [regionToBbox $r] bMinX bMinY bMaxX bMaxY - - # minpoint on a circle - set mx [expr {($bMaxX + $bMinX) / 2}] - set my [expr {($bMaxY + $bMinY) / 2}] - - # direction vector - set dx [expr {$bMaxX - $bMinX}] - set dy [expr {$bMaxY - $bMinY}] - - # radius - half hypotenuse - set length [expr {sqrt($dx * $dx + $dy * $dy)}] - set r [expr {$length / 2}] - - # normal vector - set nx [- $dy] - set ny $dx - set ux [expr {$nx / $length}] - set uy [expr {$ny / $length}] - - # up - set upX [expr {$mx + $r * $ux}] - set upY [expr {$my + $r * $uy}] - set downX [expr {$mx - $r * $ux}] - set downY [expr {$my - $r * $uy}] - - Display::stroke [list [list $bMinX $bMinY] [list $bMaxX $bMaxY]] 3 blue - Display::stroke [list [list $upX $upY] [list $downX $downY]] 3 red - + if {$highlight} { + Wish region $indexedRegion has highlight $highlight with color $color } } @@ -124,3 +63,23 @@ When /someone/ wishes region /r/ has highlight /highlighted/ with /...options/ { } } +Claim $this has demo { + + # How to use + # When virtual-programs/shapes/region.folk has demo /code/ & \ + # $this has region /r/ { + # Claim $this has program code $code + # set angle [region angle $r] + # set pos [region bottom $r] + # Wish to draw text with position $pos scale 0.6 text $code radians $angle anchor topright + # } + + When $this has region /r/ { + Wish region $r has highlight true with color yellow thickness 1 dashed true + + Wish $this adds region with index 0 width 50 height 50 offset [list -250 0] highlight true color yellow + Wish $this draws text "Region 0" with offset [list -250 -50] scale 0.6 color yellow + Wish $this adds region with index 1 width 50 height 50 offset [list 250 0] highlight true color yellow + Wish $this draws text "Region 1" with offset [list 250 -50] scale 0.6 color yellow + } +} From d95d9b67bbb3d3577dd02c1a0950b5aa5d3d3d42 Mon Sep 17 00:00:00 2001 From: RobF Date: Mon, 28 Apr 2025 14:40:58 +1200 Subject: [PATCH 25/35] fix compile --- vendor/blobdetect/blobdetect.tcl | 22 ++++++++++++---------- 1 file changed, 12 insertions(+), 10 deletions(-) diff --git a/vendor/blobdetect/blobdetect.tcl b/vendor/blobdetect/blobdetect.tcl index c4f1c3ce..e59e05a4 100644 --- a/vendor/blobdetect/blobdetect.tcl +++ b/vendor/blobdetect/blobdetect.tcl @@ -1,10 +1,10 @@ namespace eval ::BlobDetect { - rename [c create] apc - apc cflags -I$::env(HOME)/apriltag $::env(HOME)/folk/vendor/blobdetect/hk.c - apc include - apc include - apc include - apc code { + set cc [c create] + $cc cflags -I$::env(HOME)/apriltag $::env(HOME)/folk/vendor/blobdetect/hk.c + $cc include + $cc include + $cc include + $cc code { int hoshen_kopelman(int **matrix, int m, int n); typedef struct { @@ -36,6 +36,7 @@ namespace eval ::BlobDetect { // for(int i = 0; i < rows; i++) // memset(matrix[i], 0, cols * sizeof(int)); + // filter the raster into on or off for (int y = 0; y < im_orig->height; y++) { for (int x = 0; x < im_orig->width; x++) { int i = y * im_orig->stride + x; @@ -54,6 +55,7 @@ namespace eval ::BlobDetect { int clusters = hoshen_kopelman(matrix,m,n); // printf("clusters: %d\n", clusters); + // initialize a structure for (int i=0; iid = i; @@ -120,9 +122,9 @@ namespace eval ::BlobDetect { zarray_destroy(detections); } } - defineImageType apc + defineImageType $cc - apc proc detect {image_t gray int threshold} Tcl_Obj* { + $cc proc detect {image_t gray int threshold} Tcl_Obj* { assert(gray.components == 1); image_u8_t im = (image_u8_t) { .width = gray.width, .height = gray.height, .stride = gray.bytesPerRow, .buf = gray.data }; @@ -134,7 +136,7 @@ namespace eval ::BlobDetect { detected_blob_t *det; zarray_get(detections, i, &det); - // printf("detection %3d: id %-4d\n cx %f cy %f size %d\n", i, det->id, det->c[0], det->c[1], det->size); + printf("detection %3d: id %-4d\n cx %f cy %f size %d\n", i, det->id, det->c[0], det->c[1], det->size); // int size = sqrt((det->p[0][0] - det->p[1][0])*(det->p[0][0] - det->p[1][0]) + (det->p[0][1] - det->p[1][1])*(det->p[0][1] - det->p[1][1])); int size = det->size; @@ -154,5 +156,5 @@ namespace eval ::BlobDetect { return result; } - apc compile + $cc compile } From 853b8a4bf328d5bc42d94320814de27b5e64b400 Mon Sep 17 00:00:00 2001 From: RobF Date: Mon, 28 Apr 2025 14:59:10 +1200 Subject: [PATCH 26/35] renable laser.folk --- virtual-programs/laser.folk | 2 -- 1 file changed, 2 deletions(-) diff --git a/virtual-programs/laser.folk b/virtual-programs/laser.folk index 712312cd..63d6053a 100644 --- a/virtual-programs/laser.folk +++ b/virtual-programs/laser.folk @@ -1,5 +1,3 @@ -return - source vendor/blobdetect/blobdetect.tcl When camera /any/ has frame /grayFrame/ at timestamp /timestamp/ { From ef39fc059bbc0239633aecef75e0890d89b52845 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andr=C3=A9s=20Cuervo?= Date: Tue, 29 Apr 2025 13:55:34 -0400 Subject: [PATCH 27/35] Add overridable angle to text wishes --- virtual-programs/shapes.folk | 21 ++++++++++++++++----- 1 file changed, 16 insertions(+), 5 deletions(-) diff --git a/virtual-programs/shapes.folk b/virtual-programs/shapes.folk index ed3142a3..7e906842 100644 --- a/virtual-programs/shapes.folk +++ b/virtual-programs/shapes.folk @@ -143,15 +143,26 @@ When /someone/ wishes /p/ draws an /shape/ { When /someone/ wishes /p/ draws text /text/ with /...options/ & /p/ has region /r/ { # As shapes.folk but for text. lassign [region centroid $r] cx cy - set angle [region angle $r] + set pageAngle [region angle $r] - set color [dict_getdef $options color white] - set scale [dict_getdef $options scale 1.0] - set layer [dict_getdef $options layer 0] + # Use the page's angle unless explicitly overwritten + set defaults [dict create \ + color white \ + scale 1.0 \ + layer 0 \ + angle $pageAngle \ + ] + + set options [dict merge $defaults $options] + + set color [dict get $options color] + set scale [dict get $options scale] + set layer [dict get $options layer] + set angle [dict get $options angle] set offset [dict_getdef $options offset {0 0}] set offset [::process_offset $offset $r] - set center [vec2 add [list $cx $cy] [vec2 rotate $offset $angle]] + set center [vec2 add [list $cx $cy] [vec2 rotate $offset $pageAngle]] Wish to draw text with position $center scale $scale text $text color $color radians $angle } From e81a2a5daf6c2586661ea49cc122f5215779e0ca Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andr=C3=A9s=20Cuervo?= Date: Wed, 30 Apr 2025 15:20:11 -0400 Subject: [PATCH 28/35] Use options dictionary defaults strategy --- virtual-programs/shapes/region.folk | 23 +++++++++++++++-------- 1 file changed, 15 insertions(+), 8 deletions(-) diff --git a/virtual-programs/shapes/region.folk b/virtual-programs/shapes/region.folk index 5666974e..47b4c367 100644 --- a/virtual-programs/shapes/region.folk +++ b/virtual-programs/shapes/region.folk @@ -1,14 +1,22 @@ -# Creates a id "${p}:${index}" and assigns region. +# Creates an id "${p}:${index}" and assigns region. # Extra regions can be used to create sensitive areas other pages can collect. When /someone/ wishes /p/ adds region with /...options/ & /p/ has region /r/ { lassign [region centroid $r] cx cy set angle [region angle $r] - set index [dict_getdef $options index 0] - set height [dict_getdef $options height 55] - set width [dict_getdef $options width 55] - set highlight [dict_getdef $options highlight false] - set color [dict_getdef $options color red] + set defaults { + index 0 \ + height 55 \ + width 55 \ + highlight false \ + color red \ + } + + set index [dict get $options index] + set height [dict get $options height] + set width [dict get $options width] + set highlight [dict get $options highlight] + set color [dict get $options color] set offset [dict_getdef $options offset {0 0}] set offset [::process_offset $offset $r] @@ -34,7 +42,7 @@ When /someone/ wishes /p/ adds region with /...options/ & /p/ has region /r/ { if {$i > 0} { lappend edges [list [expr {$i - 1}] $i] } } lappend edges [list [expr {[llength $tablePoints] - 1}] [lindex $tablePoints 0]] - + # Create new region in table points set indexedRegion [region create $tablePoints $edges $angle] Claim $p has indexedRegion with index $index region $indexedRegion @@ -64,7 +72,6 @@ When /someone/ wishes region /r/ has highlight /highlighted/ with /...options/ { } Claim $this has demo { - # How to use # When virtual-programs/shapes/region.folk has demo /code/ & \ # $this has region /r/ { From 65b154e2c0fd686f1e6663eda4cc8febf9af59c7 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andr=C3=A9s=20Cuervo?= Date: Thu, 1 May 2025 12:05:40 -0400 Subject: [PATCH 29/35] Update /keyboards layout --- virtual-programs/web/web-keyboards.folk | 32 +++++++++++++++++++++---- 1 file changed, 27 insertions(+), 5 deletions(-) diff --git a/virtual-programs/web/web-keyboards.folk b/virtual-programs/web/web-keyboards.folk index 3c4867fb..08c5355b 100644 --- a/virtual-programs/web/web-keyboards.folk +++ b/virtual-programs/web/web-keyboards.folk @@ -3,15 +3,37 @@ When the keyboards are /keyboards/ { upvar ^html ^html html [subst { + + + Status
[join [lmap kb $keyboards { subst { -
$kb
-
-
- -
+
+
$kb
+
+ Keys typed: +
+
+ +
+
} }] "\n"]
From 937f4f02077707fb6fb837dd345cd35e4f17c54e Mon Sep 17 00:00:00 2001 From: Omar Rizwan Date: Thu, 1 May 2025 15:59:56 -0400 Subject: [PATCH 30/35] laser: Disable laser blob detection by default --- virtual-programs/laser.folk | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/virtual-programs/laser.folk b/virtual-programs/laser.folk index 63d6053a..8d69d1cb 100644 --- a/virtual-programs/laser.folk +++ b/virtual-programs/laser.folk @@ -1,6 +1,7 @@ source vendor/blobdetect/blobdetect.tcl -When camera /any/ has frame /grayFrame/ at timestamp /timestamp/ { +When /someone/ wishes to detect laser blobs &\ + camera /any/ has frame /grayFrame/ at timestamp /timestamp/ { set blobTime [time { set threshold 250 set blobs [::BlobDetect::detect $grayFrame $threshold] From f7bd9c064c028435cdcbc69f5867fc4bba102fed Mon Sep 17 00:00:00 2001 From: Daniel Pipkin Date: Sat, 3 May 2025 09:38:51 -0600 Subject: [PATCH 31/35] fix esc-pos geom file --- virtual-programs/esc-pos.folk | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/virtual-programs/esc-pos.folk b/virtual-programs/esc-pos.folk index cc9f9bed..850df99e 100644 --- a/virtual-programs/esc-pos.folk +++ b/virtual-programs/esc-pos.folk @@ -49,7 +49,7 @@ namespace eval escpos { if {![dict exists $matchDict geometry]} { return } set geometry [dict get $matchDict geometry] set metaFile [open "$::env(HOME)/folk-printed-programs/$id.meta.folk" w] - puts $metaFile [subst -novariables {Claim tag $this has geometry {[read $fd]}}] + puts $metaFile [subst {Claim tag \$this has geometry $geometry}] close $metaFile } From 39d9c6b6f6045420835b7cd84efac6d3990d8238 Mon Sep 17 00:00:00 2001 From: Daniel Pipkin Date: Sat, 3 May 2025 11:15:45 -0600 Subject: [PATCH 32/35] Wrap geom in braces --- virtual-programs/esc-pos.folk | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/virtual-programs/esc-pos.folk b/virtual-programs/esc-pos.folk index 850df99e..64d87f9c 100644 --- a/virtual-programs/esc-pos.folk +++ b/virtual-programs/esc-pos.folk @@ -49,7 +49,7 @@ namespace eval escpos { if {![dict exists $matchDict geometry]} { return } set geometry [dict get $matchDict geometry] set metaFile [open "$::env(HOME)/folk-printed-programs/$id.meta.folk" w] - puts $metaFile [subst {Claim tag \$this has geometry $geometry}] + puts $metaFile [subst {Claim tag \$this has geometry {$geometry}}] close $metaFile } From bcf097d55d77b2dce1010b93925a219a213af909 Mon Sep 17 00:00:00 2001 From: Mason Jones <20848827+smj-edison@users.noreply.github.com> Date: Mon, 12 May 2025 14:15:22 -0700 Subject: [PATCH 33/35] Add anchor option to relative text --- virtual-programs/shapes.folk | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/virtual-programs/shapes.folk b/virtual-programs/shapes.folk index 7e906842..c81baa8d 100644 --- a/virtual-programs/shapes.folk +++ b/virtual-programs/shapes.folk @@ -151,6 +151,7 @@ When /someone/ wishes /p/ draws text /text/ with /...options/ & /p/ has region / scale 1.0 \ layer 0 \ angle $pageAngle \ + anchor center ] set options [dict merge $defaults $options] @@ -159,12 +160,14 @@ When /someone/ wishes /p/ draws text /text/ with /...options/ & /p/ has region / set scale [dict get $options scale] set layer [dict get $options layer] set angle [dict get $options angle] + set anchor [dict get $options anchor] set offset [dict_getdef $options offset {0 0}] set offset [::process_offset $offset $r] set center [vec2 add [list $cx $cy] [vec2 rotate $offset $pageAngle]] - Wish to draw text with position $center scale $scale text $text color $color radians $angle + Wish to draw text with position $center scale $scale text $text\ + color $color radians $angle anchor $anchor } When /someone/ wishes /p/ draws a /shape/ with /...options/ & /p/ has region /r/ { From 61a9e5aad8fb974fe2af378ef637074240c12738 Mon Sep 17 00:00:00 2001 From: Mason Jones <20848827+smj-edison@users.noreply.github.com> Date: Mon, 12 May 2025 23:13:27 -0700 Subject: [PATCH 34/35] Also add font as a parameter --- virtual-programs/shapes.folk | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/virtual-programs/shapes.folk b/virtual-programs/shapes.folk index c81baa8d..7cd932cb 100644 --- a/virtual-programs/shapes.folk +++ b/virtual-programs/shapes.folk @@ -151,7 +151,8 @@ When /someone/ wishes /p/ draws text /text/ with /...options/ & /p/ has region / scale 1.0 \ layer 0 \ angle $pageAngle \ - anchor center + anchor center \ + font "PTSans-Regular" ] set options [dict merge $defaults $options] @@ -161,13 +162,14 @@ When /someone/ wishes /p/ draws text /text/ with /...options/ & /p/ has region / set layer [dict get $options layer] set angle [dict get $options angle] set anchor [dict get $options anchor] + set font [dict get $options font] set offset [dict_getdef $options offset {0 0}] set offset [::process_offset $offset $r] set center [vec2 add [list $cx $cy] [vec2 rotate $offset $pageAngle]] Wish to draw text with position $center scale $scale text $text\ - color $color radians $angle anchor $anchor + color $color radians $angle anchor $anchor font $font } When /someone/ wishes /p/ draws a /shape/ with /...options/ & /p/ has region /r/ { From 3e17eae49a13179af049c750fd8d655a66918125 Mon Sep 17 00:00:00 2001 From: Daniel Pipkin Date: Thu, 15 May 2025 13:43:16 -0600 Subject: [PATCH 35/35] Change default size for reciept printer --- virtual-programs/esc-pos.folk | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/virtual-programs/esc-pos.folk b/virtual-programs/esc-pos.folk index 64d87f9c..c832978d 100644 --- a/virtual-programs/esc-pos.folk +++ b/virtual-programs/esc-pos.folk @@ -84,7 +84,8 @@ namespace eval escpos { return $tagBits } - proc tag {id {scale 20}} { + # scale must be divisible by 4 so width will be divisible by 8 + proc tag {id {scale 12}} { set tagImage [::tagImageForId $id] set tagBits [scaledAprilTag $id $scale]