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
returnSee also: Circumcenter of three points