[Arjen Markus] (1 september 2008) Inspired by the mathematical animations you can find on mathworld.wolfram.com,
I sat down and wrote the little application below. Enjoy!

[AM] The update proc is not quite as useful as it ought to be - confusion over args. Oh well, it was but half an evening's
work ;).

[AM] (3 september 2008) I needed to draw a fairly elaborate sketch, one with a smooth curve, some auxiliary lines
and so on. I found this program to be rather useful :). No animation, and perhaps a bit much work to set up the 
basic drawing, but changing it (as I had to) afterwards made it all worthwhile. 
----

======
# mathanim.tcl --
#     Experiments with a little language for creating mathematical
#     animations
#
rename update tk_update

# scaling --
#     Set up the canvas and coordinates
#
# Arguments:
#     min	Minimum value of the x/y axis
#     max	Maximum value of the x/y axis
#
# Result:
#     None
#
# Side effects:
#     Default square canvas set up
#
proc scaling {min max} {
    global scaling

    set scaling(min) $min
    set scaling(max) $max

    pack [canvas .c -width 500 -height 500 -bg white]

    set scaling(dx)  [expr {500.0/($max-$min)}]
    set scaling(dy)  [expr {500.0/($max-$min)}]

}

# pause --
#     Pause the program for a given amount of time
#
# Arguments:
#     delay      Delay in ms
#
# Result:
#     None
#
# Side effects:
#     Program pauses, but any GUI is still active, screen updates occur
#
proc pause {delay} {

    after $delay {set ::delayOver 1}
    vwait ::delayOver

}

