JM 3/21/2014, Here is the
Turtleshell with minor modifications to WOAW (Works On
AndroWish)...
- Works for me in vertical mode
- added a file selection dialog to source your scripts you may construct with Jota+
- It is nice to play with
- As my device is slow, I changed the way you see the demos: select a number, then click "Run Demo"
- The original Welcome message from RS...now spoken! ;)
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
