[Keith Vetter] 2004-01-30 : Here's a fun, simple little animation of a rotating fan. You can vary the speed, direction, number and color of the blades and the size. ---- ##+########################################################################## # # Fan.tcl - draws rotating fan blades # by Keith Vetter, Jan 30, 2004 package require Tk array set S {title Fan angle 0 increment 2 delay 1 bg \#FCCA04 color black colors 0 blades 3 speed 2} set colors [list red yellow green blue cyan purple violet white black] if {$tcl_platform(platform) == "unix"} {set S(delay) 10} proc DoDisplay {} { wm title . $::S(title) canvas .c -relief raised -height 250 -width 250 -bg $::S(bg) -bd 2 label .lspeed -text "Speed:" scale .sspeed -orient horizontal -showvalue 0 -variable S(speed) \ -command Speed -from -20 -to 20 label .lblades -text "Blades:" scale .sblades -orient horizontal -showvalue 0 -variable S(blades) \ -command DrawFan -from 1 -to 20 checkbutton .colors -text "C" -font {Helvetica 6 bold} \ -indicatoron 0 -variable S(colors) -command [list DrawFan 1] button .about -text "?" -font {Helvetica 6 bold} \ -command [list tk_messageBox -title "About $::S(title)" \ -message "$::S(title)\nby Keith Vetter, January 2004"] grid .c - - -row 0 -sticky news grid .lspeed .sspeed .colors -sticky ew grid .lblades .sblades .about -sticky ew grid rowconfigure . 0 -weight 1 grid columnconfigure . 1 -weight 1 bind all {console show} bind .c {ReCenter %W %h %w} update DrawFan 1 } proc DrawFan {{arg 0}} { global S colors set a [expr {360.0 / $S(blades)}] ; set b [expr {$a / 2}] ;# Blade positions if {$arg} { .c delete all set clen [llength $::colors] for {set i 0} {$i < $S(blades)} {incr i} { set color [expr {! $S(colors) ? $S(color) \ : [lindex $colors [expr {int($clen*rand())}]]}] .c create arc $S(size1) -tag blade$i -fill $color -outline $color \ -start [expr {$S(angle) + $i*$a}] -extent $b } .c create oval $S(size2) -tag outer -fill $S(bg) -outline $S(bg) .c create oval $S(size3) -tag inner -fill $S(color) -outline $S(color) } else { ;# Here to just update position for {set i 0} {$i < $S(blades)} {incr i} { .c itemconfig blade$i -start [expr {$S(angle) + $i * $a}] -extent $b } } } # Recenter -- keeps 0,0 at the center of the canvas during resizing proc ReCenter {W h w} { ;# Called by configure event set h2 [expr {$h / 2}] ; set w2 [expr {$w / 2}] $W config -scrollregion [list -$w2 -$h2 $w2 $h2] set s [expr {($h2 < $w2 ? $h2 : $w2) * .75}];# Blade size set ::S(size1) [list -$s -$s $s $s] set s [expr {$s / 4}] ;# Middle circle set ::S(size2) [list -$s -$s $s $s] set s [expr {$s / 2}] ;# Inner circle set ::S(size3) [list -$s -$s $s $s] DrawFan -1 } proc Speed {val} { foreach old $::S(increment) ::S(increment) [expr {$val / 4.0}] break if {! $old} Go } proc Go {} { foreach aid [after info] {after cancel $aid};# Be safe if {$::S(increment) == 0} return set ::S(angle) [expr {$::S(angle) + $::S(increment)}] DrawFan after $::S(delay) Go } DoDisplay Go ---- [SS] to work well with Unix you should not use after with an argument < 10, because that's the max granularity of the timer of many unix-like operating systems (notably Linux >= 2.6 should perform better, having the HZ macro set to 1000 instead of 100). Otherwise X server events will speed-up the Fun when you move the cursor, press keys and so on. [KPV] Okay, I added code to set S(delay) to 10 if tcl_platform(platform) equals "unix". ---- [FW]: The color scheme and spacing looks more than slightly like the "radiation" symbol, non? ;) [KPV] Yes, as you can see at [http://www.who.int/docstore/water_sanitation_health/medwaste/images/p_03.gif] ---- [Category Animation] | [Category Graphics] | [Category Application] | [Category Toys]