Keith Vetter 2003-02-18 - a whizzlet showing an interesting property of three equilateral triangles that share a common vertex.
##+###################################################
#
# 3Triags.tcl -- a 3-equilateral triangle whizzlet
# by Keith Vetter, Feb 18, 2003
package require Tk
set PI [expr {atan(1) * 4}]
array set P {1,1 {-10 -150} 2,1 {117 90} 3,1 {-150 30}} ;# Initial position
proc DoDisplay {} {
wm title . "Three Equilateral Triangles"
canvas .c -width 500 -height 500 -bd 2 -relief raised \
-scrollregion {-250 -250 250 250}
pack .c -side top -fill both -expand 1
button .about -text About -command About
place .about -x 5 -y 5
foreach n {1 2 3} l {12 23 31} {
DrawButton $n
.c create poly 0 0 0 0 0 0 -tag [list triag triag$n] -fill lightgreen \
-outline {}
.c create line 0 0 0 0 -tag [list line ltriag$n]
MoveTriangle $n
.c create line 0 0 0 0 -tag [list line line$l] -fill gray60
}
.c create line 0 0 0 0 -tag equi -fill blue -width 2
MoveLines
.c raise b
bind all <Alt-c> [list console show]
}
proc OtherVertex {x y} {
set len [expr {sqrt($x*$x + $y*$y)}]
if {$len == 0} {return [list 0 0]}
set a1 [expr {acos($x / $len)}]
if {$y < 0} { set a1 [expr {-1 * $a1}]}
set a2 [expr {$a1 - $::PI / 3}]
return [list [expr {cos($a2) * $len}] [expr {sin($a2) * $len}]]
}
proc MoveTriangle {n} {
foreach {x1 y1} $::P($n,1) break
foreach {x2 y2} [OtherVertex $x1 $y1] break
set ::P($n,2) [list $x2 $y2]
.c coords triag$n [concat 0 0 $::P($n,1) $::P($n,2)]
.c coords ltriag$n [concat 0 0 $::P($n,1) $::P($n,2) 0 0]
}
proc MoveLines {} {
global P
.c coords line12 [concat $P(1,1) $P(2,2)]
.c coords line23 [concat $P(2,1) $P(3,2)]
.c coords line31 [concat $P(3,1) $P(1,2)]
set p12 [Mid $P(1,1) $P(2,2)]
set p23 [Mid $P(2,1) $P(3,2)]
set p31 [Mid $P(3,1) $P(1,2)]
.c coords equi [concat $p12 $p23 $p31 $p12]
}
proc DrawButton {n} {
foreach {x y} $::P($n,1) break
set xy [list [expr {$x-5}] [expr {$y-5}] [expr {$x+5}] [expr {$y+5}]]
.c create oval $xy -fill red -tag [list b b$n]
.c bind b$n <B1-Motion> [list DoButton $n %x %y]
}
proc Mid {xy1 xy2} {
foreach {x1 y1} $xy1 {x2 y2} $xy2 break
return [list [expr {($x1 + $x2) / 2}] [expr {($y1 + $y2) / 2}]]
}
proc DoButton {who XX YY} {
set X [.c canvasx $XX] ; set Y [.c canvasy $YY]
foreach {x y} $::P($who,1) break
set ::P($who,1) [list $X $Y]
.c move b$who [expr {$X - $x}] [expr {$Y - $y}]
MoveTriangle $who
MoveLines
.c lower triag
.c raise triag$who triag
.c raise line
.c raise b
.c raise equi
}
proc About {} {
set msg "Three Equilateral Triangles\nby Keith Vetter, Feb 2003\n\n"
append msg "A whizzlet showing the following interesting property: for\n"
append msg "any three equilateral triangles that share a common vertex,\n"
append msg "the midpoints of lines joining alternating vertices also\n";
append msg "forms equilateral triangle.\n"
tk_messageBox -title "About" -message $msg
}
DoDisplayCategory Graphics | Category Mathematics | Category Application | Category Whizzlet