[Richard Suchenwirth] 2000-12-20 - Just in time for the merry season, here's my little gift to the Tcl community, Turtleshell: a small environment for playing with Tcl and [Turtle graphics the Logo way], featuring: * a canvas to draw on (turtle or freehand) * buttons for reset commands, and colorful ones for setting the pen color (right-click for background color) * a text widget that echoes commands and their results or errors, also in color * an entry widget to type in Tcl commands with a simple history mechanism (cursor up/down moves one line; page down moves to bottom) [WikiDbImage turtleshell.jpg] So this page doesn't get too crowded, here's the Turtleshell only. Copy, paste in the code from [Turtle graphics the Logo way] (minus the demo there), and you're set. Slightly tested on Sun/8.0.5, W95/8.1a2, and NT/8.2.3, no warranty, but merry Christmas... enjoy! ---- proc turtleshell {} { wm title . Turtleshell! pack [entry .e -textvariable ::entrycmd] -fill x -side bottom bind .e { history:add? $entrycmd .t insert end $entrycmd\n blue set tag {} if [catch {eval $entrycmd} res] {set tag red} .t insert end $res\n $tag .t see end set entrycmd "" } bind .e {history:move -1} bind .e {history:move 1} bind .e {history:move 99999} pack [text .t -height 5 -bg gray80] -fill x -side bottom .t tag configure red -foreground red .t tag configure blue -foreground blue .t insert end "Welcome to Turtleshell!" red .t insert end " (Richard Suchenwirth 2000) All Tcl/Tk commands welcome, plus a few known from Logo: fd bk rt lt pu pd home setpc setbg... Enjoy! " frame .f foreach i {cs home demo} { button .f.$i -text $i -command $i -width 4 -pady 0 } foreach i {red orange yellow green1 green3 blue purple black white} { button .f.$i -background $i -width 2 -pady 0 -command "setpc $i" bind .f.$i <3> "setbg $i" } eval pack [winfo children .f] -side left pack .f -side bottom -pady 5 -fill x canvas .c -bg black -width 400 -height 300 \ -scrollregion {-200 -150 200 150} pack .c -fill both -expand 1 -side top #-------------------------- Doodler bind .c { set X [%W canvasx %x] set Y [%W canvasy %y] set %W(line) [list %W coords [%W create line \ $X $Y $X $Y -fill $Turtle::data(fg)] $X $Y] } bind .c { eval [lappend %W(line) [%W canvasx %x] [%W canvasy %y]]} bind .c {unset %W(line)} update Turtle::Init .c to square s {repeat 4 {fd $s rt 90}} to web s {repeat 36 {square $s rt 10}} ht setpc yellow web 30 web 50 web 80 st focus .e } proc demo {{var ::entrycmd}} { set it [random:select $::Turtle::demos] .t insert end "Now playing:\n$it\n" .t see end-2c cs; ht; setpc [random:select [colors]] eval $it; st upvar $var wait if {$wait==""} {after 3000 demo} } #----------------------------- history for entry widget set history {}; set nhistory 0 proc history:add? {s} { if [string compare $s [lindex $::history end]] { lappend ::history $s set ::nhistory [llength $::history] } } proc history:move {where} { incr ::nhistory $where if {$::nhistory<0} {set ::nhistory 0} if {$::nhistory>=[llength $::history]+1} { set ::nhistory [llength $::history] } set ::entrycmd [lindex $::history $::nhistory] } turtleshell ---- 2000-12-21: added mouse-right colors background; doodler; demo mode (which ends after you write something into the entry widget, but can be restarted with the demo button). See also [An entry with a history] for a better-hidden version of the above. ---- [gold] 17Jul2010: Auxillary code for a help and exit button using the console show command (eTCL) Only change statement and additional code shown below. The help statements call and print on the console. namespace export -clear bk clean cs fd home ht lt pd pu rt \ setbg seth setpc setpos setx sety st help to to help {} {console show} foreach i {cs home demo exit help} { button .f.$i -text $i -command $i -width 4 -pady 0 } puts " 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 " ---- [Arts and crafts of Tcl-Tk programming] <> Graphics