- 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)
proc turtleshell {} { wm title . Turtleshell! pack [entry .e -textvariable ::entrycmd] -fill x -side bottom bind .e <Return> { 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 <Up> {history:move -1} bind .e <Down> {history:move 1} bind .e <Next> {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 <ButtonPress-1> { 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 <B1-Motion> { eval [lappend %W(line) [%W canvasx %x] [%W canvasy %y]]} bind .c <ButtonRelease-1> {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 "
JM 3/21/2014, See an AndroWish friendly version at Turtle Shell for Androwish
Arts and crafts of Tcl-Tk programming