Geometrical constructions

Arjen Markus (30 december 2002) I developed the script that follows as an experiment in educational software. My experiences with such software are very limited, so I pretend nothing about its usefulness. It just struck me that classical geometrical constructions, like bisecting an angle or drawing a regular hexagon can be shown in a simple animation to make the concept more lifely.

In order to do that, I needed a small drawing language. It is a kind of "turtle geometry" (if I understand that term correctly). I keep track of a current position and draw from there. The aspects that make this language easy to use are:

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.

There are two examples: constructing a hexagon and working with fractions (I remember the nice display from my own school days).

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 work

AM (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"
}

Category Application

Category Mathematics

Category Education