console hide
 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 label rtree
        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 label  s {
         $data(c) create text $data(x) $data(y) \
                 -text $s -anchor nw -fill $data(fg)
        }
        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}}
#--------------------------------------------------------------------------------
 proc configure_event {w} {
     set ratio [format "%0.2f" [expr [winfo screenmmwidth $w].0 / [winfo screenmmheight $w].0]]
     wm title . "Turtleshell! Screen Ratio: $ratio"
     if 0 {
     if {$ratio > 1} {
        label "This is better in vertical mode..."
     }
     }
 }


proc turtleshell {} {
     wm title . "Turtleshell!"
     
     pack [entry .e -textvariable ::entrycmd] -fill x -side bottom
     #pack [entry .e -textvariable ::entrycmd] -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 ""
         .g.speak configure -state disable
     }
    bind .e <Up>   {history:move -1}
    bind .e <Down> {history:move 1}
    bind .e <Next> {history:move 99999}

    if 1 {
     pack [text .t -width 50 -height 5 -bg gray80] -side bottom -fill x
     .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, + a few known from Logo:
     fd bk rt lt pu pd home setpc setbg...
     Enjoy!
     "
     }
     frame .f
     frame .g
     foreach i {cs home} {
         button .f.$i -text $i -command $i -width 4 -height 3 -pady 0
     }
     
     foreach i {red orange yellow green1 green3 blue purple white} {
         button .f.$i -background $i -width 2 -height 3 -pady 0 -command "setpc $i"
         bind   .f.$i <3> "setbg $i"
     }
     
     button .g.speak -text speak -command {borg speak [.t get 1.0 end]}
     button .g.exit -text "Exit" -command {exit}
     label .g.lblDemo -text "Select Demo:"
     tk_optionMenu .g.demo cual 0 1 2 3 4 5
     button .g.runDemo -text "Run Demo" -command {demo $cual}
     
     button .g.load -text Load... -command {source [tk_getOpenFile]}
     
     eval pack [winfo children .f] -side left -fill x
     eval pack [winfo children .g] -side left -fill x
     
     pack .g -side bottom -pady 5
     pack .f -side bottom -pady 5

     canvas .c -bg black -width 200 -height 360 \
             -scrollregion {-100 -100 180 180}
     pack .c -fill both -expand 1 -side top
     #pack .c -side top
     #pack .c -fill both -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)}


     #wm attributes . -fullscreen 1
     #label .l -textvariable ::conf
     #pack .l -side top -fill both -expand 1
     bind . <Configure> {configure_event %W}

     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
     #. configure -width 4.5i
 }
 proc demo {cual} {
     set it [lindex $::Turtle::demos $cual]
     .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