**An Experiment**

This code is rather long. It draws several sprites (configurable by modifying `NUMBER_OF_SPRITES`) and animate them. Currently on my 1.5GHz PC the [canvas] can comfortably handle up to 50 sprites at once. This does roughly 12 frames per second on my PC.

This is really a proof of concept rather than anything useful. This is roughly a straightforward translation of one of my [javascript] projects (which explains why I'm using [dicthash: Yet another lightweight object system%|%dicthash%|%] and why the code looks weird).

[ZB] Nice. But indeed: in the present form for faster machine rather (I had to lower the amount of sprites). Of course, one can easily speed it up, by calculating the movement data in advance, and feed that LCP (little computer people ;) with ready-to-use data. Yes, I realize, that it'll set the time limit for demo duration.

[slebetman] 29 April 2009: I removed all the dicthash stuff to improve performance. Now this easily handles upwards of 300 sprites on my machine. It turns out that all those [upvar]s were killing me.

[DKF]: I must have a faster processor, as it does 100 handily for me (and only chugs a little at 200) even with the old version. I do wonder how much more efficient this would be with one of the other OO systems that's been designed for runtime efficiency...
----
***Code***
======
#! /usr/bin/env wish

# Changelog:
# slebetman 29 April 2009: Modified to non-oo code, saw greatly improved speed.

package require math::constants
math::constants::constants pi

set NUMBER_OF_SPRITES 300
set CANVAS_WIDTH 800
set CANVAS_HEIGHT 600

proc angleFromDelta {dx dy} {
        set hyp [distanceFromDelta $dx $dy]
        set theta [expr {asin($dy/$hyp)}]
        if {$dx<0} {
                set theta [expr {$::pi-$theta}]
        } elseif {$dy<0} {
                set theta [expr {$::pi*2+$theta}]
        }
        return $theta
}

proc angleDiff {theta gamma} {
        expr {acos(cos($theta-$gamma))}
}

proc sectorFromAngle {angle numberOfSectors} {
        set sec [expr {round(($angle/(2*$::pi))*$numberOfSectors)}]
        if {$sec == $numberOfSectors} {
                set sec 0
        }
        return $sec
}

proc distanceFromDelta {dx dy} {
    expr {sqrt($dx*$dx + $dy*$dy)}
}

proc distance {xy1 xy2} {
    distanceFromDelta \
                [expr {[lindex $xy1 0]-[lindex $xy2 0]}] \
                [expr {[lindex $xy1 1]-[lindex $xy2 1]}]
}

set SPRITE_SECTORS 8

pack [canvas .c -bg white -width $CANVAS_WIDTH -height $CANVAS_HEIGHT] -fill both -expand 1
.c create text 20 20 -text "Type 'f' to toggle full-screen mode" -fill #cccccc -anchor nw

proc copySprite {src dst width height x y {composite set}} {
        set w [expr {$width-1}]
        set h [expr {$height-1}]
        set startx [expr {$x*$width}]
        set starty [expr {$y*$height}]
        set endx [expr {$startx+$width}]
        set endy [expr {$starty+$height}]
        $dst copy $src \
                -from $startx $starty $endx $endy \
                -to 0 0 $width $height \
                -compositingrule $composite
}

set IMAGE_COL 3
set IMAGE_ROW 8
set IMAGE_WIDTH 12
set IMAGE_HEIGHT 24
image create photo boy -data {
R0lGODlhJADAAMIEAAAHA8iicunUw/7//P///////////////yH5BAEKAAQALAAAAAAkAMAAAAP+
SKrQ+zBKCYIF1E3ScKzWBYGB94XmAgpsSopjCKvWAAiuxeJnsKccH45HC9iID9ARWNkhg60nQ3hj
OktJYevkBEKltx12dGVqvU0pbUtmjdfs2O/jFrw5Yi9+3g673BpZQ2p+cQ1lZCUtZopEFVU+d01p
gQwNVFM3JZV4jYSIll0faYRnbXZoOnFJfFOAd0FpsHuoDHkoRSWYMbhBFyQmwL0jHUkaxcYYyBvM
zc7P0BvL0dDAE9PEei+z1j3cMrDbjMNQWpLg4zNQNktr5sGReXBVSE3sVWv3T2GtX/TwUfDBWUWL
ID+CX8JpAbPQDCg43wAJcrKP4r6GrCjCONj+j1S9eD8c2blSj1KwKD+wFAoJj1KRg8cudHkDoqYx
jCo8VmqyyYqojP2+1AK6imdHIbtU1KmIIympMJJaqAPGBxjPHD1HXZqBzKaxZ9iIURvLLCzZa+SS
SeM0RUYqdbnephXHi5wmMRfd1p0qYMmAeiPrnDT3cYimk34BJ/7z0xU9mj4e55BHFAzFVEMnZnYl
UXPEWeUcPhSqkLItiwAfeszM0ZBGwAsdgRypUhWqWpPMqUQ5SJknqL55P/LFz+shqZB/ByO1CWjz
m0GhGhwt1HLvNklPZ9/jpw/cmgYvfP+lbSsaZeXB6jnLvj0HtjnXv1/fra62tL7moturUG/+Fv+5
TEUYZHgRWAdNOLDDWoIA/IVggw0uSI+EgzxYIWPRXXbKdKad1plSHSaE2WaclRbiQVFpCOJoKGL4
0woqhoLKYCR5MOGBJ6FiYUg8PNKFIeJBBtNGQ9J0yWbHAeLic5yRyJFPGQaWIm0uXsQbgrcxld1V
3RRnl0x52RiIVWx18J1886nn3prumWUJmmbV9x9o+aXTH350rfidGNzw+UeDewLap6B/fmgLcHQg
uqKT1BV0TmNNlgLpHqApSgeJtPRpqJ6ifRJUk5Ntxx2mRzLVnTFSMdRFjqfmBAiSkUBiI3JopATG
kcNRGhY/TC46Jk7ORcShk0h5lUmxQEH+qUsvwlRlypy+bYRClwDGZ+2103SAJpvcdtuem2leA1+d
FOBHLn92povuunMKCE5y+7UVbyfzalKvHfdGMsxdAPJrlxt74hsOwAML7NNcBIsmrKbEsojahlOa
1pqVH8L4YmCCQYfDSSjiNghKLTnlyXU+ppScse/NNEaSMwqSFVG9PnlKwFFS6aqUVR586lMSL4Uh
tbHWB15ePWElJhPmZbNWNdt6q5XT0IorX5zzxlUuXPmNV23WUYFDtNb/ej2YDLCRPXYIZaN9tg5/
qM2K2ErBPdDAbr/NNhcMDxteiKGV2zCL78hh6MSpSRwbljFyFFncKhqFoy954BaZbsrDCLdFyRf6
k1K0Xq7cOTzK5fQOhr2+9yyI27UoOIetasdh6iB711/rxGkdZ9JiwTeuWFAz3TR7cqol9dV4mhs8
1+q2e867WOlX7TaLy9vvu/DGA7rZAd6dS1FkR5/1SM2Hp8o4CMlCPkPjr/63pLA+PJB1jbXGVeCL
OouxYTfHfP/iK0mVoy6s+hHnVvUfYw3Nf5YA1ptipbFFVIYRNdMbxagAkNO5rjBXmlVTWDe/X+jL
Rig4ysuwNRUznYlpa/kdtxIAADs=
}

# Split image tile into individual sprites:
array set sprites {}
for {set x 0} {$x < $IMAGE_COL} {incr x} {
        for {set y 0} {$y < $IMAGE_ROW} {incr y} {
                set sprites(boy.$x.$y) [image create photo \
                        -width $IMAGE_WIDTH -height $IMAGE_HEIGHT
                ]
                copySprite boy $sprites(boy.$x.$y) $IMAGE_WIDTH $IMAGE_HEIGHT $x $y
        }
}        

proc count {stepcount} {
        expr {($stepcount+1)%120}
}

proc step {id} {
        global units
        if {$units($id.dest.x) == {} || $units($id.dest.y) == {}} {
                return 0
        }
        
        set x $units($id.x)
        set y $units($id.y)
        
        set dx [expr {$units($id.dest.x)-$x}]
        set dy [expr {$units($id.dest.y)-$y}]
        
        set distance [distanceFromDelta $dx $dy]
        
        if {$distance < $units($id.speed)} {
                # Arrived at destination, stop moving.
                set units($id.dest.x) {}
                set units($id.dest.y) {}
                return 0
        }
        
        if {($units($id.stepcount) % 5) == 0} {
                setVector $id $dx $dy
        }
        
        set xx $units($id.vector.x)
        set yy $units($id.vector.y)
        
        set xx [expr {$xx*$units($id.speed)}]
        set yy [expr {$yy*$units($id.speed)}]
       
        set units($id.x) [expr {$x+$xx}]
        set units($id.y) [expr {$y+$yy}]
        
        .c coords $units($id.sprite.tag) $units($id.x) $units($id.y)
        
        set units($id.stepcount) [count $units($id.stepcount)]
       
        set walkstate [expr {$units($id.stepcount) % 4}]
        switch -- $walkstate {
                0 {set units($id.sprite.x) 0}
                1 {set units($id.sprite.x) 1}
                2 {set units($id.sprite.x) 0}
                3 {set units($id.sprite.x) 2}
        }
        renderImg $id
       
        return 1
}
            
proc setVector {id dx dy} {
        global units
        math::constants::constants pi
        
        set theta [angleFromDelta $dx $dy]
        
        set units($id.sprite.y) [sectorFromAngle $theta $::SPRITE_SECTORS]
        renderImg $id
        
        set gamma [expr {(double($units($id.sprite.y))/$::SPRITE_SECTORS)*2*$::pi}]
        
        set units($id.vector.x) [expr {cos($gamma)}]
        set units($id.vector.y) [expr {sin($gamma)}]
}
    
proc renderImg {id} {
        global units
        global sprites
        
        .c itemconfigure $units($id.sprite.tag) \
                -image $sprites($units($id.sprite.img).$units($id.sprite.x).$units($id.sprite.y))
}

array set units {}
set unit_ids {}
proc makeUnit {id {spec {}}} {
        global units unit_ids
        set spec [dict merge {
                size 50
                x 100
                y 100
                vector.x 0
                vector.y 1
                speed 3
                dest.x {}
                dest.y {}
                sprite.img boy
                sprite.tag ""
                sprite.x 0
                sprite.y 2
                stepcount 0
        } $spec]

        foreach {key val} $spec {
                set units($id.$key) $val
        }                
        
        set units($id.sprite.tag) [.c create image $units($id.x) $units($id.y)]
        
        lappend unit_ids $id
        
        renderImg $id
}

proc sortCanvas {} {
        # raise/lower units based on y-coordinates
        global units unit_ids
        set ylist {}
        foreach x $unit_ids {
                lappend ylist [list $units($x.sprite.tag) $units($x.y)]
        }
        set ylist [lsort -decreasing -real -index 1 $ylist]
        foreach x $ylist {
                set item [lindex $x 0]
                .c lower $item topitems
                .c addtag topitems withtag $item
        }
        .c dtag topitems
}

for {set x 0} {$x < $NUMBER_OF_SPRITES} {incr x} {
        makeUnit $x [list \
                x [expr {rand()*$::CANVAS_WIDTH}] \
                y [expr {rand()*$::CANVAS_HEIGHT}]
        ]
}

proc anim {} {
        global units unit_ids
        foreach x $unit_ids {
                step $x
        }
        sortCanvas
        after 80 anim
}
anim

# periodically give people random destinations
proc motivate {} {
        global units unit_ids
        foreach x $unit_ids {
                if {rand() > 0.7} {
                        set units($x.dest.x) [expr {rand()*[winfo width .c]}]
                        set units($x.dest.y) [expr {rand()*[winfo height .c]}]
                }
        }
        after 1000 motivate
}
motivate

bind . <Key-c> {
        catch {console show}
}
set fullscreen 0
bind . <Key-f> {
        set ::fullscreen [expr {!$::fullscreen}]
        wm attributes . -fullscreen $::fullscreen
}
======

----
!!!!!!
%| [Category Animation] |%
!!!!!!