[Arjen Markus] 2012-10-07: The discussion on [https://groups.google.com/forum/?hl=en&fromgroups=#!topic/comp.lang.tcl/V5ZkH9zL_eQ%|%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. ** Screenshot ** [curve.png] ** Code ** ====== # 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 ====== <>Category Graphics | Mathematics