Updated 2007-07-05 19:26:31 by LV

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.

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 combinations, 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. For example, of lamp 123, the left part-circle in the middle would be named L1.123. }
``` 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 . <Escape> {exec wish \$argv0 &; exit}
bind . <F1> {console show}```

if 0 {

Category Animation - Arts and crafts of Tcl-Tk programming }