Updated 2012-05-17 01:43:43 by RLE

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"