*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.

*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"