if 0 {[Richard Suchenwirth] 2004-10-28 - Another evening fun project on [canvas] [animation]: at least in Germany, ambulances, fire dept. and police cars have rotating alarm lights on the top, where a bright lamp with a round concave mirror rotates around a vertical axis under a colored glass (or plastic) cover, to draw everybody's attention. With the thought of maybe using this in [toy cars], I thought how to simulate this effect in Tcl. [http://mini.net/files/strobe.gif] Let the cover just be a rectangle. When the light rotates, you first see it as part of a circle on one side (say, the left); then it moves to the middle, the bright center appears, follows by another part of the circle - all move in the same direction and disappear on the other side. This repeats until stopped. So we need three kinds of canvas items: the left and right circular parts (easily done with ''arc -style chord'' items), and the center, for simplicity as a rectangle. And we need them in three positions: at left, middle, and right of the cover. My solution was to create nine items for all possible combination, labeled (in a tag) with the kind (L, M, R) and position (0, 1, 2) - plus the ID of the cover, so one can have several alarm lights concurrently without interference. } proc strobe {w x0 y0 x1 y1 color} { set color2 [color'dim $color 0.95] set bgcolor [color'dim $color 0.66] set id [$w create rect $x0 $y0 $x1 $y1 -fill $bgcolor] set dx [expr {($x1-$x0)/3.}] set x2 [expr {$x0+$dx}] set x3 [expr {$x0-2*$dx}] foreach i {0 1 2} { $w create arc $x0 $y0 $x1 $y1 -style chord \ -start 115 -extent 130 -fill $color2 \ -outline $color2 -tag [list L$i.$id X.$id]] $w create rect $x0 $y0 $x2 $y1 -fill $color \ -outline $color -tag [list M$i.$id X.$id] $w create arc $x3 $y0 $x2 $y1 -style chord \ -start 295 -extent 130 -fill $color2 \ -outline $color2 -tag [list R$i.$id X.$id] if $i { foreach shape {L M R} { $w move $shape$i.$id [expr {$dx*$i}] 0 } } } strobe'animate $w $id {R0 {M0 R1} {L0 M1 R2} {L1 M2} L2} } if 0 {The animation happens by lowering all these items below the cover, then raising a set of items (specified as a "phase" in a "script") above it, so they become visible. The script is then cycled, so the first item is moved to the end of the script, and [after] some interval this repeats again - normally I love to use the [every] timer, but then the script would have to be in a [global] variable to survive. With the solution below, the script is strictly encapsulated in the [after] calls.} proc strobe'animate {w id phases} { $w raise $id set phase [lindex $phases 0] foreach tag $phase {$w raise $tag.$id} set phases [concat [lrange $phases 1 end] [list $phase]] after 100 [list strobe'animate $w $id $phases] } #-- making a color darker by a certain factor: proc color'dim {color factor} { foreach {rmax gmax bmax} [winfo rgb . white] break ;# "calibration" foreach {r g b} [winfo rgb . $color] break foreach var {r g b} { set $var [expr {round([set $var]*$factor*255./[set ${var}max])}] } format #%02X%02X%02X $r $g $b } if 0 {Now testing with two instances, to verify they don't interfere:} pack [canvas .c -width 100 -height 50] strobe .c 10 10 40 40 blue strobe .c 60 10 90 40 orange #-- Little dev helpers: bind . {exec wish $argv0 &; exit} bind . {console show} if 0 { ---- [Category Animation] - [Arts and crafts of Tcl-Tk programming] }