# superformula.tcl 
 # Author:      Gerard Sookahet
 # Date:        16 Nov 2004 
 # Description: Plot Superformula based upon Johan Gielis equations 
 #              See http://www.sciencenews.org/articles/20030503/mathtrek.asp
 
 package require Tk
 
 bind all <Escape> {exit}
 
 proc About {} {
  set w .about
  catch {destroy $w}
  toplevel $w
  wm title $w "About Superformula"
  message $w.msg -justify center -aspect 250 -relief sunken -bg blue -fg white \
         -text "Superformula\n\nGerard Sookahet\n\nNovember 2004"
  button $w.bquit -text " OK " -command {destroy .about}
  eval pack [winfo children $w]
 }
 # Init or reset data
 proc Init { w mid } {
     global a b m k
     global n1 n2 n3
 
  $w.c delete all
 
  set a 1.0
  set b 1.0
  set m 6.0
  set k 2
  set n1 3.0
  set n2 1.0
  set n3 1.0
 
  PlotSuperformula $w $mid 0
 }
 # Filled polygons or not
 proc FilledState { w mid } {
     global fs
     global poly
  if $fs {$w.c itemconfigure $poly -outline lightblue -width 1 -fill blue} else {
          $w.c itemconfigure $poly -outline lightblue -width 1 -fill black 
  }
 }
 
 proc DisplayState { w mid } {
     global rf
  if $rf {Init $w $mid} 
 }
 
 proc Main { N } {
     global a b m k
     global n1 n2 n3
     global rf fs
 
  set w .sp
  catch {destroy $w}
  toplevel $w
  wm withdraw .
  wm title $w "Superformula"
  wm geometry $w +100+10
  $w config -bg orange
 
  set f0 [frame $w.f0]
  set mid [expr {$N/2}]
  pack [canvas $w.c -width $N -height $N -bg black] $f0 -side left
  Init $w $mid
 
  set f1 [frame $f0.f1 -relief sunken -bd 1]
  pack $f1 -fill x
  scale $f1.sca -from 0.1 -to 10 -length 340 -resolution 0.01 -label "a" \
                -orient vert -bd 1 -showvalue true -variable a \
                -command "PlotSuperformula $w $mid"
  scale $f1.scb -from 0.1 -to 10 -length 340 -resolution 0.01 -label "b" \
                -orient vert -bd 1 -showvalue true -variable b \
                -command "PlotSuperformula $w $mid"
  scale $f1.scm -from 0 -to 34 -length 340 -resolution 0.2 -label "m" \
                -orient vert -bd 1 -showvalue true -variable m \
                -command "PlotSuperformula $w $mid"
  scale $f1.scn1 -from 0.1 -to 17 -length 340 -resolution 0.1 -label "n1" \
                 -orient vert -bd 1 -showvalue true -variable n1 \
                 -command "PlotSuperformula $w $mid"
  scale $f1.scn2 -from 0 -to 17 -length 340 -resolution 0.1 -label "n2" \
                 -orient vert -bd 1 -showvalue true -variable n2 \
                 -command "PlotSuperformula $w $mid"
  scale $f1.scn3 -from 0 -to 17 -length 340 -resolution 0.1 -label "n3" \
                 -orient vert -bd 1 -showvalue true -variable n3 \
                 -command "PlotSuperformula $w $mid"
  scale $f1.sck -from 1 -to 34 -length 340 -label "pi" \
                -orient vert -bd 1 -showvalue true -variable k \
                -command "PlotSuperformula $w $mid"
  eval pack [winfo children $f1] -side left
 
  set f2 [frame $f0.f2 -relief sunken -bd 1]
  pack $f2 -fill x
  checkbutton $f2.cbf -text "Filled shape" -variable fs \
             -command "FilledState $w $mid"
  checkbutton $f2.cbr -text "Refresh display" -variable rf \
             -command "DisplayState $w $mid"
  eval pack [winfo children $f2] -side left
 
  set f3 [frame $f0.f3 -relief sunken -bd 1]
  pack $f3 -fill x
  button $f3.bc -text Clear -width 6 -bg blue -fg white \
        -command "$w.c delete all"
  button $f3.ba -text About -width 6 -bg blue -fg white \
        -command About
  button $f3.bq -text Quit -width 5 -bg blue -fg white -command exit
  eval pack [winfo children $f3] -side left
 }
 
 proc PlotSuperformula { w mid v } {
     global a b m k
     global n1 n2 n3
     global rf fs
     global poly
 
  if $rf {$w.c delete all}
 
  set kpi [expr {$k*3.14159265358}]
  set N 400
  set s 0.4
 
  set l {}
  for {set i 0} {$i<=$N} {incr i} {
     set phi [expr {$i*$kpi/$N}]
 
     set t  [expr {$m*$phi/4}]
     set t1 [expr {abs(cos($t)/$a)}]
     set t1 [expr {pow($t1,$n2)}]
     set t2 [expr {abs(sin($t)/$b)}]
     set t2 [expr {pow($t2,$n3)}]
 
     set r [expr {pow($t1+$t2,1/$n1)}]
     if {[expr {abs($r)}] <= 0.000001} {
       lappend l 0 0
     } else {
       set r [expr {1/$r}]
       lappend l [expr {round($mid + $s*$mid*$r*cos($phi))}] \
                 [expr {round($mid + $s*$mid*$r*sin($phi))}]
     }
  }
  set poly [eval $w.c create polygon $l] 
  if $fs {$w.c itemconfigure $poly -outline lightblue -width 1 -fill blue} else {
          $w.c itemconfigure $poly -outline lightblue -width 1 -fill black 
  }
 }
 
 set rf 1
 set fs 1
 Main 440