Updated 2016-04-28 20:06:14 by gold

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]

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"]
    
    bind all <Key-F2> {console show}
    bind .c <Configure> {ReCenter %W %h %w}
    bind .c <Map> {
        Go
    }

    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
}

proc DrawFan {{arg 0}} {
    global S colors
 
    set b [expr {[set a [expr {360.0 / $S(blades)}]] /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

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.

Screenshots Section


uniquename 2013jul29

The image above at a 'flickr.com' site has gone dead. Here is an image that is 'locally stored' on the wiki.tcl.tk site.

(Thanks to 'gnome-screenshot', 'mtpaint', and ImageMagick 'convert' on Linux for, respectively, capturing the screen to a PNG file, cropping the image, and converting the resulting PNG file to a JPEG file that is about one-sixth the size of the PNG file. Thanks to FOSS developers everywhere --- including Linux kernel and Gnu developers. I used the 'mv' command and the ImageMagick 'identify' command in a shell script to easily rename the cropped image file to contain the image dimensions in pixels.)

The static image above does not indicate that the fan blades are slowly rotating when the GUI first pops up.