Arjen Markus 2 october 2002. The wonderful page by
Keith Vetter on the graphics (and mechanics) of the
Spirograph made me think of my own childhood. And from there on to a generalisation of the concept, and from there on to the script below.
Well, it is not actually a proper generalisation, but it will do as the results are satisfactory in terms of graphics and maths. The best metaphore, however, is a physical one (back to my student days now :-).
Suppose you are watching someone drawing a curve. You concentrate on the motion of his or her stylus, and copy the result on a sheet of paper yourself. Actually, you have to do that to see the final curve, because this person is sitting in some kind of vehicle that is following a path on its own right.
For example: the person is drawing a straight line while sitting on the horse in a merry-go-round. The result? Well, it depends on the speed of the merry-go-round, the size of the line that is being drawn and so on. In short, you need to
compose the motion of the person and of the stylus.
In mathematical terms:
- There are two parametrised curves (time is the obvious parameter here!).
- The locus and orientation of a point on the one curve determines the relative coordinate system of the second curve.
In the script below this idea is elaborated: define parameterised curves, and construct new curves out of them. You can even use composed curves as the basic ingredients.
Explanation of the design:- With UniqueID I construct a unique name, no more (just a counter)
- I have an implementation routine like ParamCurveImpl that takes all the specific arguments to do its true job.
- I do not want to show that in the "production code", so I use interp alias to store them safely away.
- interp alias also makes a proc with this unique name.
- When I call this proc, the call is translated into a call to ParamCurveImp with the constant, hidden arguments.
- This is the equivalent of creating a Java object (or other OO-type languages) with a bunch of arguments that are stored in the object's fields
# compose_curves.tcl --
#
# Package for composing parametrised curves
# (sample Workbench module)
#
# Notes:
# This package is a quick hack to get started only
#
# Version information:
# version 0.1: initial implementation, october 2002
package require Tk
package provide ComposeCurves 0.1
namespace eval ::composecurves {
variable unique_id 0
namespace export paramCurve compositeCurve display
# paramCurve --
# Construct a procedure that implements a parametrised curve
# and return its name
#
# Arguments:
# xexpr Expression for calculating x-coordinate from parameter p
# yexpr Ditto for calculating y-coordinate from parameter p
#
# Result:
# Name of procedure that will calculate the locus at parameter p,
# this procedure returns the coordinate pair (x,y) as a list.
#
# Note:
# The expressions must use the variable p as the parameter,
# e.g. "{$p} {$p*$p}" for the parabola with equation y = x^2
#
proc paramCurve {xexpr yexpr} {
set name [UniqueID "CURVE"]
interp alias {} $name {} [namespace current]::ParamCurveImpl $xexpr $yexpr
return $name
}
# ParamCurveImpl --
# Calculate the x and y coordinates as function of parameter p
#
# Arguments:
# xexpr Expression for calculating x-coordinate from parameter p
# yexpr Ditto for calculating y-coordinate from parameter p
# p Value of parameter
#
# Result:
# Name of procedure that will calculate the locus at parameter p,
# this procedure returns the coordinate pair (x,y) as a list.
#
proc ParamCurveImpl {xexpr yexpr p} {
# NOFRINK
return [list [expr $xexpr] [expr $yexpr]]
}
# UniqueID --
# Construct a unique ID for a new procedure
#
# Arguments:
# prefix Prefix to be used
#
# Result:
# String of the form "prefix##0"
#
proc UniqueID {prefix} {
variable unique_id
set name "$prefix##$unique_id"
incr unique_id
return $name
}
# compositeCurve --
# Construct a procedure that implements the composition of the given
# curves and return its name
#
# Arguments:
# curve1 Curve to be imposed upon the loci of the second
# curve2 Curve providing loci and orientation
#
# Result:
# Name of procedure that will calculate the locus at parameter p,
# this procedure returns the coordinate pair (x,y) as a list.
#
proc compositeCurve {curve1 curve2} {
set name [UniqueID "COMPOSITE"]
interp alias {} $name {} [namespace current]::CompositeCurveImpl $curve1 $curve2
return $name
}
# CompositeCurveImpl --
# Calculate the x and y coordinates as function of parameter p,
# based on the composition of the two curves
#
# Arguments:
# curve1 Curve to be imposed upon the loci of the second
# curve2 Curve providing loci and orientation
# p Value of parameter
#
# Result:
# (x,y) coordinates
#
# Note:
# The construction uses a second parameter value (p+0.001) to
# determine the tangent. This assumes the parameter value is
# in the order of 1 to 100, say.
#
proc CompositeCurveImpl {curve1 curve2 p} {
set pd [expr {$p+0.001}]
foreach {x1 y1} [$curve1 $p] break
foreach {x2 y2} [$curve2 $p] break
foreach {x2d y2d} [$curve2 $pd] break
set xt [expr {$x2d-$x2}]
set yt [expr {$y2d-$y2}]
set tt [expr {hypot($xt,$yt)}]
set xt [expr {$xt/$tt}]
set yt [expr {$yt/$tt}]
set xn [expr {-$yt}]
set yn $xt
set xp [expr {$x2+$x1*$xt+$y1*$xn}]
set yp [expr {$y2+$y1*$yt+$y1*$yn}]
return [list $xp $yp]
}
# display --
# Quick and dirty implementation to calculate and display a polyline
#
# Arguments:
# curve Name of the curve to be calculated
# colour Colour to use
#
# Result:
# None
#
# Side effect:
# Display of polyline, scaled within -20 to 20 for x and y
#
proc display {curve colour} {
set xycoords {}
for {set i 0} {$i < 2000} {incr i} {
set p [expr {$i*0.01}]
foreach {x y} [$curve $p] break
set x [expr {int(10*($x+20.0))}]
set y [expr {int(10*(20.0-$y))}]
lappend xycoords $x $y
}
.cnv create line $xycoords -fill $colour
}
} ;# End of namespace
#
# Run the program
#
namespace import ::composecurves::*
canvas .cnv -width 400 -height 400 -background white
pack .cnv -fill both
set line [paramCurve {0.7*$p} {0.7*$p}]
set circle [paramCurve {cos($p)} {sin($p)}]
set circle2 [paramCurve {cos(2.6*$p)} {sin(2.6*$p)}]
set parabola [paramCurve {0.4*($p-10.0)} {0.16*($p-10.0)*($p-10.0)}]
set lc [compositeCurve $line $circle]
set cl [compositeCurve $circle2 $line]
set pp [compositeCurve $circle2 $parabola]
set clc [compositeCurve $circle2 $lc]
display $lc "black"
display $cl "red"
display $pp "green"
display $clc "magenta"
