[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
 }
 DoDisplay

----
[Category Graphics] | [Category Mathematics] | [Category Application] | [Category Whizzlet]