(August 2014), [pw] Here is an extension to the Tk canvas that facilitates animating canvas items, and it also includes a collection of easing functions. All of the functions currently listed at http://easings.net/ are implemented. Here is the code: https://gist.github.com/paulwal/0cdb41cab88bc655d003 And here is a fancy demo showing off the various easing functions: ====== proc orbit {c i sector} { switch -- $sector { nw {$c animate $i -xamount -150 -duration 1000 -easing outquad -command [list orbit $c $i sw] $c animate $i -yamount 40 -duration 1000 -easing inquad } sw {$c animate $i -xamount 150 -duration 1000 -easing inquad -command [list orbit $c $i se] $c animate $i -yamount 40 -duration 1000 -easing outquad } ne {$c animate $i -xamount -150 -duration 1000 -easing inquad -command [list orbit $c $i nw] $c animate $i -yamount -40 -duration 1000 -easing outquad } se {$c animate $i -xamount 150 -duration 1000 -easing outquad -command [list orbit $c $i ne] $c animate $i -yamount -40 -duration 1000 -easing inquad } } } proc shake {c times easing {amount 50}} { if { $times == 0 } {return} $c animate all -xamount $amount -duration 100 -easing $easing -command [list shake $c [expr {$times-1}] $easing [expr {-$amount}]] return } proc bounce {direction c item easing} { if { $direction eq "down" } {$c animate $item -yamount 130 -duration 800 -easing $easing -command [list bounce up $c $item $easing]} if { $direction eq "up" } {$c animate $item -yamount -130 -duration 800 -easing $easing -command [list bounce down $c $item $easing]} } proc ra {c id easing} { if { [$c find withtag $id] ne "" } { $c animate $id -xamount [expr {int((rand()*50)+(rand()*-50))}] -yamount [expr {int((rand()*30)+(rand()*-30))}] -duration [expr {int(rand()*1000)+200}] -command [list ra $c $id $easing] -easing $easing } } proc spawn {c amount easing} { for {set i 0} {$i < $amount} {incr i} { set id [$c create oval {750 510 760 520} -fill [random_color] -width 0] ra $c $id $easing after [expr {int(rand()*10000)+200}] [list $c delete $id] } return } proc bubbles {c amount} { set y1 [winfo height $c] set y2 [expr {$y1+5}] for {set i 0} {$i < $amount} {incr i} { set x1 [expr {int(rand()*([winfo width $c]/4))+([winfo width $c]/8*3)}] set x2 [expr {$x1+5}] set item [$c create oval $x1 $y1 $x2 $y2 -fill {} -outline "#ddd" -width 2] $c animate $item -easing inquad -yamount -[expr {$y1-30}] -duration [expr {int(rand()*5000)+2000}] -command [list $c delete $item] } return } # Returns a random 8-bit hex color. proc random_color {} { return [rgb_to_hex "[expr {int(rand()*65536)}] [expr {int(rand()*65536)}] [expr {int(rand()*65536)}]"] } # Convert a list of 16-bit RGB values to an 8-bit hex color. proc rgb_to_hex {rgb} { lassign $rgb r g b set r [format %02x [expr {$r/256}]] set g [format %02x [expr {$g/256}]] set b [format %02x [expr {$b/256}]] return #$r$g$b } proc demo {} { toplevel .t wm title .t "Animation Demo" set f [ttk::frame .t.f] set c [canvas .t.c -bg grey -highlightthickness 0 -width 950 -height 600] ttk::button $f.b1 -text "Camera Shake" -command [list shake $c 8 outquad] ttk::button $f.b2 -text "Bubbles" -command [list bubbles $c 10] ttk::button $f.b3 -text "Spawn" -command [list spawn $c 10 OUTQUAD] pack $f.b3 $f.b2 $f.b1 -side right -padx 10 pack $f -fill x pack $c -fill both -expand true set x 30 set y 15 set index 0 foreach easing [$c easings] { $c create text $x $y -text $easing set i [$c create oval [expr {$x-10}] [expr {$y+15}] [expr {$x+10}] [expr {$y+35}] -fill [random_color] -tags ball] bounce down $c $i $easing incr x 75 incr index if { $index % 12 == 0 } { set x 30 incr y 180 } } orbit $c [$c create oval {750 500 762 512} -fill "#333" -width 0] nw orbit $c [$c create oval {750 520 762 532} -fill "#ddd" -width 0] se return } demo ====== [pw] Run the code at the above link and then run the above demo code. There are 36 simultaneous animations in the demo until you start clicking buttons. My old Core2Duo CPU can handle roughly 100 simultaneous animations before it chokes. The framerate can also be reduced to improve performance. The main bottleneck appears to be in number-crunching the easing functions. I may convert this to a C extension at some point if there is a significant enough performance boost. ---- ====== #! /bin/env tclsh package require Tk 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 .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 bind .c animate pack .c -expand 1 ====== Slightly changed to show selection by tag combinations: ====== package require Tk 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 # 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 } bind .c animate1 pack .c -expand 1 ====== ---- [EKB] That's fun! [HJG] Changed old "repeat" to "animate". [RAI] Circles are fun, but here's a running guy: ====== #! /bin/env tclsh package require Tk 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 [list $x0 [expr $y0 + $up]] set neck [add $waist [list -7 -15]] ; limb $waist $neck blue set head [add $neck [list -2 -4]] ; limb $head [add $head [list -5 -5]] pink set knee [add $waist [list $kx $ky]] ; limb $waist $knee blue set foot [add $knee [list $fx $fy]] ; limb $knee $foot blue set knee [add $waist [list $k2x $k2y]] ; limb $waist $knee blue set foot [add $knee [list $f2x $f2y]] ; limb $knee $foot blue set elbow [add $neck [list $ex $ey]] ; limb $neck $elbow white set hand [add $elbow [list $hx $hy]] ; limb $elbow $hand white } proc x {lst} {lindex $lst 0} proc y {lst} {lindex $lst 1} proc add {xy1 xy2} { return [list [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 } 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 } ############################################################ # 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] set ::width 100 set ::height 100 set ::cnt 0 set ::interval 100 canvas .c -width $::width -height $::height # create the animation frames set idx 0 foreach p $::params { makeFrame step$idx $p incr idx } .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 button .b -text "make giant" -command makeGiant bind .c animate2 pack .c .b ====== [analognoise]: [RAI], The running man didn't work for me; did Tcl 8.6 break it? [AMG]: Worked fine for me in 8.6.1. <> Example | GUI | Animation