Turtleshell

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)

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 <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.

Above Code Not Changed by me

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