Arjen Markus (17 october 2012) The discussion on comp.lang.tcl inspired me to create the procedure below. The devil, as they say, is in the detail, which is why it took me longer than I thought to get correct. (I suspect it can be simplified a bit)
The idea: given two points create a circular arc with an adjustable curvature.
# curve.tcl -- # Draw a curve between two points # (Based on a dscussion in comp.lang.tcl) # # curve -- # Draw a circle section between two points # # Arguments: # canvas Canvas to draw it on # coords Coordinates of the start and end points # angle Angle determining the curvature (in degrees) proc curve {canvas coords angle} { # # Preliminaries # set angle_rad [expr {$angle * acos(-1.0) / 180.0}] lassign $coords xb yb xe ye set xv [expr {$xe-$xb}] set yv [expr {$ye-$yb}] # # Determine the radius and the distance of the centre to the # line through the two points # set length [expr {hypot($xv,$yv)}] set radius [expr {$length / sqrt( 2.0 * (1.0-cos($angle_rad)) )}] set distance [expr {sqrt($radius**2-0.25*$length**2)}] if { $angle > 180.0 } { set distance [expr {-$distance}] } # # Coordinates of the centre # set xc [expr {0.5 * ($xb + $xe) - $distance * $yv / $length}] set yc [expr {0.5 * ($yb + $ye) + $distance * $xv / $length}] # # Start angle for the section (note the inversion for y) # set angle_start [expr {180.0 / acos(-1.0) * atan2($yc-$yb,$xb-$xc)}] # # Draw the circle section # $canvas create arc [expr {$xc-$radius}] [expr {$yc-$radius}] \ [expr {$xc+$radius}] [expr {$yc+$radius}] \ -start [expr {$angle_start-$angle}] -extent $angle -style arc } # main -- # Test the algorithm # pack [canvas .c -width 400 -height 400] .c create line 100 100 300 300 -width 3 -fill red curve .c {100 100 300 300} 30 curve .c {100 100 300 300} 70 curve .c {100 100 300 300} 100 curve .c {100 100 300 300} 180 curve .c {100 100 300 300} 270