Tangents make a curve

Arjen Markus (29 november 2010) I found these two scripts on my disk while searching for something else ... Enjoy their geometrical beauty!


A parabola

parabolaSS

# tangent.tcl --
#    Draw tangent lines and try to determine the curve that they
#    define

# tangentLine --
#    Draw a tangent line
# Arguments:
#    xcrd        X-coordinate at which the line intersects the x-axis
#    ycrd        Y-coordinate at which the line intersects the y-axis
# Result:
#    None
# Side effect:
#    Line drawn
# Note:
#    Assumes the x-axis to run from -200 to +200, ditto the y-axis
#
proc tangentLine { xcrd ycrd scale } {
   if { $xcrd == 0.0 } { return }
   #
   # Parametrisation of the line:
   #    x = $xcrd - m*$xcrd
   #    y = 0     + m*$ycrd
   #
   set x1 -2000.0
   set m  [expr {-($x1-$xcrd)/$xcrd}]
   set y1 [expr {$m*$ycrd}]
   set x2  2000.0
   set m  [expr {-($x2-$xcrd)/$xcrd}]
   set y2 [expr {$m*$ycrd}]

   set x11 [expr {100.0+$x1/$scale}]
   set x22 [expr {100.0+$x2/$scale}]
   set y11 [expr {300.0-$y1/$scale}]
   set y22 [expr {300.0-$y2/$scale}]
   .c create line $x11 $y11 $x22 $y22 -fill black
}

#
# Main code
#
canvas .c -background white -width 400 -height 400
pack   .c -fill both

set hlines 40
set scale   1.0

.c create line   0 300 400 300 -fill red -width 2
.c create line 100   0 100 400 -fill red -width 2
for { set i -$hlines } { $i < $hlines } { incr i } {
  #tangentLine [expr {$i*10+0.01}] [expr {200.0-$i*10-0.01}] $scale
   tangentLine [expr {$i*$scale*10}] [expr {200.0-$i*$scale*10}] $scale
  #tangentLine [expr {$i*$scale*10}] [expr {200.0-$i*$i}] $scale
  #tangentLine [expr {$i*$scale*10}] [expr {200.0-3.0*$i*$scale}] $scale
}

A cardioid

# cardioid.tcl --
#    Draw a classical curve:
#    - The "support" circle is at 200,300 with a radius of 100
#    - The point that passes through all other circles is 100,300
#    - The cardioid is the envelope of these circles
#
# From the book: 
#    E.H. Lockwood, A book of curves, Cambridge University Press, 1960
#
canvas .c -width 600 -height 600 -bg white
pack   .c -fill both

.c create oval 100 200 300 400 -outline blue -width 2

set support_radius 100.0

for { set angle 0 } { $angle < 360 } { incr angle 18 } {
   set rads   [expr {$angle*3.1415926/180.0}] 
   set xc     [expr {200+int($support_radius*cos($rads))}]
   set yc     [expr {300+int($support_radius*sin($rads))}]
   set radius [expr {hypot($xc-100.0,$yc-300.0)}]
   
   set xup    [expr {$xc-$radius}]
   set yup    [expr {$yc-$radius}]
   set xdown  [expr {$xc+$radius}]
   set ydown  [expr {$yc+$radius}]
   .c create oval $xup $yup $xdown $ydown -outline black
}