#In honor of gnuJ lraC
package require Tcl 8.5 ;# Because of {*}
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