proc animate {} {
set i [ expr { $::cnt % 15 } ]
if {$i > 8} { set i [ expr { 15 - $i } ] }
set tag t$i
puts $tag
.c raise bg
.c raise $tag
incr ::cnt
after $::interval animate
}
set ::cnt 0
set ::interval 200
canvas .c -width 20 -height 20
pack .c -expand 1
.c create rect 0 0 20 20 -fill gray
.c create oval -5 -5 25 25 -fill gray -tags { bg }
.c create oval 0 0 0 0 -fill green -tags {t0 }
.c create oval 0 0 5 5 -fill green -tags { t1 }
.c create oval 0 0 10 10 -fill green -tags { t2 }
.c create oval 0 0 15 15 -fill green -tags { t3 }
.c create oval 0 0 20 20 -fill green -tags { t4 }
.c create oval 5 5 20 20 -fill green -tags { t5 }
.c create oval 10 10 20 20 -fill green -tags { t6 }
.c create oval 15 15 20 20 -fill green -tags { t7 }
.c create oval 20 20 20 20 -fill green -tags { t8 }
.c raise off
update
after 200
animateSlightly changed to show selection by tag combinations:
proc animate1 {} {
set i [ expr { $::cnt % 18 } ] ; incr ::cnt
.c raise screen
if {$i < 9} {
set tags [ list green && step$i ]
} else {
set tags [ list blue && step[ expr { 17 - $i } ] ]
}
puts $tags
.c raise $tags
after $::interval animate1
}
set ::cnt 0
set ::interval 200
set ::coords_bg {
-5 -5 25 25
}
set ::coords_ball {
{ 0 20 2 18 }
{ 0 20 5 15 } { 0 20 10 10 } { 0 20 15 5 }
{ 0 20 20 0 }
{ 5 20 20 5 } { 10 20 20 10 } { 15 20 20 15 }
{ 18 18 20 20 }
}
canvas .c -width 20 -height 20
pack .c -expand 1
# create a screen to hide the nonvisible parts
.c create rect $::coords_bg -fill gray -tag screen
# create the animation elements
foreach color {blue green} {
set idx 0
foreach coord $::coords_ball {
.c create oval $coord -fill $color -tags [ list $color step$idx ]
incr idx
}
puts idx:$idx
}
animate1EKB That's fun!
HJG Changed old "repeat" to "animate".
RAI Circles are fun, but here's a running guy:
set ::width 100
set ::height 100
pack [ canvas .c -width $::width -height $::height]
update
.c create rect 0 0 $::width $::height -fill gray -tag BACKDROP
.c scale 1 50 50 2 2 ;# make it bigger
.c create oval 10 10 30 30 -outline {} -fill yellow -tag BACKDROP ;# sun
.c create line 20 20 30 30 -fill yellow -tag BACKDROP ;# sun
.c create line 20 20 20 35 -fill yellow -tag BACKDROP ;# sun
.c create line 20 20 35 20 -fill yellow -tag BACKDROP ;# sun
.c create line 20 20 10 35 -fill yellow -tag BACKDROP ;# sun
.c create line 20 20 35 10 -fill yellow -tag BACKDROP ;# sun
set ::cnt 0
set ::interval 100
proc animate2 {} {
set ::cnt [ expr { ($::cnt+1) % $::total } ]
.c raise BACKDROP
.c raise step$::cnt
after $::interval animate2
}
######################################################################
# draw a bunch of objects. make sure that all have -tags $::t
######################################################################
proc makeFrame {tag params} {
set ::t $tag ;# current tag
foreach {x0 y0 up kx ky fx fy k2x k2y f2x f2y ex ey hx hy} $params {} ;# funky tcl trick for assignment
set waist "$x0 [expr $y0 + $up]"
set neck [add $waist "-7 -15"] ; limb $waist $neck blue
set head [add $neck "-2 -4"] ; limb $head [add $head "-5 -5"] pink
set knee [add $waist "$kx $ky"] ; limb $waist $knee blue
set foot [add $knee "$fx $fy"] ; limb $knee $foot blue
set knee [add $waist "$k2x $k2y"] ; limb $waist $knee blue
set foot [add $knee "$f2x $f2y"] ; limb $knee $foot blue
set elbow [add $neck "$ex $ey"] ; limb $neck $elbow white
set hand [add $elbow "$hx $hy"] ; limb $elbow $hand white
}
proc x {lst} {lindex $lst 0}
proc y {lst} {lindex $lst 1}
proc add {xy1 xy2} { return "[expr [x $xy1]+[x $xy2]] [expr [y $xy1]+[y $xy2]]" }
proc line {xy1 xy2 width color} {
set id [.c create line [x $xy1] [y $xy1] [x $xy2] [y $xy2] \
-width $width -capstyle round -fill $color -tags $::t ]
.c addtag limb withtag $id
if {$color == "black" } { .c addtag outline withtag $id }
if {$color == "black" } { .c lower $id 1 }
}
proc limb {xy xy2 color} {
line $xy $xy2 9 black
line $xy $xy2 6 $color
}
############################################################
# parameters for each frame. input to proc makeFrame
# x0 y0 up kx ky fx fy k2x k2y f2x f2y ex ey hx hy
set ::params {
{ 55 60 0 0 15 0 20 -8 13 13 15 7 10 -15 4}
{ 55 60 -1 2 14 9 10 -11 9 2 16 3 11 -15 1}
{ 55 60 -2 5 14 18 9 -14 5 -8 18 -2 12 -15 -2}
{ 55 60 -1 -1 13 15 12 -7 10 -4 19 3 11 -15 2}
{ 55 60 0 -8 13 13 15 0 15 0 20 7 10 -15 4}
{ 55 60 -1 -11 9 3 17 3 14 9 10 9 6 -4 9}
{ 55 60 -2 -14 5 -8 18 5 14 18 9 12 2 -7 13}
{ 55 60 -1 -7 10 -4 19 -3 14 15 12 9 6 -11 9}
}
set ::total [llength $::params]
# create the animation frames
set idx 0
foreach p $::params {
makeFrame "step$idx" $p
incr idx
}
animate2
proc makeGiant {} {
.c config -width 400 -height 400
.c scale all 0 0 4 4
.c itemconfig limb -width 25
.c itemconfig outline -width 35
pack unpack .b
}
pack [button .b -text "make giant" -command makeGiant]