- The commands are short
- You can draw in cartesian and polar coordinates
- You have a limited set of attributes to worry about
- By using relative drawing commands, you do not have to calculate the coordinates - just let the script worry about them.
AM (24 june 2003) I have started to improve the script below, with the suggestions from Peter Milne (notably the bounding box) and a new mode, "turtle", with accompanying commands modelled after LOGO's turtle graphics.The thing is becoming rather lengthy (mostly because of the comments, mind you, that head each proc), so probably the best way to distribute it, is as a starkit.For yet another example of what you can do with this little package: Daddy, how does a computer workAM (8 july 2003) Submitted the application as a starkit, with four different demos to choose from - including the fractions demo by Peter (slightly adjusted to fit the default screen). The starkit is called "plain_geometry", to emphasize that it deals with simple geometry in the (Euclidean) plane.See the sdarchive for the starkit.
See also Turtle graphics the LOGO way
AM (12 january 2005) This approach still makes it necessary to do all kinds of coordinate computations. I wanted to avoid that - it is tedious and error-prone. So, here is a quick alternative - Drawing geometrical objects
# constructions.tcl --
#
# Package providing tools for showing geometrical constructions
#
# Version information:
# version 0.1: initial implementation, december 2002
#
# Constructions --
# namespace to hold all specific variables and procedures
#
package require Tk
namespace eval ::Constructions {
variable mode "cartesian"
variable canvas .c
variable colour black
variable fillcolour black
variable textcolour black
variable textfont "Times 10"
variable delay 300
variable xcurr 0.0
variable ycurr 0.0
variable width 12.0
variable height 12.0
variable xmin
variable xmax
variable ymin
variable ymax
variable degtorad
set degtorad [expr {3.1415926/180.0}]
namespace export draw display moveto colour mode \
textfont textcolour erase
}
# mode --
# Set the coordinates mode (cartesian or polar)
#
# Arguments:
# type New mode
#
# Result:
# None
#
# Side effect:
# The interpretation of coordinate arguments is changed, if the
# type is a valid type. Otherwise it is left unchanged
#
proc ::Constructions::mode {type} {
variable mode
if { $type == "cartesian" || $type == "polar" } {
set mode $type
}
}
# textcolour --
# Set the colour for text
#
# Arguments:
# newcolour New colour to use
#
# Result:
# None
#
# Side effect:
# Set a new colour for subsequent text drawing actions
#
proc ::Constructions::textcolour {newcolour} {
variable textcolour
set textcolour $newcolour
}
# textfont --
# Set the font for text
#
# Arguments:
# newfont New font to use
#
# Result:
# None
#
# Side effect:
# Set a new font for subsequent text drawing actions
#
proc ::Constructions::textfont {newfont} {
variable textfont
set textfont $newfont
}
# colour --
# Set the current colour
#
# Arguments:
# newcolour New colour to be used for outlines
# newfill New colour to be used for filling (defaults to newcolour)
#
# Result:
# None
#
# Side effect:
# Set a new colour for subsequent drawing actions
#
proc ::Constructions::colour {newcolour {newfill "same"}} {
variable colour
variable fillcolour
set colour $newcolour
if { $newfill == "same" } {
set fillcolour $newcolour
} else {
set fillcolour $newfill
}
}
# moveto --
# Set the current coordinates
#
# Arguments:
# newx New x coordinate or distance from origin
# newy New y coordinate or angle to positive x-axis
#
# Result:
# None
#
# Side effect:
# Set a new "current" position for subsequent drawing actions
#
proc ::Constructions::moveto {newx newy} {
variable mode
variable xcurr
variable ycurr
variable degtorad
if { $mode == "cartesian" } {
set xcurr $newx
set ycurr $newy
} else {
set dist $newx
set angle $newy
set xcurr [expr {$dist*cos($angle*$degtorad)}]
set ycurr [expr {$dist*sin($angle*$degtorad)}]
}
}
# moverel --
# Move the current coordinates by the given vector
#
# Arguments:
# delx X coordinate of vector over which to move or distance
# dely Y coordinate or angle
#
# Result:
# None
#
# Side effect:
# Set a new "current" position for subsequent drawing actions
#
proc ::Constructions::moverel {delx dely} {
variable xcurr
variable ycurr
if { $mode == "cartesian" } {
set xcurr [expr {$xcurr+$delx}]
set ycurr [expr {$ycurr+$dely}]
} else {
set dist $delx
set angle $dely
set xcurr [expr {$xcurr+$dist*cos($angle*$degtorad)}]
set ycurr [expr {$ycurr+$dist*sin($angle*$degtorad)}]
}
}
# erase --
# Erase items from the canvas
#
# Arguments:
# tagorid Tag or ID of item(s) to erase
#
# Result:
# None
#
# Side effect:
# Removes items from the canvas
#
proc ::Constructions::erase {tagorid} {
variable canvas
$canvas delete $tagorid
}
# draw --
# Draw an object into the canvas
#
# Arguments:
# objtype Type of object
# args List of arguments, appropriate for type
#
# Result:
# ID of object that was created (or a specific tag)
#
proc ::Constructions::draw {objtype args} {
variable mode
variable xcurr
variable ycurr
variable xmin
variable xmax
variable ymin
variable ymax
variable canvas
variable degtorad
variable colour
variable fillcolour
variable textcolour
variable textfont
variable delay
variable go_on
switch -- $objtype {
"grid" {
for { set x $xmin } { $x < $xmax } { set x [expr {$x+1.0}] } {
$canvas create line ${x}c ${ymin}c ${x}c ${ymax}c -tag grid -fill gray
}
for { set y $ymin } { $y < $ymax } { set y [expr {$y+1.0}] } {
$canvas create line ${xmin}c ${y}c ${xmax}c ${y}c -tag grid -fill gray
}
$canvas move grid ${xmax}c ${ymax}c
return grid
}
"axes" {
$canvas create line ${xmin}c 0.0c ${xmax}c 0.0c -tag axes -fill black
$canvas create line 0.0c ${ymin}c 0.0c ${ymax}c -tag axes -fill black
$canvas move axes ${xmax}c ${ymax}c
return axes
}
"line" {
if { $mode == "cartesian" } {
set xp [lindex $args 0]
set yp [lindex $args 1]
set xcurr [lindex $args 2]
set ycurr [lindex $args 3]
} else {
set dist1 [lindex $args 0]
set angle1 [lindex $args 1]
set dist2 [lindex $args 2]
set angle2 [lindex $args 3]
set xp [expr {$dist1*cos($angle1*$degtorad)}]
set yp [expr {$dist1*sin($angle1*$degtorad)}]
set xcurr [expr {$dist2*cos($angle2*$degtorad)}]
set ycurr [expr {$dist2*sin($angle2*$degtorad)}]
}
set x1 "${xp}c"
set y1 "[expr {-$yp}]c"
set x2 "${xcurr}c"
set y2 "[expr {-$ycurr}]c"
set obj [\
$canvas create line $x1 $y1 $x2 $y2 -fill $colour]
}
"linerel" {
set x1 "${xcurr}c"
set y1 "[expr {-$ycurr}]c"
if { $mode == "cartesian" } {
set xcurr [lindex $args 0]
set ycurr [lindex $args 1]
} else {
set dist [lindex $args 0]
set angle [lindex $args 1]
set xcurr [expr {$xcurr+$dist*cos($angle*$degtorad)}]
set ycurr [expr {$ycurr+$dist*sin($angle*$degtorad)}]
}
set x2 "${xcurr}c"
set y2 "[expr {-$ycurr}]c"
set obj [\
$canvas create line $x1 $y1 $x2 $y2 -fill $colour]
}
"circle" -
"disc" {
set rad [lindex $args 0]
set x1 "[expr {$xcurr-$rad}]c"
set y1 "[expr {-$ycurr+$rad}]c"
set x2 "[expr {$xcurr+$rad}]c"
set y2 "[expr {-$ycurr-$rad}]c"
if { $objtype == "circle" } {
set fill {}
} else {
set fill $fillcolour
}
set obj [\
$canvas create oval $x1 $y1 $x2 $y2 -outline $colour -fill $fill]
}
"arc" -
"pie" {
set rad [lindex $args 0]
set start [lindex $args 1]
set stop [lindex $args 2]
set x1 "[expr {$xcurr-$rad}]c"
set y1 "[expr {-$ycurr+$rad}]c"
set x2 "[expr {$xcurr+$rad}]c"
set y2 "[expr {-$ycurr-$rad}]c"
if { $objtype == "arc" } {
set fill {}
set style arc
} else {
set fill $fillcolour
set style pie
}
set obj [\
$canvas create arc $x1 $y1 $x2 $y2 -outline $colour \
-start $start -extent [expr {$stop-$start}] \
-style $style -fill $fill]
}
"text" {
set x1 "${xcurr}c"
set y1 "[expr {-$ycurr}]c"
set text [lindex $args 0]
set obj [\
$canvas create text $x1 $y1 -text $text -fill $textcolour \
-font $textfont]
}
default {return {}}
}
#
# Move the newly created object to the centre of the window,
# that is, correct for the origin
#
$canvas move $obj ${xmax}c ${ymax}c
#
# Wait a while before returning - gives a nice animated effect
#
set go_on 0
after $delay {set ::Constructions::go_on 1}
vwait ::Constructions::go_on
return $obj
}
# display --
# Create the initial canvas
#
# Arguments:
# None
# Result:
# None
#
proc ::Constructions::display {} {
variable canvas
variable xmin
variable xmax
variable ymin
variable ymax
variable width
variable height
canvas $canvas -background white -width ${width}c -height ${height}c
pack $canvas -fill both
set xmin [expr {-$width/2.0}]
set xmax [expr {+$width/2.0}]
set ymin [expr {-$height/2.0}]
set ymax [expr {+$height/2.0}]
draw grid
draw axes
}# main --
# Main code
#
namespace import ::Constructions::*
if { 1 } {
display
moveto 0.0 5.5
textfont "Times 14"
draw text "Construct a hexagon"
#
# Reset the drawing position - all is relative
#
moveto 0.0 0.0
mode "polar"
colour "black"
draw circle 5.0
colour "red"
moveto 5.0 90
draw disc 0.1
draw arc 5.0 -90 -20
draw linerel 5.0 -30
draw disc 0.1
draw arc 5.0 -70 -100
draw linerel 5.0 -90
draw disc 0.1
draw arc 5.0 -130 -160
draw linerel 5.0 -150
draw disc 0.1
draw arc 5.0 -200 -223
draw linerel 5.0 -210
draw disc 0.1
draw arc 5.0 -263 -289
draw linerel 5.0 -270
draw disc 0.1
draw arc 5.0 -310 -335
draw linerel 5.0 -330
draw disc 0.1
}
if { 0 } {
mode "cartesian"
colour "black" "blue"
textcolour "black"
textfont "Times 20 bold"
display
erase axes
erase grid
moveto -3.5 3.5
draw pie 1.8 90.1 270 ;# Ugly drawing under Windows 98
moveto -4.0 0
draw text "1/2"
moveto -2.5 3.5
draw text "+"
moveto -2.5 0
draw text "+"
moveto 0.5 3.5
draw pie 1.8 90.1 270
moveto 0.0 0
draw text "1/2"
moveto 1.0 3.5
draw text "="
moveto 1.0 0
draw text "="
moveto 4.0 3.5
draw disc 1.8
moveto 4.0 0
draw text "1"
}Peter Milne [email protected] ( I hope you don't mind direct updates :-) ) It is a useful little toolkit, easy to write extended applications - I tried a short extension of the fractions picture. Biggest problem was maintaining the x-cursor - maybe the canvas can return its bounding rectangle to make this easier?AM Please, updating is part of the Wiki philosophy, and it shows that people read and use these pages. (I corrected the formatting a bit). Thanks for the feedback. I will try and see what can be done.
# # Example fraction teaching app (Peter Milne [email protected]) # # pie -- # Convenience proc to draw a pie # # Arguments: # x y origin # t1 t2 start, end angles (normalised for easy math, display) # label # fillcolour # # Result: # Updated x cursor # WORKTODO: x update is a kludge, large on lh pies, small on rh pies # # Side effect: # Set a new colour for subsequent drawing actions # proc pie {x y t1 t2 label fillcolour} { moveto $x $y colour "black" $fillcolour draw pie 1.8 [expr $t1+90] [expr $t2+90] moveto $x [expr $y-3.5 ] draw text $label return [expr $x+2] } # label -- # Convenience proc to draw a label # # Arguments: # x y origin # label # # Result: # Updated x cursor # proc label {x y label} { moveto $x $y draw text $label return [expr $x+2.5] } if { 1 } { mode "cartesian" textcolour "black" textfont "Times 20 bold" display erase axes erase grid set x -3.5; set y 7 set x [pie $x $y 0 180 "1/2" "blue"] set x [label $x $y "+"] set x [pie $x $y 180 360 "1/2" "yellow"] set x [label $x $y "="] pie $x $y 0 180 "1" "blue" pie $x $y 180 360 "1" "yellow" set x -3.5; set y 0 set x [pie $x $y 0 120 "1/3" "blue"] set x [label $x $y "+"] set x [pie $x $y 120 240 "1/3" "yellow"] set x [label $x $y "+"] set x [pie $x $y 240 360 "1/3" "red"] set x [label $x $y "="] pie $x $y 0 120 "1" "blue" pie $x $y 120 240 "1" "yellow" pie $x $y 240 360 "1" "red" set x -3.5; set y -7 set x [pie $x $y 0 90 "1/4" "blue"] set x [label $x $y "+"] set x [pie $x $y 90 180 "1/4" "yellow"] set x [label $x $y "+"] set x [pie $x $y 180 270 "1/4" "red"] set x [label $x $y "+"] set x [pie $x $y 270 360 "1/4" "green"] set x [label $x $y "="] pie $x $y 0 90 "1" "blue" pie $x $y 90 180 "1" "yellow" pie $x $y 180 270 "1" "red" pie $x $y 270 360 "1" "green" }
