Move an item on a Canvas Widget in a Straight Line (animated)

Description

July 15th 2004 - MG After a quick search of the Wiki, I couldn't find a page explaining how to do this, so thought I'd knock something up myself. On a canvas widget, if you have an item which you want to move, it's simple enough to do; $widget move $item $xAmount $yAmount. But, if you want the movement to be animated - so that the item moves a bit at a time - it's a little more difficult. This is something I wanted for my Spider Solitaire game, so that the cards could be dealt in a slightly more noticable fashion; once I finish this page and get around to adding it to the game, you can see it for a working implimentation. (Hence the example :)

The proc below works so that the item on the canvas moves an even amount (by both X and Y) every time. The variables passed to it are $c (the path to the canvas widget), $item (the ID of the item on the canvas, returned by canvas create), $tox and $toy (the x and y coords to move to, respectively), $time (how long to wait between each move), and $steps, which can be moved to speed it up more (see below).

$steps works like this: if you're moving from coords 0 0 to coords 100 50, by default it'll move one x coordinate and half a y coordinate at a time: to 1 .5, 2 1, 3 1.5, etc. $steps will be multiplied by the default amount; so, with $steps set to 4, it'll move to 4 2, 8 4, 12 6, and so on. (No, explaining things I code isn't my strong point;)

(Update: it now also handles when you aren't moving at all in one direction; before it returned a 'divide by 0' error from the expr calls at the start.)

(July 16th: fixed a bug from the expr calls I was using at the end during the while loop, to check if it was in the right place, stemming from the problems discussed at Computers and real numbers)

Anyway, here's the code. :)

Code

#! /bin/env tclsh

# Mike Griffiths, July 15th 2004.
# Move an item on a canvas from one coordinate set to another, animated.

package require Tk

proc moving {c item tox dirx stepx toy diry stepy time} {
    scan [$c coords $item] "%s %s" nowx nowy
    if { $stepx == 0 && $stepy == 0} {return;}
    if { [expr {round(ceil($nowx-$tox))}] == 0 } {
        set stepx 0
    } elseif " [expr {$nowx+$stepx}] $dirx $tox " {
        set stepx [expr {$tox-$nowx}]
    }
    if { [expr {round(ceil($nowy-$toy))}] == 0 } {
        set stepy 0
    } elseif " [expr {$nowy+$stepy}] $diry $toy " {
        set stepy [expr {$toy-$nowy}]
    }
    $c move $item $stepx $stepy
    after $time moving $c $item $tox $dirx $stepx $toy $diry $stepy $time
}

proc cMove {c item tox toy {time 25} {steps 1}} {

    scan [$c coords $item] "%s %s" origx origy
    set diffx [expr {abs($origx-$tox)}]
    set diffy [expr {abs($origy-$toy)}]

    if { $diffx > $diffy } {
        set stepy [expr {$steps*1}]
        if { [expr { round(ceil($diffx + $diffy))}] == "0" } {
            set stepx 0
        } else {
            set stepx [expr {$steps*(double($diffx) / $diffy)}]
        }
    } else {
        set stepx [expr {$steps*1}]
        if { [expr {round(ceil($diffx+$diffy))}] == "0" } {
            set stepy 0
        } else {
            set stepy [expr {$steps*(double($diffy) / $diffx)}]
        }
    }
    set diry [set dirx >]
    if { $origx > $tox } {
        set stepx [expr {$stepx*-1}] ; set dirx "<"
    }
    if { $origy > $toy } {
        set stepy [expr {$stepy*-1}] ; set diry "<"
    }
    after $time moving $c $item $tox $dirx $stepx $toy $diry $stepy $time

};# cMove

image create photo myimg -format gif -data {
   R0lGODlhRwBgAKEAAH//1AAAAP////8AACH5BAEAAAAALAAAAABHAGAAAAL/BIKpy+0PYzBH2I
   uz3rz7L0wBSJamiZzquqbawMZyOL7zfbrYwOP+p7vwYL+iJijo9YxMWkZJbBaDy2RUiqMOh9if
   bgvuZmvW51XMcm2FXHRM3bZW3SokfUq+G+36MRsW15dTs7YmOGgBZnhYAqd4xujhqBjZSPZYab
   mzmAmUJ9ep+RQqStryaVqaioK66umKCKsqK9lKe2R7i8Gnu5vb6wTMwStMLLPI6WdESen1u4KJ
   6WMM/Sit/GN9fUOtot2M7fMdNv1cPY7HND7HbX5uvef+Tp4ute3cRR8vFrjP39XtVkBaA2UVhH
   XQVcJVC1M1NPWQVMRQEztVzHTxDqSMYm76ceTH6SOWayKbaLNQUh28YLROspRVqE1KlYCqzLxz
   k05ONztnIJMp79DPJT19nrEZVOjKl7C2FTXKxlcvKBmeQmVn1ejGpJH6MW25IavPsFwZlnVYQV
   hVChLaun3b1kABADs=}
 
canvas .c -height 500 -width 500 -bg "dark green"
set item [.c create image 100 100 -image myimg -anchor center]
bind .c <Map> [list cMove .c $item 250 375 10]
pack .c 
 

And a small demo...

pack [canvas .c -height 500 -width 500 -bg "dark green"]
 
image create photo myimg -format gif -data {
   R0lGODlhRwBgAKEAAH//1AAAAP////8AACH5BAEAAAAALAAAAABHAGAAAAL/BIKpy+0PYzBH2I
   uz3rz7L0wBSJamiZzquqbawMZyOL7zfbrYwOP+p7vwYL+iJijo9YxMWkZJbBaDy2RUiqMOh9if
   bgvuZmvW51XMcm2FXHRM3bZW3SokfUq+G+36MRsW15dTs7YmOGgBZnhYAqd4xujhqBjZSPZYab
   mzmAmUJ9ep+RQqStryaVqaioK66umKCKsqK9lKe2R7i8Gnu5vb6wTMwStMLLPI6WdESen1u4KJ
   6WMM/Sit/GN9fUOtot2M7fMdNv1cPY7HND7HbX5uvef+Tp4ute3cRR8vFrjP39XtVkBaA2UVhH
   XQVcJVC1M1NPWQVMRQEztVzHTxDqSMYm76ceTH6SOWayKbaLNQUh28YLROspRVqE1KlYCqzLxz
   k05ONztnIJMp79DPJT19nrEZVOjKl7C2FTXKxlcvKBmeQmVn1ejGpJH6MW25IavPsFwZlnVYQV
   hVChLaun3b1kABADs=}
 
set item [.c create image 100 100 -image myimg -anchor center]
cMove .c $item 250 375 10

History

PYK 2012-11-28: updated code to not use update idletasks (moved while loop into a separate proc)

Screenshots

HJG 2014-02-06: pix not available

Move-item-on-Canvas_ScrShot