Skip to content

Instantly share code, notes, and snippets.

@paulwal
Last active Aug 29, 2015
Embed
What would you like to do?
Extend the Tk canvas to enable animations
# canvas_animate.tcl
# Animate canvas items.
#
# Usage:
# <canvas> animate <tagOrId> ?-xamount <pixels>? ?-yamount <pixels>? ?-duration <milliseconds>? ?-easing <function name>? ?-command <command>?
# <canvas> easings
# -> <list of easing function names>
# Rename the original 'canvas' command and redefine it to create a new object in this class.
# The object name will be identical to the path of the canvas, and the canvas command will
# continue to work identically as before.
rename canvas canvas_
proc ::canvas {path args} {
# Create a canvas_animate object which has the same name as the desired Tk path.
set obj [canvas_animate create tmp $path {*}$args]
rename $obj ::$path
return $path
}
namespace import oo::*
class create canvas_animate {
variable widget
variable tick_rate
variable tick_afterid
variable jobs
variable counter
constructor {path args} {
set widget ${path}_
set tick_rate 17
set jobs [list]
set counter 1
# Create a real canvas widget.
canvas_ $path {*}$args
rename $path $widget
# Destroy this object when the canvas widget is destroyed.
bind $path <Destroy> [list $path destroy]
# Start the animation loop.
set tick_afterid [after idle $path tick]
}
destructor {
after cancel $tick_afterid
destroy $widget
}
# Forward all unknown subcommands to the real canvas widget.
method unknown {args} {
return [$widget {*}$args]
}
# Animate the movement of canvas items.
method animate {tagOrId args} {
set job [my Process_args $args {
xamount 0
yamount 0
duration 400
easing outquad
command {}
}]
dict set job tag $tagOrId
dict set job started [clock microseconds] ;# Mark the start time.
dict set job xmoved 0 ;# Track the total change in movement
dict set job ymoved 0 ;# in both directions.
dict set jobs [incr counter] $job
return
}
# Perform one animation frame.
method tick {} {
set tick_afterid [after $tick_rate [self] tick]
dict for {id job} $jobs {
dict with job {}
# Calculate the amount to move in each direction.
set elapsed [expr {[clock microseconds]-$started}]
set duration [expr {$duration*1000}]
if { $elapsed > $duration } {
set elapsed $duration
}
set xmoved_new 0
set ymoved_new 0
if {$xamount} {set xmoved_new [my Easing $easing $elapsed 0 $xamount $duration]}
if {$yamount} {set ymoved_new [my Easing $easing $elapsed 0 $yamount $duration]}
set x [expr {$xmoved_new-$xmoved}]
set y [expr {$ymoved_new-$ymoved}]
# Save the total amount moved.
dict set jobs $id xmoved $xmoved_new
dict set jobs $id ymoved $ymoved_new
# Move the item(s) on the canvas.
[self] move $tag $x $y
# Delete the job if it is complete.
if { ($xmoved==$xmoved_new && $ymoved==$ymoved_new) } {
set jobs [dict remove $jobs $id]
namespace eval :: $command
}
}
return
}
# Returns a list of available easing functions.
method easings {} {
return [list \
inquad outquad bothquad \
incubic outcubic bothcubic \
inquart outquart bothquart \
inquint outquint bothquint \
insine outsine bothsine \
inexpo outexpo bothexpo \
incirc outcirc bothcirc \
inelastic outelastic bothelastic \
inback outback bothback \
inbounce outbounce bothbounce \
linear swing \
]
}
# Easing functions.
# See: http://easings.net/
# t: elapsed time, b: beginning value, c: change In value, d: duration
method Easing {type t b c d} {
switch -nocase -- $type {
linear {
return [expr {1.000* $t/$d *$c+$b}]
}
swing {
return [expr {(0.5-cos(1.000*$t/$d*3.1416)/2)*$c+$b}]
}
inQuad {
set t [expr {1.000* $t/$d}]
return [expr {1.000* $c*$t*$t+$b}]
}
outQuad {
set t [expr {1.000* $t/$d}]
return [expr {1.000* -$c *$t*($t-2) +$b}]
}
bothQuad {
set t [expr {1.000* $t/($d/2)}]
if { $t < 1 } { return [expr {$c/2*$t*$t+$b}] }
return [expr {-$c/2 * (($t-1)*($t-3) - 1) + $b}]
}
inCubic {
set t [expr {1.000* $t/$d}]
return [expr {$c*$t*$t*$t+$b}]
}
outCubic {
set t [expr {1.000* $t/$d-1}]
return [expr {$c*($t*$t*$t+1)+$b}]
}
bothCubic {
set t [expr {1.000* $t/($d/2)}]
if {$t < 1} {return [expr {$c/2*$t*$t*$t+$b}]}
set t [expr {$t-2}]
return [expr {$c/2*($t*$t*$t+2)+$b}]
}
inQuart {
set t [expr {1.000* $t/$d}]
return [expr {$c*$t*$t*$t*$t+$b}]
}
outQuart {
set t [expr {1.000* $t/$d-1}]
return [expr {-$c*($t*$t*$t*$t-1)+$b}]
}
bothQuart {
set t [expr {1.000* $t/($d/2)}]
if {$t < 1} {return [expr {$c/2*$t*$t*$t*$t+$b}]}
set t [expr {$t-2}]
return [expr {-$c/2*($t*$t*$t*$t-2)+$b}]
}
inQuint {
set t [expr {1.000* $t/$d}]
return [expr {$c*$t*$t*$t*$t*$t+$b}]
}
outQuint {
set t [expr {1.000* $t/$d-1}]
return [expr {$c*($t*$t*$t*$t*$t+1)+$b}]
}
bothQuint {
set t [expr {1.000* $t/($d/2)}]
if {$t < 1} {return [expr {$c/2*$t*$t*$t*$t*$t+$b}]}
set t [expr {$t-2}]
return [expr {$c/2*($t*$t*$t*$t*$t+2)+$b}]
}
inSine {
return [expr {-$c* cos(1.000* $t/$d*(3.1416/2))+$c+$b}]
}
outSine {
return [expr {$c* sin(1.000* $t/$d*(3.1416/2))+$b}]
}
bothSine {
return [expr {-$c/2 * (cos(3.1416*$t/$d)-1)+$b}]
}
inExpo {
if {$t==0} {
return $b
} else {
return [expr {$c * pow(2, 10*(1.000* $t/$d-1))+$b}]
}
}
outExpo {
if {$t==$d} {
return [expr {$b+$c}]
} else {
return [expr {$c*(-pow(2, 1.000* -10*$t/$d)+1)+$b}]
}
}
bothExpo {
if {$t==0} {return $b}
if {$t==$d} {return [expr {$b+$c}]}
set t [expr {1.000* $t/($d/2)}]
if {$t < 1} {
return [expr {$c/2 * pow(2, 10*($t-1))+$b}]
}
return [expr {$c/2 * (-pow(2, -10*($t-1))+2)+$b}]
}
inCirc {
set t [expr {1.000* $t/$d}]
return [expr {-$c*(sqrt(1-$t*$t)-1)+$b}]
}
outCirc {
set t [expr {1.000* $t/$d-1}]
return [expr {$c*sqrt(1-$t*$t)+$b}]
}
bothCirc {
set t [expr {1.000* $t/($d/2)}]
if {$t < 1} {
return [expr {-$c/2 * (sqrt(1-$t*$t)-1)+$b}]
}
set t [expr {$t-2}]
return [expr {$c/2 * (sqrt(1-$t*$t)+1)+$b}]
}
inElastic {
set s 1.70158
set p 0.000
set a $c;
if {$t==0} {return $b}
set t [expr {1.000* $t/$d}]
if {$t==1} {return [expr {$b+$c}]}
if {!$p} {set p [expr {$d*.3}]}
if {$a < abs($c)} {
set a $c
set s [expr {$p/4}]
} else {
set s [expr {$p/(2*3.1416) * asin($c/$a)}]
}
set t [expr {$t-1}]
return [expr {-($a*pow(2,10*$t) * sin(($t*$d-$s)*(2*3.1416)/$p))+$b}]
}
outElastic {
set s 1.70158
set p 0.000
set a $c
if {$t==0} {return $b}
set t [expr {1.000* $t/$d}]
if {$t==1} {return [expr {$b+$c}]}
if {!$p} {set p [expr {$d*.3}]}
if {$a < abs($c)} {
set a $c
set s [expr {$p/4}]
} else {
set s [expr {$p/(2*3.1416) * asin($c/$a)}]
}
return [expr {1.000*$a*pow(2,-10*$t)*sin(($t*$d-$s)*(2*3.1416)/$p)+$c+$b}]
}
bothElastic {
set s 1.70158
set p 0.000
set a $c
if {$t==0} {return $b}
set t [expr {1.000* $t/($d/2)}]
if {$t==2} {return [expr {$b+$c}]}
if {!$p} {set p [expr {$d*(.3*1.5)}]}
if {$a < abs($c)} {
set a $c
set s [expr {$p/4}]
} else {
set s [expr {$p/(2*3.1416) * asin($c/$a)}]
}
if {$t < 1} {
set t [expr {$t-1}]
return [expr {-.5*($a*pow(2,10*$t) * sin(($t*$d-$s)*(2*3.1416)/$p))+$b}]
}
set t [expr {$t-1}]
return [expr {$a*pow(2,-10*$t) * sin(($t*$d-$s)*(2*3.1416)/$p)*.5+$c+$b}]
}
inBack {
if {![info exists s]} {set s 1.70158}
set t [expr {1.000* $t/$d}]
return [expr {$c*$t*$t*(($s+1)*$t-$s)+$b}]
}
outBack {
if {![info exists s]} {set s 1.70158}
set t [expr {1.000* $t/$d-1}]
return [expr {$c*($t*$t*(($s+1)*$t+$s)+1)+$b}]
}
bothBack {
if {![info exists s]} {set s 1.70158}
set t [expr {1.000* $t/($d/2)}]
if {$t < 1} {
set s [expr {$s*1.525}]
return [expr {$c/2*($t*$t*(($s+1)*$t-$s))+$b}]
}
set s [expr {$s*1.525}]
set t [expr {$t-2}]
return [expr {$c/2*($t*$t*(($s+1)*$t+$s)+2)+$b}]
}
inBounce {
set t [expr {$d-$t}]
return [expr {$c - [my Easing outbounce $t 0 $c $d] +$b}]
}
outBounce {
set t [expr {1.000* $t/$d}]
if {$t < (1/2.75)} {
return [expr {$c*(7.5625*$t*$t)+$b}]
} elseif {$t < (2/2.75)} {
set t [expr {$t-(1.5/2.75)}]
return [expr {$c*(7.5625*$t*$t+.75)+$b}]
} elseif {$t < (2.5/2.75)} {
set t [expr {$t-(2.25/2.75)}]
return [expr {$c*(7.5625*$t*$t+.9375)+$b}]
} else {
set t [expr {$t-(2.625/2.75)}]
return [expr {$c*(7.5625*$t*$t+.984375)+$b}]
}
}
bothBounce {
if {$t < $d/2} {
set t [expr {$t*2}]
return [expr { [my Easing inbounce $t 0 $c $d] *.5+$b}]
}
set t [expr {$t*2-$d}]
return [expr { [my Easing outbounce $t 0 $c $d] *.5+$c*.5+$b}]
}
}
}
# Process method arguments. Returns a dict of options.
method Process_args {args defaults} {
set options $defaults
dict for {key value} $args {
set option $key
set key [string range $key 1 end]
if { [dict exists $options $key] } {
dict set options $key $value
} else {
error "invalid option: $option; must be: [join [dict keys $defaults] {, }]"
}
}
return $options
}
}
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment