Extend the Tk canvas to enable animations

canvas_animate.tcl

# 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
    }
}