# create --
#     Create an item on the canvas (type is fixed)
#
# Arguments:
#     name       Name of the item
#     itemdata   Data for the item
#
# Result:
#     None
#
# Side effects:
#     An item with the given name now exists and is possibly visible
#
proc create {name itemdata} {
    global item

    set item(type,$name) [lindex $itemdata 0]

    switch -- $item(type,$name) {
	"point"  { # Nothing to do }
	"dot"    { set item(id,$name) [.c create oval 0 0 0 0] }
	"circle" { set item(id,$name) [.c create oval 0 0 0 0] }
	"line"   { set item(id,$name) [.c create line 0 0 0 0] }
    }

    if { $item(type,$name) != "point" } {
	.c itemconfig $item(id,$name) {*}[lindex $itemdata end]
    }

    update $name {*}$itemdata
}

# update --
#     Update the properties of an item
#
# Arguments:
#     name       Name of the item
#     itemdata   Data for the item
#
# Result:
#     None
#
# Side effects:
#     The item has updated properties
#
proc update {name args} {
    global scaling
    global item

    set type $item(type,$name)

    if { $type != [lindex $args 0] } {
	error "Item $name and given data are incompatible!"
    }

    set item(data,$name) [lrange $args 1 end]

    UpdateCoords $name [lrange $item(data,$name) 0 end-1]
}

# UpdateCoords --
#     Update the canvas coordinates of an item
#
# Arguments:
#     name       Name of the item
#     coords     World coordinates for the item
#
# Result:
#     None
#
# Side effects:
#     The item is updated on the screen
#
proc UpdateCoords {name coords} {
    global item
    global scaling

    switch -- $item(type,$name) {
	"point" {
	    # Not visible
	}
	"dot" {
	    foreach {x y} $coords {break}
	    set xd1 [expr {$scaling(dx)*($x -$scaling(min)) - 3}]
	    set yd1 [expr {$scaling(dy)*($scaling(max)-$y) - 3}]
	    set xd2 [expr {$scaling(dx)*($x -$scaling(min)) + 3}]
	    set yd2 [expr {$scaling(dy)*($scaling(max)-$y) + 3}]

	    .c coords $item(id,$name) $xd1 $yd1 $xd2 $yd2
	}
	"circle" {
	    set r ""
	    foreach {x y r} $coords {break}
	    if { $r == "" } {
		set r [lindex $item(data,$name) 2]
	    }
	    set rad [expr {$scaling(dx)*$r}]
	    set xd1 [expr {$scaling(dx)*($x-$scaling(min)) - $rad}]
	    set yd1 [expr {$scaling(dy)*($scaling(max)-$y) - $rad}]
	    set xd2 [expr {$scaling(dx)*($x-$scaling(min)) + $rad}]
	    set yd2 [expr {$scaling(dy)*($scaling(max)-$y) + $rad}]

	    .c coords $item(id,$name) $xd1 $yd1 $xd2 $yd2
	}
	"line" {
	    foreach {x1 y1 x2 y2} $coords {break}
	    set xd1 [expr {$scaling(dx)*($x1-$scaling(min))}]
	    set yd1 [expr {$scaling(dy)*($scaling(max)-$y1)}]
	    set xd2 [expr {$scaling(dx)*($x2-$scaling(min))}]
	    set yd2 [expr {$scaling(dy)*($scaling(max)-$y2)}]

	    .c coords $item(id,$name) $xd1 $yd1 $xd2 $yd2
	}
    }
}

# point, dot, circle, line --
#     Prepare the item data for an (invisible) point
#
# Arguments:
#     args       Such things as x-coordinate/y-coordinate but also -fill colour
#
# Result:
#     Item data for [create] or [update]
#
# Note:
#     The extra arguments are only used in the [create] procedure
#
#     point, dot:
#     The first argment can be the name of a point or a pair of
#     coordinates. The rest is used as attributes
#
#     circle:
#     The first argment can be the name of a point or a pair of
#     coordinates. The second must be the radius, the rest is used as
#     attributes
#
#     line:
#     The first and second argments can be the name of a point or a pair
#     of coordinates. The rest is used as attributes.
#
proc point {first args} {
    global item

    if { [llength $first] == 2 } {
	return [concat point $first [list $args]]
    } else {
	return [concat point [lrange $item(data,$first) 0 1] [list $args]]
    }
}

proc dot {first args} {
    global item

    if { [llength $first] == 2 } {
	return [concat dot $first [list $args]]
    } else {
	return [concat dot [lrange $item(data,$first) 0 1] [list $args]]
    }
}

proc circle {first rad args} {
    global item

    if { [llength $first] == 2 } {
	return [concat circle $first $rad [list $args]]
    } else {
	return [concat circle [lrange $item(data,$first) 0 1] $rad [list $args]]
    }
}

proc line {first second args} {
    global item

    if { [llength $first] == 1 } {
	set first [lrange $item(data,$first) 0 1]
    }
    if { [llength $second] == 1 } {
	set second [lrange $item(data,$second) 0 1]
    }
    return [concat line $first $second [list $args]]
}

# add --
#     Translate a point over a given vector and return the coordinates
#
# Arguments:
#     point      Point (name or coordinate pair)
#     vector     Vector (name or coordinate pair)
#
# Result:
#     New coordinate pair
#
proc add {point vector} {
    global item

    if { [llength $point] == 1 } {
	set point [lrange $item(data,$point) 0 1]
    }
    if { [llength $vector] == 1 } {
	set vector [lrange $item(data,$vector) 0 1]
    }

    foreach {xb yb} $point {xe ye} $vector {
	set xn [expr {$xb+$xe}]
	set yn [expr {$yb+$ye}]
	break
    }

    return [list $xn $yn]
}

# translate --
#     Translate one or more item over a given vector and update the coordinates
#
# Arguments:
#     items      List of items
#     vector     Vector (name or coordinate pair)
#
# Result:
#     New coordinate pair
#
proc translate {items vector} {
    global item

    if { [llength $vector] == 1 } {
	set vector [lrange $item(data,$vector) 0 1]
    }
    set xv [lindex $vector 0]
    set yv [lindex $vector 1]

    foreach name $items {
	switch -- $item(type,$name) {
	    "point"  {set last 1}
	    "dot"    {set last 1}
	    "circle" {set last 1}
	    "line"   {set last 3}
	}

	set coords [lrange $item(data,$name) 0 $last]
	set newcoords {}

	foreach {xc yc} $coords {
	    set xn [expr {$xc + $xv}]
	    set yn [expr {$yc + $yv}]

	    lappend newcoords $xn $yn
	}

	set item(data,$name) [lreplace $item(data,$name) 0 $last {*}$newcoords]
	UpdateCoords $name $newcoords
    }
}

# rotate --
#     Rotate one or more item over a given angle and update the coordinates
#
# Arguments:
#     items      List of items
#     centre     Centre of rotation (name or coordinate pair)
#     angle      Angle (in radians)
#
# Result:
#     New coordinate pair
#
proc rotate {items centre angle} {
    global item

    if { [llength $centre] == 1 } {
	set centre [lrange $item(data,$centre) 0 1]
    }
    set xr   [lindex $centre 0]
    set yr   [lindex $centre 1]
    set cosa [expr {cos($angle)}]
    set sina [expr {sin($angle)}]

    foreach name $items {
	switch -- $item(type,$name) {
	    "point"  {set last 1}
	    "dot"    {set last 1}
	    "circle" {set last 1}
	    "line"   {set last 3}
	}

	set coords [lrange $item(data,$name) 0 $last]
	set newcoords {}

	foreach {xc yc} $coords {
	    set xn [expr {$xr + $cosa * ($xc-$xr) - $sina*($yc-$yr)}]
	    set yn [expr {$yr + $sina * ($xc-$xr) + $cosa*($yc-$yr)}]

	    lappend newcoords $xn $yn
	}

	set item(data,$name) [lreplace $item(data,$name) 0 $last {*}$newcoords]
	UpdateCoords $name $newcoords
    }
}

# track --
#     Track a point
#
# Arguments:
#     cmd	Command in question (start, next or stop)
#     point      Name (!) of the point to track
#     args       Extra attributes (for colour and such)
#
# Result:
#     None
#
# Side effect:
#     A line connecting the dots is drawn
#
proc track {cmd point args} {
    global item
    global scaling

    set xp [lindex $item(data,$point) 0]
    set yp [lindex $item(data,$point) 1]

    switch -- $cmd {
	"start" {
	    set xp [expr {$scaling(dx)*($xp-$scaling(min))}]
	    set yp [expr {$scaling(dy)*($scaling(max)-$yp)}]
	    set item(track,$point) [.c create line $xp $yp $xp $yp {*}$args]
	}
	"next" {
	    set coords [.c coords $item(track,$point)]
	    lappend coords \
		[expr {$scaling(dx)*($xp-$scaling(min))}] \
		[expr {$scaling(dy)*($scaling(max)-$yp)}]
	    .c coords $item(track,$point) $coords
	}
	"stop" {
	    unset item(track,$point)
	}
    }
}

# main --
#     Quick test
#
console show
if {0} {
scaling -5 5

create P  [dot {0 0} -fill blue]
create C1 [point {1 1}]
create C  [circle C1 2 -outline red]
create L  [line {0 0} {1 1} -fill green]


for {set i 0} {$i < 20} {incr i} {

    puts "$i ..."
    translate C {-0.2 -0.2}
    pause 30
}
}

#
# Create a cardioid
#
scaling -5 5
create C1      [point {0 0}]
create C2      [point [add C1 {2 0}]]
create circle1 [circle C1 1]
create circle2 [circle C2 1]
create P       [dot [add C2 {1 0}] -fill blue]
create line    [line C2 P -fill red]

set pi    [expr {acos(-1.0)}]
set angle [expr {2.0*$pi/100.0}]

track start P -fill blue
parray item

for {set i 0} {$i < 100} {incr i} {
    rotate {C2 P line circle2} C1 $angle
    rotate {P line}	    C2 $angle

    track next P
    pause 30
}
track stop P 
------
yahalom: I copied the code to text file and I got "extra characters after close-brace". I looked a bit but did not find the problem.
======
----
!!!!!!
%| [Category Mathematics] | [Category Graphics] | [Category Animation] |%
!!!!!!