GPS
#In honor of gnuJ lraC
package require Tk
pack [canvas .c -bg black -bd 0 -highlightthickness 0 -width 650 -height 650] -fill both -expand 1
proc hexagram {c width startangle startcolor endcolor} {
set ratio [expr {3.1459 / 180}]
set magic 60
set angle $startangle
set radius [expr {$width / 2}]
for {set i 0} {$i <= 6} {incr i} {
set theta [expr {$ratio * $angle}]
set x [expr {(cos($theta) * $radius) + $radius}]
set y [expr {(-sin($theta) * $radius) + $radius}]
lappend points $x $y
incr angle $magic
}
set offset 0
for {set i 0} {$i < ([llength $points] / 2)} {incr i} {
set start [lrange $points $offset [expr {$offset + 1}]]
set rest [lrange $points [expr {$offset + 2}] end]
set x1 [lindex $start 0]
set y1 [lindex $start 1]
foreach {x2 y2} $rest {
$c create line [list $x1 $y1 $x2 $y2] -fill $startcolor
}
incr offset 2
}
$c create line $points -fill $endcolor
catch {$c raise wisdom}
}
proc go {c angle colors incr step} {
set width [$c cget -width]
hexagram $c $width $angle {*}$colors
incr angle $incr
set half [expr {$width / 2}]
if {abs($angle) > $width} {
$c delete all
switch -- [expr {$step % 4}] {
0 {
set colors [list yellow green]
$c create text $half $half -text Zeitgeist -font {Helvetica 32} -fill black -tags wisdom
set incr 3
}
1 {
set colors [list red yellow]
$c create text $half $half -text Self -font {Helvetica 32} -fill white -tags wisdom
set incr -5
}
2 {
set colors [list blue red]
$c create text $half $half -text Anima -font {Helvetica 32} -fill white -tags wisdom
set incr 5
}
3 {
set colors [list blue purple]
$c create text $half $half -text Shadow -font {Helvetica 32} -fill green -tags wisdom
incr incr -3
}
}
set angle 90
incr step
}
after 50 [list go $c $angle $colors $incr $step]
}
go .c 90 [list black white] 8 0