[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
----
[Jeff Smith] 2019-09- : Below is an online demo using [CloudTk]
<<inlinehtml>>
<iframe height="7600" width="7500" src="https://cloudtk.tcl-lang.org/cloudtk/VNC?session=new&Tk=Triangle-Madness" allowfullscreen></iframe>
<<inlinehtml>>
----
[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
======
See also: [Circumcenter of three points]
<<categories>> Graphics | Mathematics | Application | Whizzlet