[Keith Vetter] 2003-07-09 - Edna St. Vincent Millay wrote in a sonnet: 

''Euclid alone has looked on Beauty bare''

[WikiDbImage trianglemadness.jpg]

Well, in looking at a triangle, he indeed saw many wonderous properties, but he was
not alone. Properties such as the '''circumcenter''', '''incenter''', '''centroid''' and
'''orthocenter''' were known to Euclid, but later mathematicians have found plenty more, 
such as the '''Euler Line''', 
the '''nine-point circle''' in 1822 and [Morley's Miracle] in 1899.

Here is a visualization of some interesting properties of a triangle. You can grab and move
any vertex.

[KPV] 2007-01-10 : finally came back to this code and added the 9 point circle
----
[AM] This website is entirely devoted to the 1500 or more special points now known about triangles: http://www.xtec.es/~qcastell/ttw/ttweng/portada.html


----
 ##+##########################################################################
 #
 # Triangle Madness -- Shows some interesting properties of a triangle
 # by Keith Vetter - July 7, 2003
 # January 10, 2007 -- added 9 point circle
 #
 
 package require Tk
 catch {package require tile}
 array set P {1 {17 -227} 2 {-215 66} 3 {156 192}} ;# Initial position
 set S(title) "Triangle Madness"
 
 set S(circumcenter) 1
 set S(incenter) 1
 set S(centroid) 0
 set S(orthocenter) 0
 set S(eulerline) 0
 set S(ninepointcircle) 0
 set S(morley'smiracle) 0
 set S(ninepointcircle) 0
 
 set C(circumcenter) magenta
 set C(incenter) deeppink
 set C(centroid) navy
 set C(orthocenter) DeepSkyBlue2
 set C(eulerline) black
 set C(9point) blueviolet
 
 proc DoDisplay {} {
    global P S
 
    wm title . $S(title)
    pack [frame .ctrl -relief ridge -bd 2 -padx 5 -pady 5] \
        -side right -fill both -ipady 5
 
    button .about -text About -command About
    .about configure  -font "[font actual [.about cget -font]] -weight bold"
    option add *font [.about cget -font]
    option add *Checkbutton.anchor w
    option add *Checkbutton.relief raised
 
    foreach txt [list Circumcenter Incenter Centroid Orthocenter \
                     "Euler Line" "Nine Point Circle" "Morley's Miracle"] {
        set w [string tolower [string map {" " ""} $txt]]
        checkbutton .$w -variable S($w) -text $txt -command DrawLines
        button .h_$w -text "?" -command [list Help $txt $w]
        grid .$w .h_$w -in .ctrl -sticky news
    }
    grid rowconfigure .ctrl 50 -weight 10
    grid .about - -in .ctrl -row 100 -sticky ew
 
    canvas .c -width 500 -height 500 -bd 2 -relief raised
    bind all <Alt-c> {console show}
    bind .c <Configure> {ReCenter %W %h %w}
    pack .c -side top -fill both -expand 1
 
    foreach w {1 2 3} {
        .c create oval [Box $P($w)] -tag [list vert p$w] -fill red
        .c bind p$w <B1-Motion> [list DoButton $w %x %y]
    }
    bind all <Alt-c> [list console show]
 }
 ##+##########################################################################
 #
 # Recenter -- keeps 0,0 at the center of the canvas during resizing
 #
 proc ReCenter {W h w} {                   ;# Called by configure event
    set h2 [expr {$h / 2}]
    set w2 [expr {$w / 2}]
    $W config -scrollregion [list -$w2 -$h2 $w2 $h2]
 }
 ##+##########################################################################
 #
 # DoButton -- interactively moves a vertex around and redraws everything
 #
 proc DoButton {who X Y} {
    foreach {x y} $::P($who) {X Y} [list [.c canvasx $X] [.c canvasy $Y]] break
    set ::P($who) [list $X $Y]
    .c move p$who [expr {$X - $x}] [expr {$Y - $y}]
    DrawLines
 }
 ##+##########################################################################
 #
 # Box -- returns coordinates for a box around a given point
 #
 proc Box {xy {r 5}} {
    foreach {x y} $xy break
    return [list [expr {$x-$r}] [expr {$y-$r}] [expr {$x+$r}] [expr {$y+$r}]]
 }
 ##+##########################################################################
 #
 # VAdd -- adds two vectors w/ scaling of 2nd vector
 # VSub -- subtract two vectors
 # VNormal -- returns normal vector to v
 #
 proc VAdd {v1 v2 {scaling 1}} {
    foreach {x1 y1} $v1 {x2 y2} $v2 break
    return [list [expr {$x1 + $scaling*$x2}] [expr {$y1 + $scaling*$y2}]]
 }
 proc VSub {v1 v2} { return [VAdd $v1 $v2 -1] }
 proc VNormal {v} { foreach {x y} $v break; return [list $y [expr {-1 * $x}]]}
 ##+##########################################################################
 #
 # DrawLines -- draws all the various lines on the screen
 #
 proc DrawLines {} {
    global P
    .c delete outer circum incenter centroid ortho euler equi tri
 
    .c create poly [concat $P(1) $P(2) $P(3)] -tag outer -width 2 \
        -fill lightgreen -outline black
    set theta [FindAngle3 $P(1) $P(2) $P(3)]    ;# Check for collinear points
    if {$theta != 0} {
        CircumCenter
        InCenter
        Centroid
        OrthoCenter
        EulerLine
        9PointCircle
        Morley
    }
    .c raise vert
 }
 ##+##########################################################################
 #
 # IntersectV -- find where 2 point/vector intersect
 #
 # p1+K(v1) = p3+J(v3)
 # convert into and solve matrix equation (a b / c d) ( K / J) = ( e / f )
 #
 proc IntersectV {p1 v1 p3 v3} {
    foreach {x1 y1} $p1 {vx1 vy1} $v1 {x3 y3} $p3 {vx3 vy3} $v3 break
 
    set a $vx1
    set b [expr {-1 * $vx3}]
    set c $vy1
    set d [expr {-1 * $vy3}]
    set e [expr {$x3 - $x1}]
    set f [expr {$y3 - $y1}]
 
    set det [expr {double($a*$d - $b*$c)}]
    if {$det == 0} {error "Determinant is 0"}
 
    set k [expr {($d*$e - $b*$f) / $det}]
    #set j [expr {($a*$f - $c*$e) / $det}]
    return [VAdd $p1 $v1 $k]
 }
 ##+##########################################################################
 #
 # Intersect -- find where two line intersect given two points on each line
 #
 proc Intersect {p1 p2 p3 p4} {
    return [IntersectV $p1 [VSub $p2 $p1] $p3 [VSub $p4 $p3]]
 }
 ##+##########################################################################
 #
 # TrisectAngle -- returns two points which are on the two lines trisecting
 # the angle created by points p1,p2,p3. We use the cross product to tell
 # us clockwise ordering.
 #
 proc TrisectAngle {p1 p2 p3} {
    set cross [Cross [VSub $p2 $p1] [VSub $p2 $p3]]
    if {$cross < 0} {foreach {p1 p3} [list $p3 $p1] break}
 
    set theta [FindAngle3 $p1 $p2 $p3]          ;# What the angle is
    set theta1 [expr {$theta / 3.0}]            ;# 1/3 of that angle
    set theta2 [expr {2 * $theta1}]             ;# 2/3 of that angle
 
    set v [VSub $p3 $p2]                        ;# We'll rotate this leg
    set v1 [RotateCC $v $theta1]                ;# By 1/3
    set v2 [RotateCC $v $theta2]                ;# By 2/3
    set t1 [VAdd $p2 $v1]                       ;# Trisect point 1
    set t2 [VAdd $p2 $v2]                       ;# Trisect point 2
 
    if {$cross < 0} { foreach {t1 t2} [list $t2 $t1] break }
    return [list $t1 $t2]
 }
 ##+##########################################################################
 #
 # BisectAngle -- returns point on bisector of an angle
 #
 proc BisectAngle {p1 p2 p3} {
    foreach {x1 y1} [VSub $p1 $p2] {x2 y2} [VSub $p3 $p2] break
    set s1 [expr {100.0 / hypot($x1, $y1)}]
    set s2 [expr {100.0 / hypot($x2, $y2)}]
    set v1 [VAdd $p2 [list $x1 $y1] $s1]        ;# Unit vector from p2 to p1
    set v2 [VAdd $p2 [list $x2 $y2] $s2]        ;# Unit vector from p2 to p3
    return [VAdd $v1 [VSub $v2 $v1] .5]
 }
 ##+##########################################################################
 #
 # FindAngle3 -- returns the angle between three points
 #
 proc FindAngle3 {p1 p2 p3} {
    foreach {x1 y1} [VSub $p1 $p2] {x2 y2} [VSub $p3 $p2] break
 
    set m1 [expr {hypot($x1,$y1)}]
    set m2 [expr {hypot($x2,$y2)}]
    if {$m1 == 0 || $m2 == 0} { return 0 }      ;# Coincidental points
    set dot [expr {$x1 * $x2 + $y1 * $y2}]
 
    set theta [expr {acos($dot / $m1 / $m2)}]
    if {$theta < 1e-5} {set theta 0}
    return $theta
 }
 ##+##########################################################################
 #
 # RotateCC -- rotates vector v by beta radians counter-clockwise
 #
 proc RotateCC {v beta} {
    foreach {x y} $v break
    set xx [expr {$x * cos(-$beta) - $y * sin(-$beta)}]
    set yy [expr {$x * sin(-$beta) + $y * cos(-$beta)}]
    return [list $xx $yy]
 }
 ##+##########################################################################
 #
 # Cross -- returns the cross product -- easy w/ z=0
 #
 proc Cross {v1 v2} {
    foreach {x1 y1} $v1 {x2 y2} $v2 break
    return [expr {($x1*$y2) - ($y1*$x2)}]
 }
 proc About {} {
    set msg "$::S(title)\nby Keith Vetter, July 2003\n\n"
    append msg "A little program to visualize some of the many interesting\n"
    append msg "properties of a triangle. You can grab and drag any of the\n"
    append msg "triangle's vertices. Click on the \"?\" next to a property\n"
    append msg "to learn more about it."
    tk_messageBox -title "About $::S(title)" -message $msg
 }
 proc CircumCenter {} {
    global P S C
 
    .c delete circum
    set h12 [VAdd $P(1) [VSub $P(2) $P(1)] .5]  ;# Midpoints of each side
    set h13 [VAdd $P(1) [VSub $P(3) $P(1)] .5]
    set h23 [VAdd $P(2) [VSub $P(3) $P(2)] .5]
 
    set n12 [VNormal [VSub $P(2) $P(1)]]        ;# Normal to side p1-p2
    set n13 [VNormal [VSub $P(3) $P(1)]]
    set O [IntersectV $h12 $n12 $h13 $n13]      ;# The circumcenter
    set S(v,circumcenter) $O
    foreach {rx ry} [VSub $P(1) $O] break       ;# Radius vector
    set radius [expr {hypot($rx,$ry)}]          ;# Radius magnitude
 
    if {! $S(circumcenter) && ! $S(eulerline)} return
    .c create text $O -text "O" -anchor se -tag circum -fill $C(circumcenter)
    .c create oval [Box $O 3] -tag circum -fill $C(circumcenter) -outline $C(circumcenter)
    if {! $S(circumcenter)} return
    .c create line [concat $h12 $O] -tag circum -fill $C(circumcenter)
    .c create line [concat $h13 $O] -tag circum -fill $C(circumcenter)
    .c create line [concat $h23 $O] -tag circum -fill $C(circumcenter)
    .c create oval [Box $O $radius] -tag circum -outline $C(circumcenter)
    .c create line [concat $O [VAdd $O [list $radius 0]]] -tag circum \
        -fill $C(circumcenter) -dash 1
 }
 proc InCenter {} {
    global P S C
 
    .c delete incenter
    set b1 [BisectAngle $P(3) $P(1) $P(2)]      ;# Bisect angle 1
    set b2 [BisectAngle $P(1) $P(2) $P(3)]      ;# Bisect angle 2
    set Q [Intersect $P(1) $b1 $P(2) $b2]
    set S(v,incenter) $Q
 
    # Need distance from any side to the incenter
    foreach {qx qy p1x p1y p2x p2y} [concat $Q $P(1) $P(2)] break
    set vqx [expr {$qx - $p1x}]
    set vqy [expr {$qy - $p1y}]
    set vpx [expr {$p2x - $p1x}]
    set vpy [expr {$p2y - $p1y}]
    set radius [expr {($vqx * $vpy - $vqy * $vpx) / hypot($vpx, $vpy)}]
 
    if {! $S(incenter)} return
    .c create text $Q -text "Q" -anchor se -tag incenter -fill $C(incenter)
    .c create oval [Box $Q 3] -tag incenter -fill $C(incenter) -outline $C(incenter)
    .c create line [concat $P(1) $Q] -tag incenter -fill $C(incenter)
    .c create line [concat $P(2) $Q]  -tag incenter -fill $C(incenter)
    .c create line [concat $P(3) $Q]  -tag incenter -fill $C(incenter)
    .c create oval [Box $Q $radius] -tag incenter -outline $C(incenter)
    .c create line [concat $Q [expr {$qx + $radius}] $qy] -tag incenter \
        -fill $C(incenter) -dash 1
 }
 proc Centroid {} {
    global P S C
 
    .c delete centroid
    set h12 [VAdd $P(1) [VSub $P(2) $P(1)] .5]  ;# Midpoints of each side
    set h13 [VAdd $P(1) [VSub $P(3) $P(1)] .5]
    set h23 [VAdd $P(2) [VSub $P(3) $P(2)] .5]
    set CC [Intersect $P(1) $h23 $P(2) $h13]
    set S(v,centroid) $CC
 
    if {! $S(centroid) && ! $S(eulerline)} return
    set col $C(centroid)
    .c create text $CC -text "C" -anchor se -tag centroid -fill $col
    .c create oval [Box $CC 3] -tag centroid -fill $col -outline $col
    if {! $S(centroid)} return
    .c create line [concat $P(1) $h23] -tag centroid -fill $col
    .c create line [concat $P(2) $h13] -tag centroid -fill $col
    .c create line [concat $P(3) $h12] -tag centroid -fill $col
 }
 proc OrthoCenter {} {
    global P S C
 
    .c delete ortho
    set v1 [VSub $P(3) $P(2)]                   ;# Vector for side p2-p3
    set a1 [IntersectV $P(1) [VNormal $v1] $P(2) $v1]
    set v2 [VSub $P(3) $P(1)]
    set a2 [IntersectV $P(2) [VNormal $v2] $P(1) $v2]
    set v3 [VSub $P(2) $P(1)]
    set a3 [IntersectV $P(3) [VNormal $v3] $P(1) $v3]
    set H [Intersect $P(1) $a1 $P(2) $a2]
    set S(v,orthocenter) $H
 
    if {! $S(orthocenter) && ! $S(eulerline)} return
    set col $C(orthocenter)
    .c create text $H -text "H" -anchor se -tag ortho -fill $col
    .c create oval [Box $H 3] -tag ortho -fill $col -outline $col
    if {! $S(orthocenter)} return
    .c create line [concat $P(1) $a1] -tag ortho -fill $col
    .c create line [concat $P(2) $a2] -tag ortho -fill $col
    .c create line [concat $P(3) $a3] -tag ortho -fill $col
 
    # Altitude's feet maybe outside triangle, draw a dashed line to look bettter
    .c create line [concat $P(2) $P(3) $a1] -tag {x ortho} -fill $col -dash 1
    .c create line [concat $P(1) $P(3) $a2] -tag {x ortho} -fill $col -dash 1
    .c create line [concat $P(1) $P(2) $a3] -tag {x ortho} -fill $col -dash 1
    .c lower x
 }
 proc EulerLine {} {
    global P S C
    if {! $S(eulerline)} return
 
    .c delete euler
    .c create line [concat $S(v,orthocenter) $S(v,centroid)] -tag euler
    .c create line [concat $S(v,circumcenter) $S(v,centroid)] -tag euler
    .c itemconfig euler -fill $C(eulerline) -width 3
 }
 proc 9PointCircle {} {
    global P S C
 
    .c delete 9point
    if {! $S(ninepointcircle)} return
 
    # 3 side medians
    set h12 [VAdd $P(1) [VSub $P(2) $P(1)] .5]  ;# Midpoints of each side
    set h13 [VAdd $P(1) [VSub $P(3) $P(1)] .5]
    set h23 [VAdd $P(2) [VSub $P(3) $P(2)] .5]
 
    # 3 feet of altitudes
    set v1 [VSub $P(3) $P(2)]                   ;# Vector for side p2-p3
    set a1 [IntersectV $P(1) [VNormal $v1] $P(2) $v1]
    set v2 [VSub $P(3) $P(1)]
    set a2 [IntersectV $P(2) [VNormal $v2] $P(1) $v2]
    set v3 [VSub $P(2) $P(1)]
    set a3 [IntersectV $P(3) [VNormal $v3] $P(1) $v3]
    set H [Intersect $P(1) $a1 $P(2) $a2]       ;# Orthocenter
 
    # 3 midpoints of orthocenter to vertices
    set o1 [VAdd $P(1) [VSub $H $P(1)] .5]
    set o2 [VAdd $P(2) [VSub $H $P(2)] .5]
    set o3 [VAdd $P(3) [VSub $H $P(3)] .5]
 
    foreach {O radius} [GetCenter $h12 $h13 $h23] break
 
    foreach who {h12 h13 h23 a1 a2 a3 o1 o2 o3 O} {
        set xy [Box [set $who] 3]
        .c create oval $xy -tag 9point -fill $C(9point) -outline $C(9point)
    }
    set xy [Box $O $radius]
    .c create oval $xy -tag 9point -fill {} -outline $C(9point)
    .c create line [concat $O [VAdd $O [list $radius 0]]] -tag 9point \
        -fill $C(9point) -dash 1
    .c create text $O -text "9" -anchor se -tag 9point -fill $C(9point)
 }
 proc GetCenter {p1 p2 p3} {
    set h12 [VAdd $p1 [VSub $p2 $p1] .5]        ;# Midpoints of each side
    set h13 [VAdd $p1 [VSub $p3 $p1] .5]
    set h23 [VAdd $p2 [VSub $p3 $p2] .5]
 
    set n12 [VNormal [VSub $p2 $p1]]            ;# Normal to side p1-p2
    set n13 [VNormal [VSub $p3 $p1]]
    set O [IntersectV $h12 $n12 $h13 $n13]      ;# The circumcenter
    set S(v,circumcenter) $O
    foreach {rx ry} [VSub $p1 $O] break         ;# Radius vector
    set radius [expr {hypot($rx,$ry)}]          ;# Radius magnitude
    return [list $O $radius]
 }
 ##+##########################################################################
 #
 # Morley -- draws the angle trisectors out to where they
 # meet and then draws the Morley triangle in the middle.
 #
 proc Morley {} {
    global P
 
    .c delete tri equi
    if {! $::S(morley'smiracle)} return
 
    # Get trisector lines out of each vertex
    foreach {t(1,1) t(1,2)} [TrisectAngle $P(3) $P(1) $P(2)] break
    foreach {t(2,1) t(2,2)} [TrisectAngle $P(1) $P(2) $P(3)] break
    foreach {t(3,1) t(3,2)} [TrisectAngle $P(2) $P(3) $P(1)] break
 
    # Find where trisector line segments intersect
    set E1 [Intersect $P(1) $t(1,1) $P(2) $t(2,2)]
    set E2 [Intersect $P(2) $t(2,1) $P(3) $t(3,2)]
    set E3 [Intersect $P(1) $t(1,2) $P(3) $t(3,1)]
    if {$E1 == {} || $E2 == {} || $E3 == {}} return ;# Colinear lines?
 
    .c create line [concat $P(1) $E1 $P(2) $E2 $P(3) $E3 $P(1)] -tag tri \
        -fill blue
    .c create line [concat $E1 $E2 $E3 $E1] -tag equi -fill red -width 2
 }
 ##+##########################################################################
 # 
 # MyHelpBox -- like tk_messageBox but w/o the grab
 # 
 proc MyHelpBox {title msg} {
    set W .help
 
    if {[winfo exists $W]} {
        wm title $W $title
        $W.msg config -text $msg
        return
    }
    
    destroy $W
    toplevel $W
    wm transient $W .
    wm title $W $title
    wm resizable $W 0 0
    set bg [$W cget -background]
    frame $W.bot -background $bg
    pack $W.bot -side bottom -fill both
    frame $W.top -background $bg
    pack $W.top -side top -fill both -expand 1
    set windowingsystem [tk windowingsystem]
    if {$windowingsystem ne "classic" && $windowingsystem ne "aqua"} {
        $W.bot configure -relief raised -bd 1
        $W.top configure -relief raised -bd 1
    }
    label $W.icon -image ::img::info -bg $bg
    label $W.msg -anchor nw -justify left -text $msg -bg $bg -wraplength 3i
    grid $W.icon $W.msg -in $W.top -sticky news -padx 2m -pady 2m
    grid config $W.icon -sticky n
    grid columnconfigure $W.top 1 -weight 1
    grid rowconfigure $W.top 0 -weight 1
 
    if {[info commands ::ttk::button] ne {}} {
        ::ttk::button $W.ok -text "OK" -command [list destroy $W]
        $W.top config -bd 0
        $W.bot config -bd 0
    } else {
        button $W.ok -text "OK" -padx 3m -command [list destroy $W]
    }
    grid $W.ok -in $W.bot -padx 3m -pady 2m -sticky ew
    bind $W <space> [list destroy $W]
    ::tk::PlaceWindow $W widget .
 }
 image create photo ::img::info -data {
    R0lGODlhIAAgALMAAAAAAAAA/4SEhMbGxvf/Mf//////////////////////////////////////
    /////yH5BAEAAAQALAAAAAAgACAAAAStkMhJibj41s0nHkUoDljXXaCoqqRgUkK6zqP7CvQQ7IGs
    AiYcjcejFYAb4ZAYMB4rMaeO51sNkBKlc/uzRbng0NWlnTF3XAAZzExj2ET3BV7cqufctv2Tj0vv
    Fn11RndkVSt6OYVZRmeDXRoTAGFOhTaSlDOWHACHW2MlHQCdYFebN6OkVqkZlzcXqTKWoS8wGJMh
    s7WoIoC7v7i+v7uTwsO1o5HHu7TLtcodEQAAOw==}
 
 proc Help {title who} {
    set m(orthocenter) "The orthocenter is the intersection of the "
    append m(orthocenter) "three altitudes of a triangle."
    set m(centroid) "The centroid is the balance point of the triangle. "
    append m(centroid) "It is the intersection of the lines from each vertex "
    append m(centroid) "to the opposite median."
    set m(incenter) "The incenter is the center of a circle that is tangent "
    append m(incenter) "to each side of the triangle. It is the intersection "
    append m(incenter) "of the lines bisecting each vertex."
    set m(circumcenter) "The circumcenter is the center of a circle that "
    append m(circumcenter) "passes through each vertex of a triangle. It is "
    append m(circumcenter) "the intersection the lines perpendicular to and "
    append m(circumcenter) "passing through the midpoint of each side."
    set m(morley'smiracle) "Morley's Miracle is an equilateral triangle formed "
    append m(morley'smiracle) "by the three points of intersection of the "
    append m(morley'smiracle) "adjacent trisectors of the angles of a triangle."
    set m(eulerline) "Euler Line is the lined formed by the collinear points: "
    append m(eulerline) "centroid, circumcenter, othrocenter and the center "
    append m(eulerline) "of the nine-point circle."
    set m(ninepointcircle) "The nine-point circle is also known as both the "
    append m(ninepointcircle) "Euler Circle and Feuerbach Circle and is a "
    append m(ninepointcircle) "circle passing through nine seemingly random "
    append m(ninepointcircle) "points: the midpoints of the three sides, the "
    append m(ninepointcircle) "feet of the three altitudes, and the midpoints "
    append m(ninepointcircle) "of the three line segments connecting the "
    append m(ninepointcircle) "orthocenter to the vertices."
 
    set msg "$title\n\n$m($who)"
    #tk_messageBox -title "$::S(title) -- $title" -message $msg
    MyHelpBox "$::S(title) -- $title" $msg
 }
 ################################################################
 DoDisplay
 DrawLines
 return
----
[Circumcenter of three points]
!!!!!!
%|[Category Graphics] | [Category Mathematics] | [Category Application] | [Category Whizzlet]|%
!!!!!!