Arjen Markus 2012-10-07: 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.
Screenshot edit
# curve.tcl --
# Draw a curve between two points
# (Based on a discussion 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 center 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 center
#
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
