(a,b,m,n1,n2,n3) (1) (1, 1.8, 6, 1, 2, 1.4) (2) (1.5, 2, 8, 0.9, 1.8, 0.8) (3) (1, 2, 10, 0.9, 1.7, 1.1) (4) (1.6, 1, 12, 1.5, 2, 7.5) (5) (2.7, 2.6, 6, 12, 8.3, 5.3) (6) (1.5, 2, 2, 1.7, 0.7, 2) (7) (1.19, 2.8, 32, 3, 0.9, 6) (8) (0.9, 10, 4, 4.2, 17, 1.5)-
# 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
Ro: This is a brillant addition GS! Well DONE!