Another weekend fun project by Richard Suchenwirth 2000-12 -- I dug out my old LOGO book from 1986 (DR Logo on CP/M) and finally made an old wish come true: to reimplement their turtle graphics - in Tcl of course.
LOGO (Seymour Papert, MIT 1967 [L1 ]) is still somehow popular as an educational programming language. My impression was "a stripped-down Lisp with much less parens" - that's one reason why I liked it then. In contrast to most other languages (except Forth), statements are not strictly separated but can be strung together on one line, e.g. to draw a circle (the most intuitive way I've ever seen):
repeat 360 [rt 1 fd 1]
where repeat, rt and fd are commands that take up as many arguments to their right as they need. This feature could easily be approximated in Tcl: each exported proc takes an additional args and evals that in the end. This functionality is wrapped into the to command which differs in syntax from Logo's but likewise gives an impression how simple The turtle commands are mostly two-letter abbreviations:
bk - move back (n pixels) cs - clear screen fd - move forward (n pixels, drawing a line if pen is down) home - move turtle to (0,0) ht - hide turtle (a triangular cursor indicating drawing direction) lt - left turn (in degrees) pd - pen down pu - pen up rt - right turn (in degrees) st - show turtle
I first tried to draw the turtle as a triangle myself, but soon found that Tcl's arrowhead on a line item does that faster and easier. The color and palette treatment was simplified - just use setpc/setbg with a color name for foreground/background. (In old Logo, you could use up to 4 palettes - one color each - with RGB values between 0 and 2...)
The story continues at Turtleshell...
namespace eval Turtle {
variable data
proc Init canvas {
variable data
array set data {x 0.0 y 0.0 h 0.0 pen down fg blue show 1}
set data(c) $canvas
cs
uplevel 1 namespace import -force ::Turtle::*
}
proc Show? {} {
variable data
update idletasks
$data(c) delete withtag turtle
if !$data(show) return
set h1 [expr {atan(1.)*8*$data(h)/360.}]
set x1 [expr {$data(x)+10*sin($h1)}]
set y1 [expr {$data(y)-10*cos($h1)}]
$data(c) create line $data(x) $data(y) $x1 $y1 -arrow last \
-arrowshape {10 10 3} -tag turtle -fill $data(fg)
}
proc to {name argl body} {
set body "variable data; $body; Show?; eval \$args"
proc $name [lappend argl args] $body
}
namespace export -clear bk clean cs fd home ht lt pd pu rt \
setbg seth setpc setpos setx sety st to
to bk n {fd -$n}
to clean {} {$data(c) delete all}
to cs {} {clean; home; pd}
to fd n {
set h1 [expr {atan(1.)*8*$data(h)/360.}]
set x1 [expr {$data(x)+$n*sin($h1)}]
set y1 [expr {$data(y)-$n*cos($h1)}]
if {$data(pen)=="down"} {
$data(c) create line $data(x) $data(y) $x1 $y1 -fill $data(fg)
}
set data(x) $x1
set data(y) $y1
}
to home {} {array set data {x 0.0 y 0.0 h 0.0}}
to ht {} {set data(show) 0}
to lt d {rt -$d}
to pd {} {set data(pen) down}
to pu {} {set data(pen) up}
to rt d {set data(h) [expr {$data(h)+$d}]}
to setbg col {$data(c) config -bg $col}
to setpc col {set data(fg) $col}
to setpos {X Y} {set data(x) $X; set data(y) $Y}
to seth val {set data(h) $val}
to setx val {set data(x) $val}
to sety val {set data(y) $val}
to st {} {set data(show) 1}
to rtree s {
if $s<5 return
fd $s
lt 30 rtree [expr $s*([random 5]+5)/10]
rt 60 rtree [expr $s*([random 5]+5)/10]
lt 30 bk $s
}
##---------------- add working and nice-looking demo code here!
variable demos {
{
setpc yellow; repeat 90 {fd 100 bk 100 rt 4}
setpc blue; repeat 90 {fd 30 bk 30 rt 4}
}
{setpc yellow web 30 setpc orange web 50 setpc red web 75}
{repeat 360 {
setpc [random:select [colors]] fd 100 bk 100 lt 1}
}
{
seth [random 360]; set n [expr [random 100]+100];
repeat $n {fd $n; rt 90; incr n -1}
}
{pu bk 100 pd rtree [expr [random 50]+25]}
{set n 100; repeat 100 {fd [incr n -2] rt 89}}
}
} ;#-------------------------- end namespace Turtle
proc colors {} {
list red orange yellow green1 green3 blue purple black white
}
proc random n {expr {round($n*rand())}}
proc random:select {list} {
lindex $list [expr int(rand()*[llength $list])]
}
proc repeat {n body} {while {$n} {incr n -1; uplevel $body}}Note how Tcl's and Logo's simplicities merge in the following demo code (not needed for Turtleshell), enhanced by a random tree ...
proc turtletest {} {
pack [canvas .c] -fill both -expand 1
update
Turtle::Init .c
repeat 4 {rt 90 fd 50}
seth 90 setx 100
foreach i {red green black blue orange} {
setpc $i pu fd 10 pd repeat 180 {fd 1 rt 2}
}
pu seth 180 fd 160 pd
to square s {repeat 4 {fd $s rt 90}}
to web s {repeat 36 {square $s rt 10}}
to facet {x y z} {web $x web $y web $z}
ht setbg black facet 30 40 70
setpos 300 250 seth 0 setpc red rtree 60
}
turtletestFor a more elaborate demo (in fact, a usable interactive program) see Turtleshell.
RM: Here is a different implementation of repeat
to repeat {n body} {while {$n} {uplevel 1 $body; incr n -1}}It allows LOGO code to be placed behind a repeat statement.
repeat 4 {fd 100 repeat 6 {fd 50 rt 60} bk 100 rt 90}RS: Good suggestion - the freedom introduced by the to commands is of course not backpropagated to all Tcl commands. My idea was, since a numbered repeat is useful in other situations as well, to keep it independent from turtle updates etc. A compromise would be
proc repeat {n body args} {
while {$n} {incr n -1; uplevel 1 $body}
uplevel 1 $args
}RM:
This version of to allows custom commands that can be called without qualifying them with Turtle::
namespace eval Turtle {
...
proc to {name argl body} {
set body "variable data; $body; Show?; eval \$args"
proc $name [lappend argl args] $body
namespace export $name
catch {uplevel 1 namespace import [namespace current]::$name}
}
namespace export -clear to
...
}RS: Great, thank you! I've also got something new, Logo's label command:
to label s {
$data(c) create text $data(x) $data(y) \
-text $s -anchor nw -fill $data(fg)
}Only in Logo the writing direction is determined by turtle heading - I don't see a way to do that on a Tcl canvas at present...
See also Geometrical constructions