Creating a Tk based logo?
Larry W. Virden
That is, it would present to the user a Logo interface (for the most part)
but implement it using Tk. Then, the user could extend the language by
using either logo or Tk...
--
:s
:s Larry W. Virden INET: lvi...@cas.org
:s Personal: 674 Falls Place, Reynoldsburg, OH 43068-1614
R James Noble
Has anyone considered creating a Tk based logo-alike program for X11?
This isn't quite what was asked for, but may still be of interest.
From the README:
This is a simple Logo-like turtle graphics package implemented in
Extended Tcl. It does not include any programming environment support,
everything must be done from the command line or sourced files as in
normal Tcl programming.
#! /bin/sh
# This is a shell archive. Remove anything before this line, then unpack
# it by saving it into a file and typing "sh file". To overwrite existing
# files, type "sh file -c". You can also feed this as standard input via
# unshar, or by typing "sh <file", e.g.. If this archive is complete, you
# will see the following message at the end:
# "End of shell archive."
# Contents: README turtle examples
# Wrapped by k...@turakirae.comp.vuw.ac.nz on Tue May 25 14:25:30 1993
PATH=/bin:/usr/bin:/usr/ucb ; export PATH
if test -f 'README' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'README'\"
else
echo shar: Extracting \"'README'\" \(4615 characters\)
sed "s/^X//" >'README' <<'END_OF_FILE'
XTkTurtle v1.0
X
XThis is a simple Logo-like turtle graphics package implemented in
XExtended Tcl. It does not include any programming environment support,
Xeverything must be done from the command line or sourced files as in
Xnormal Tcl programming. It needs Extended Tcl, mainly for the trig
Xfunctions. It's been a long time since I've used Logo, so the style
Xhere may be closer to the Smalltalk-80 Pen class, or the Lightspeed
XPascal turtle graphics libraries (which I used as references) than
Xreal Logo.
X
XTkTurtle works by making a canvas, and then defining Tcl procedures to
Xdisplay a turtle, and draw patterns. No C code is included in this
Xpackage (but, of course, it currently needs Extended Tcl). There is a
Xfair range of turtle commands supported, with the exception of real
Xcolour: the colour command currently uses stipple patterns. The use of
XEnglish, rather than American spellings (colour, centre) may be
Xconsidered a bug by some.
X
XThis has actually been used in anger, as part of a short course to
Xinterest high school students in computer science. It seems fairly
Xstable, but, of course, this is not warranted for anything :-)
X
XThe distribution consists of one file of code (turtle), a file of
Xexamples, and this short readme. There is no real documentation. You
Xare welcome to use this as you see fit, providing the usual credit is
Xgiven to the original author.
X
X
XCOMMANDS
X
Xturtle initialise the turtle library. This is the command
X that should be autoloaded, the other commands being
X loaded in the file as the package is invoked
X
Xgo <length> move the turtle <length> pixels
X - a line will be draw if the pen is down
X
X go 20
X
Xgoto <x> <y> move the turtle to the position specified
X
X - a line will be draw if the pen is down
X
X goto 0 0
X
Xwrite <text> prints the <text> as a string at the current position
X
X write "Hello John"
X
Xup put the pen up
X - the turtle will move without drawing
X
X up
X
Xdown put the pen down
X - the turtle will now draw lines
X
X down
X
Xturn <angle> turns the turtle <angle> degrees clockwise
X - if <angle> is negative, counterclockwise
X
X turn 90
X
Xnorth set the turtle's direction to north (270 degrees)
X
X north
X
Xturnto <angle> sets the turtle's direction to be <angle>
X
X turnto 175
X
Xwidth [<n>] with one argument (must be an integer)
X sets the width of lines the turtle will draw
X with no arguments, returns the current width
X
X width 3
X
Xcolour [<n>] with one argument (must be an integer)
X sets the pattern of lines the turtle will draw
X with no arguments, returns the current width
X
X colour 4
X
Xshow draws the turtle
X
X show
X
Xhide hides the turtle - the turtle will still leave a trace
X if it is down, but won't itself be displayed - makes
X things run faster.
X
X hide
X
Xhome move the turtle to the center and point it north
X
Xclear clear the screen, home the turtle, and reset colour
X and width information
X
Xscreen-dump <f> write a screen dump
X - with no arguments, to Screen-dump.ps
X - with one argument, to that filename
X
X
X
X
XEXTRA COMMANDS
X
Xmove same as go, goto, except the don't draw, and
Xmoveto don't change the turtle state.
X
Xsouth shortcuts for turnto 90, etc.
Xeast
Xwest
X
Xd2r converts degress to radians for calling the trig
X functions
X
Xdirection returns the turtle's direction
X
Xlocation returns a two-element list, the turtle's location
X
Xslow sets slow mode
Xfast sets fast mode
Xspeed [<bool>] like a ZX-81, fast mode doesn't update the screen
X after every movement.
X
Xpen [<bool>] with no arguments, returns the pen status
X with one argumenr of 0 or 1, sets the pen status
X
Xcentre centre the screen, not the turtle
X (use home to centre the turtle)
X
Xstatus [<s>] with no arguments, returns a six-element list
X containing turtle status
X with one argument of such a list, set status
X
X set saved [status] # save status
X status $saved # restore
X
Xwindow <wid> place a window onto the canvas at the current position
X
Xnew clear, and also remove any windows
X
X
X
XSHORTCUTS IN THE TURTLE WINDOW
X
XButton-2 drag-scroll the window
XC centre the window
XF toggle speed (slow mode/ fast mode)
XT toggle command tracing
XS toggle turtle display (hide/show)
XC-C, C-Q quit
X
X
XTO DO LIST
X
X* Vanilla Tcl version of TkTurtle
X* Programming environment (steal from wtour?)
X* Extension to multiple turtles and canvasses
X* Real colour support
X* Reorganise so it runs **faster**
X* Don't add a new line item for each drawn segment -
X collect line squences into large line items
X* fix it so everything worked in degrees (no need for d2r)
X
XSuggestion, comments, etc, are always apprecitated
X
XJames Noble
Xk...@comp.vuw.ac.nz
END_OF_FILE
if test 4615 -ne `wc -c <'README'`; then
echo shar: \"'README'\" unpacked with wrong size!
fi
# end of 'README'
fi
if test -f 'turtle' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'turtle'\"
else
echo shar: Extracting \"'turtle'\" \(7054 characters\)
sed "s/^X//" >'turtle' <<'END_OF_FILE'
X#!/usr/bin/X11/wishx -f
X#
X# TkTurtle v1.0
X#
X# turtle graphics demo for tk - needs exteneded Tcl for trig.
X#
X# Copyright 1993 James Noble, k...@comp.vuw.ac.nz
X#
X
Xset noAutoExec 1
X
X#initialise turtle
Xproc turtle {} {
X
X global turtle
X
X if [catch {set PI [expr "4 * [atan 1]"]}] {error "Needs Extended Wish"}
X
X set turtle(canvas) .c
X
X# colour
X set turtle(grey0) {}
X set turtle(grey1) {@/usr/include/X11/bitmaps/root_weave}
X set turtle(grey2) {@/usr/include/X11/bitmaps/stipple}
X set turtle(grey3) {@/usr/include/X11/bitmaps/gray1}
X set turtle(grey4) {@/usr/include/X11/bitmaps/boxes}
X set turtle(grey5) {@/usr/include/X11/bitmaps/hlines2}
X set turtle(grey6) {@/usr/include/X11/bitmaps/vlines2}
X set turtle(grey7) {@/usr/include/X11/bitmaps/cross_weave}
X set turtle(grey8) {@/usr/include/X11/bitmaps/light_gray}
X set turtle(grey9) {@/usr/include/X11/bitmaps/dimple1}
X set turtle(grey10) {@/usr/include/X11/bitmaps/vlines3}
X set turtle(grey11) {@/usr/include/X11/bitmaps/hlines3}
X set turtle(grey12) {@/usr/include/X11/bitmaps/grid4}
X set turtle(grey13) {@/usr/include/X11/bitmaps/gray3}
X set turtle(grey14) {@/usr/include/X11/bitmaps/dimple3}
X set turtle(grey15) {@/usr/include/X11/bitmaps/grid8}
X
X set turtle(num_colours) 16
X
X set turtle(d2r) [expr "180 / $PI"]
X
X# clear actually does this, plus draw-turtle
X set turtle(x) 0
X set turtle(y) 0
X set turtle(direction) 270
X set turtle(width) 0
X set turtle(colour) 0
X set turtle(pen) 1
X
X# debugging
X set turtle(speed) 1
X set turtle(show) 1
X
X if [winfo exists $turtle(canvas)] {new;return}
X
X scrollbar .v -relief sunken -borderwidth 3 \
X -command "$turtle(canvas) yview"
X
X scrollbar .h -relief sunken -borderwidth 3 \
X -orient horiz -command "$turtle(canvas) xview"
X
X canvas $turtle(canvas) -borderwidth 3 \
X -scrollregion {-1000 -1000 1000 1000} \
X -scrollincrement 10 \
X -xscroll ".h set" -yscroll ".v set" \
X -height 500 -width 500
X
X# centre
X $turtle(canvas) xview 75
X $turtle(canvas) yview 75
X
X pack append . \
X .h {bottom fillx} \
X .v {right filly} \
X $turtle(canvas) {expand fill}
X
X bind $turtle(canvas) <2> "$turtle(canvas) scan mark %x %y"
X bind $turtle(canvas) <B2-Motion> "$turtle(canvas) scan dragto %x %y"
X bind $turtle(canvas) <c> centre
X bind $turtle(canvas) <Control-c> "destroy ."
X bind $turtle(canvas) <Control-q> "destroy ."
X bind $turtle(canvas) <f> {toggle-speed}
X bind $turtle(canvas) <t> {toggle-cmdtrace}
X bind $turtle(canvas) <s> {toggle-show}
X
X focus .c
X
X wm minsize . 10 10
X wm title . Turtle
X wm iconname . Turtle
X wm iconbitmap . @/usr/include/X11/bitmaps/keyboard16
X
X draw-turtle
X return ""
X}
X
X# drawing
Xproc go {length} {
X global turtle
X set newx [expr "$turtle(x) +
X ([cos $turtle(direction)/$turtle(d2r)] * $length)"]
X set newy [expr "$turtle(y) +
X ([sin $turtle(direction)/$turtle(d2r)] * $length)"]
X goto $newx $newy
X expr $length
X}
X
Xproc goto {x y} {
X global turtle;
X if {$turtle(pen)} {
X $turtle(canvas) create line $turtle(x) $turtle(y) $x $y \
X -width $turtle(width) -stipple $turtle(grey$turtle(colour)) \
X -tags line
X }
X set turtle(x) $x
X set turtle(y) $y
X if {$turtle(show)} then {draw-turtle}
X if {$turtle(speed)} then {update}
X list $x $y
X}
X
X# writing text
Xproc write {text} {global turtle;
X $turtle(canvas) create text $turtle(x) $turtle(y) -text $text \
X -stipple $turtle(grey$turtle(colour)) \
X -tags text
X if {$turtle(speed)} then {update}
X }
X
X# writing windows
Xproc window {name} {global turtle;
X $turtle(canvas) create window $turtle(x) $turtle(y) \
X -window $name \
X -tags window
X update
X}
X
X##### drawing parameters
X# change pen state
Xproc pen {{p "q"}} {
X global turtle;
X if {$p == "q"} then {return $turtle(pen)} else {set turtle(pen) $p}
X}
Xproc down {} {global turtle; pen 1}
Xproc up {} {global turtle; pen 0}
X
X# change direction
Xproc turn {n} {
X global turtle;
X turnto [expr "$turtle(direction) + $n"]
X}
Xproc turnto {n} {
X global turtle;
X set turtle(direction) [fmod $n 360]
X draw-turtle
X return $turtle(direction)
X}
Xproc east {} {turnto 0}
Xproc south {} {turnto 90}
Xproc west {} {turnto 180}
Xproc north {} {turnto 270}
X
Xproc direction {} {global turtle; expr $turtle(direction)}
Xproc location {} {global turtle; list $turtle(x) $turtle(y)}
X
Xproc width {{w "q"}} {
X global turtle;
X if {$w != "q"} then {
X set turtle(width) $w; draw-turtle}
X return $turtle(width)
X}
Xproc colour {{c "q"}} {
X global turtle;
X if {$c == "q"} then {return $turtle(colour)} else {
X set turtle(colour) [expr "$c % $turtle(num_colours)"]}
X}
X
Xproc status {{c "q"}} {
X global turtle;
X if {$c == "q"} then {
X return [list $turtle(x) $turtle(y) $turtle(direction) \
X $turtle(width) $turtle(colour) $turtle(pen)]
X } else {
X if {[llength $c] != 6} then {error "Can't restore saved state"}
X set turtle(x) [lindex $c 0]
X set turtle(y) [lindex $c 1]
X set turtle(direction) [lindex $c 2]
X set turtle(width) [lindex $c 3]
X set turtle(colour) [lindex $c 4]
X set turtle(pen) [lindex $c 5]
X draw-turtle
X return $c
X }
X}
X
X
Xproc draw-turtle {} {
X global turtle
X if {$turtle(show)} {
X $turtle(canvas) delete turtle
X $turtle(canvas) create line \
X $turtle(x) $turtle(y) \
X [expr "$turtle(x) + \
X ([cos $turtle(direction)/$turtle(d2r)] * 10)"] \
X [expr "$turtle(y) + \
X ([sin $turtle(direction)/$turtle(d2r)] * 10)"] \
X -arrow last -tags turtle -width $turtle(width)
X }
X return 0
X}
Xproc show {} {global turtle; set turtle(show) 1; draw-turtle; return 1}
Xproc hide {} {global turtle; set turtle(show) 0;
X $turtle(canvas) delete turtle; return 0
X}
Xproc toggle-show {} {global turtle; if {$turtle(show)} hide show}
X
X# misc
Xproc home {} {global turtle;
X set turtle(x) 0; set turtle(y) 0; set turtle(direction) 270
X draw-turtle;
X}
Xproc clear {} {global turtle;
X home; down; width 0; colour 0;
X $turtle(canvas) delete line text
X draw-turtle;
X}
Xproc new {} {global turtle;
X clear;
X foreach w [$turtle(canvas) find withtag window] {
X catch {destroy [lindex [$turtle(canvas) itemconfigure $w -window] 4]}
X }
X $turtle(canvas) delete window
X}
Xproc screen-dump {{file Screen-dump.ps}} {
X global turtle;
X $turtle(canvas) postscript -file $file
X}
Xproc centre {} {
X global turtle;
X $turtle(canvas) xview 75
X $turtle(canvas) yview 75
X}
X
X#conversion
Xproc d2r {degrees} {
X global turtle;
X expr "$degrees/$turtle(d2r)"
X}
X
X# speed
Xproc speed {{s "q"}} {
X global turtle;
X if {$s == "q"} then {return $turtle(speed)} else {set turtle(speed) $s}
X}
Xproc slow {} {speed 1}
Xproc fast {} {speed 0}
Xproc toggle-speed {} {global turtle; if {$turtle(speed)} fast slow}
Xproc tron {} {cmdtrace on procs}
Xproc trall {} {cmdtrace on}
Xproc troff {} {cmdtrace off}
Xproc toggle-cmdtrace {} {if {[cmdtrace depth]} troff tron}
X
X# MACROS - move, moveto
Xproc move {distance} {
X set oldpen [pen]
X go $distance
X pen $oldpen
X}
X
Xproc moveto {x y} {
X set oldpen [pen]
X goto $x $y
X pen $oldpen
X}
X
X
X
X#start it all off
Xturtle
X
X
END_OF_FILE
if test 7054 -ne `wc -c <'turtle'`; then
echo shar: \"'turtle'\" unpacked with wrong size!
fi
chmod +x 'turtle'
# end of 'turtle'
fi
if test -f 'examples' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'examples'\"
else
echo shar: Extracting \"'examples'\" \(5749 characters\)
sed "s/^X//" >'examples' <<'END_OF_FILE'
X#!/usr/bin/X11/wishx -f
X#
X# examples for turtle demo, TkTurtle 1.0
X#
X# needs exteneded Tcl for trig, so I also used loop
X#
X# run "demo" for demo that shows of most examples
X#
X# Copyright 1993 James Noble, k...@comp.vuw.ac.nz
X#
X
X# polygon
Xproc polygon {n length} {
Xloop k 0 $n {
X turn [expr "360 / $n"]
X go $length
X }
X}
X
X# polygon, with a functional parameter
Xproc fungon {n length F} {
Xloop k 0 $n {
X turn [expr "360 / $n"]
X $F $length
X }
X}
X# like polygon, but takes a code block rather than function
Xproc clogon {n code} {
Xloop k 0 $n {
X turn [expr "360 / $n"]
X eval $code
X }
X}
X
X# Iterative Spiral
Xproc spiral {angle length} {
Xwhile {$length >= 1} {
X go $length
X turn $angle
X set length [expr "$length - 5"]
X }
X}
X
X# Recursive spiral
Xproc rspiral {angle length} {
Xif {$length >= 1} {
X go $length
X turn $angle
X rspiral $angle [expr "$length - 5"]
X }
X}
X
X# "Koch's" a single line - used in snowflake
Xproc koch {order length} {
Xif {($order <= 1) || ($length <= 1)} then {go $length} else {
X koch [expr "$order-1"] [expr "$length/3"]
X turn -60
X koch [expr "$order-1"] [expr "$length/3"]
X turn 120
X koch [expr "$order-1"] [expr "$length/3"]
X turn -60
X koch [expr "$order-1"] [expr "$length/3"]
X }
X}
X
X# Koch's snowflake fractal
Xproc kochflake {order length} {
Xloop k 0 3 {
X turn 120
X koch $order $length
X }
X}
X
X# tricky version of kochflake
Xproc tricky-kochflake {order length} {clogon 3 "koch $order $length"}
X
X# four sided koch
Xproc squarekoch {order length} {
Xif {($order <= 1) || ($length <= 1)} then {go $length} else {
X squarekoch [expr "$order-1"] [expr "$length/3"]
X turn -90
X squarekoch [expr "$order-1"] [expr "$length/3"]
X turn 90
X squarekoch [expr "$order-1"] [expr "$length/3"]
X turn 90
X squarekoch [expr "$order-1"] [expr "$length/3"]
X turn -90
X squarekoch [expr "$order-1"] [expr "$length/3"]
X }
X}
Xproc squareflake {order length} {clogon 4 "squarekoch $order $length"}
X
X# Fractal line
Xproc fracline {order angle length} {
X if {$order < 1} then {go $length} else {
X set ang [expr {[random [expr "(2 * $angle)"]] - $angle}]
X set len [expr "$length / (2 * [cos [d2r $ang]])"]
X turn $ang
X fracline [expr "$order - 1"] $angle $len
X turn [expr "- $ang * 2"]
X fracline [expr "$order - 1"] $angle $len
X turn $ang
X }
X}
X
X# binary tree
Xproc bintree {depth length angle} {
X if {$depth < 1} then {return}
X set saved [status]
X incr depth -1
X go $length
X turn [expr "- $angle"]
X bintree $depth $length $angle
X turn [expr "2 * $angle"]
X bintree $depth $length $angle
X status $saved
X}
X
X
X
X# C curve fractal
Xproc ccurv {order length} {
Xif {$order <= 1} then {go $length} else {
X ccurv [expr "$order - 1"] $length
X turn 90
X ccurv [expr "$order - 1"] $length
X turn -90
X }
X}
X
X# Dragon curve fractal
Xproc dragon {order length} {dragon-aux $order $length 90}
Xproc dragon-aux {order length dirn} {
Xif {$order <= 1} then {go $length} else {
X dragon-aux [expr "$order - 1"] $length 90
X turn $dirn
X dragon-aux [expr "$order - 1"] $length -90
X }
X}
X
X# Sierpinski's gasket
Xproc gasket {order length} {
Xif {$order > 0} then {
X loop k 0 3 {
X gasket [expr "$order - 1"] [expr "$length / 2"]
X go $length
X turn 120
X }
X }
X}
X
X# Sierpinski's carpet
Xproc carpet {order length} {
Xif {$order < 1} then {go $length} else {
X carpet [expr "$order - 1"] [expr "$length / 3"]
X turn -90
X carpet [expr "$order - 1"] [expr "$length / 3"]
X turn 90
X carpet [expr "$order - 1"] [expr "$length / 3"]
X turn 90
X carpet [expr "$order - 1"] [expr "$length / 3"]
X set saved [status]
X carpet [expr "$order - 1"] [expr "$length / 3"]
X turn 90
X carpet [expr "$order - 1"] [expr "$length / 3"]
X turn 90
X carpet [expr "$order - 1"] [expr "$length / 3"]
X status $saved
X turn -90
X carpet [expr "$order - 1"] [expr "$length / 3"]
X }
X}
X
X
X# "Bendy" - simple fractal (C curve variation)
Xproc bendy {order length} {if {$order < 1} then {go $length; return}
Xturn 30
Xbendy [expr "$order - 1"] [expr "$length / 2"]
Xturn -60
Xbendy [expr "$order - 1"] [expr "$length / 2"]
Xturn 30
X}
X
X# "Squigly" - simple fractal (C curve variation)
Xproc squigly {order length} {if {$order < 1} then {go $length; return}
Xturn 30
Xsquigly [expr "$order - 1"] [expr "$length / 4"]
Xturn -60
Xsquigly [expr "$order - 1"] [expr "$length / 2"]
Xturn 60
Xsquigly [expr "$order - 1"] [expr "$length / 4"]
Xturn -30
X}
X
X
Xproc randtree {depth length angle branch} {
X if {$depth < 1} then {return}
X set saved [status]
X incr depth -1
X go [expr "[random $length] + $length"]
X set thisbranch [random $branch]
X turn [expr "- ($angle * $thisbranch / 4)"]
X loop k 0 $thisbranch {
X turn [random $angle]
X randtree $depth $length $angle $branch
X }
X status $saved
X}
X
X
X
X
X#windows-demo
Xproc windows-demo {} {
X up
X goto -200 -200
X window [scale .scale]
X goto -150 -200
X window [button .spiral-button -text "Spiral" \
X -command {spiral {[.scale get]} 100}]
X goto -100 -200
X window [button .clear-button -text "Clear" -command clear]
X goto -50 -200
X window [button .home-button -text "Home" -command home]
X down
X .scale set 50
X home
X}
X
Xproc item {demo} {
X clear
X up
X goto 0 220
X down
X write $demo
X home
X eval $demo
X}
X
X
Xproc demo {} {
X item {loop k 3 12 {home; polygon $k 50}}
X item {loop k 0 16 {moveto 0 0; turn 22.5; width $k; go 200}}
X item {
X width 15
X loop k 0 16 {moveto 0 0; turn 22.5; colour $k; go 200}
X }
X item {spiral 50 100}
X item {rspiral 89 100}
X item {rspiral -90 100}
X item {kochflake 3 150}
X item {squareflake 3 150}
X item {squigly 4 200}
X item {fracline 6 40 200}
X item {ccurv 6 20}
X item {dragon 6 20}
X item {gasket 3 200}
X item {carpet 2 200}
X item {bintree 6 30 20}
X item {randtree 4 20 30 6}
X item {windows-demo}
X}
X
X# start turtle, if not running already already
Xturtle
X
END_OF_FILE
if test 5749 -ne `wc -c <'examples'`; then
echo shar: \"'examples'\" unpacked with wrong size!
fi
# end of 'examples'
fi
echo shar: End of shell archive.
exit 0
--
James Noble, Graduate Student, Computer Science Department
Victoria University, Box 600, Wellington 1, New Zealand
k...@comp.vuw.ac.nz