diff options
| author | Andrés Cuervo <acwervo@gmail.com> | 2023-04-03 17:17:40 +0000 |
|---|---|---|
| committer | Andrés Cuervo <acwervo@gmail.com> | 2023-04-03 17:17:40 +0000 |
| commit | c7f6843ea2dfe31dbd4e3edfd09e5ad230e2af24 (patch) | |
| tree | a1bcdd59369fda699e23b15580da375b4b355e49 | |
| parent | Document negation and non-capturing (diff) | |
| download | folk-c7f6843ea2dfe31dbd4e3edfd09e5ad230e2af24.tar.gz folk-c7f6843ea2dfe31dbd4e3edfd09e5ad230e2af24.zip | |
Add circle to pi Display, center shapes correctly
| -rw-r--r-- | pi/pi.tcl | 4 | ||||
| -rw-r--r-- | play/Example_Domain.html | 46 | ||||
| -rw-r--r-- | play/wget.tcl | 35 | ||||
| -rw-r--r-- | virtual-programs/shapes.folk | 35 |
4 files changed, 105 insertions, 15 deletions
@@ -21,6 +21,10 @@ namespace eval Display { uplevel [list Wish display runs [list Display::stroke $points $width $color]] } + proc circle {x y radius thickness color} { + uplevel [list Wish display runs [list Display::circle $x $y $radius $thickness $color]] + } + proc text {fb x y fontSize text {radians 0}} { uplevel [list Wish display runs [list Display::text $fb $x $y $fontSize $text $radians]] } diff --git a/play/Example_Domain.html b/play/Example_Domain.html new file mode 100644 index 00000000..5a9b52fc --- /dev/null +++ b/play/Example_Domain.html @@ -0,0 +1,46 @@ +<!doctype html> +<html> +<head> + <title>Example Domain</title> + + <meta charset="utf-8" /> + <meta http-equiv="Content-type" content="text/html; charset=utf-8" /> + <meta name="viewport" content="width=device-width, initial-scale=1" /> + <style type="text/css"> + body { + background-color: #f0f0f2; + margin: 0; + padding: 0; + font-family: -apple-system, system-ui, BlinkMacSystemFont, "Segoe UI", "Open Sans", "Helvetica Neue", Helvetica, Arial, sans-serif; + + } + div { + width: 600px; + margin: 5em auto; + padding: 2em; + background-color: #fdfdff; + border-radius: 0.5em; + box-shadow: 2px 3px 7px 2px rgba(0,0,0,0.02); + } + a:link, a:visited { + color: #38488f; + text-decoration: none; + } + @media (max-width: 700px) { + div { + margin: 0 auto; + width: auto; + } + } + </style> +</head> + +<body> +<div> + <h1>Example Domain</h1> + <p>This domain is for use in illustrative examples in documents. You may use this + domain in literature without prior coordination or asking for permission.</p> + <p><a href="https://www.iana.org/domains/example">More information...</a></p> +</div> +</body> +</html> diff --git a/play/wget.tcl b/play/wget.tcl new file mode 100644 index 00000000..65e03076 --- /dev/null +++ b/play/wget.tcl @@ -0,0 +1,35 @@ +if {0} { + example syntax: Wish $this downloads "URL" + + When someone wishes for a page to be downloaded we check to see if there's + $title.html in the current directory. If there is, we don't download it. + + If there isn't, we download the page and save it as $title.html +} + + +# proc called findTitle that searches a string of HTML for the title using regexp and returns the text of the title +proc findTitle {webpage} { + set title [regexp -inline -all -line -lineanchor {<title>(.*)</title>} $webpage] + return [lindex $title 1] +} + +# proc called getWebpage that takes a URL, uses exec & wget to print out the content as a string +proc getWebpage {URL} { + set webpage [exec wget -q -O - $URL] + return $webpage +} + +# proc called download that takes a URL, uses getWebpage to download the content to a file +proc download {URL} { + set webpage [getWebpage $URL] + set title [string map {" " "_"} [findTitle $webpage]] + puts "title: $title" + puts "writing to file $title.html" + set file [open $title.html w] + puts $file $webpage + close $file +} + +# this works! downloads example.com to Example_Domain.html +download example.com
\ No newline at end of file diff --git a/virtual-programs/shapes.folk b/virtual-programs/shapes.folk index 176f765b..f5bbaf41 100644 --- a/virtual-programs/shapes.folk +++ b/virtual-programs/shapes.folk @@ -40,11 +40,10 @@ proc regionToInnerRect {region} { lassign $vertices a b c d lassign $a aX aY lassign $c cX cY - set shrinkConstant 0.65 - set width [expr {($cX - $aX) * $shrinkConstant}] - set height [expr {($cY - $aY) * $shrinkConstant}] - set x [expr {$aX + $width * 0.25}] - set y [expr {$aY + $height * 0.25}] + set width [expr {($cX - $aX)}] + set height [expr {($cY - $aY)}] + set x [expr {$aX + $width * 0.5}] + set y [expr {$aY + $height * 0.5}] return [list $x $y $width $height] } @@ -53,7 +52,7 @@ proc regionToInnerRect {region} { # numPoints 2 => line # numPoints 3 => triangle # numPoints 4 => square -proc shape {numPoints x y r {color white} args} { +proc shape {numPoints x y r {color white} {filled false} args} { set start [list $x $y] set points [list $start] set i 0 @@ -64,13 +63,18 @@ proc shape {numPoints x y r {color white} args} { set y [expr {$y + $r * sin($angle)}] lappend points [list $x $y] } - polyline $points 5 $color + if {$filled} { + polyline $points 5 $color + } else { + polyline $points 10 $color + } } When /someone/ wishes /p/ draws a /color/ /shape/ offset /offsetVector/ & /p/ has region /r/ { lassign [regionToInnerRect $r] x y width height lassign $offsetVector offsetX offsetY - + + set filled false if {$offsetX != 0} { set x [expr {$x + $offsetX}] } @@ -81,21 +85,22 @@ When /someone/ wishes /p/ draws a /color/ /shape/ offset /offsetVector/ & /p/ ha puts "drawing $shape at $x $y" set adjustedWidth [expr {$width * 0.25}] - set x [expr { $x * 1.3}] - set y [expr { $y * 1.25}] + set x [expr { $x + $offsetX}] + set y [expr { $y + $offsetY}] + switch -nocase $shape { triangle { - shape 3 $x $y $adjustedWidth $color + shape 3 $x $y $adjustedWidth $color $filled } square { - shape 4 $x $y $adjustedWidth $color + shape 4 $x $y $adjustedWidth $color $filled } # TODO: cwervo - fix magic numbers here circle { - shape 10 [expr {$x * 0.98}] $y [expr {$adjustedWidth * 0.4}] $color + shape 10 [expr {$x * 0.98}] $y [expr {$adjustedWidth * 0.4}] $color $filled } default { - shape 5 $x $y $adjustedWidth $color + shape 5 $x $y $adjustedWidth $color $filled } } } @@ -112,4 +117,4 @@ When /someone/ wishes /p/ draws a /shape/ offset /offsetVector/ { Wish $p draws a white $shape offset $offsetVector } -# --- TODO: Wish table has ... ----
\ No newline at end of file +# --- TODO: Wish table has ... ---- |