Version 2 of Curved line through two points

Updated 2018-09-05 20:15:36 by dbohdan

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.

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