sprites on canvas test

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 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 upvars 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...

ZB On my slow "reference machine" (Pentium II 400) although I had to limit sprites amount to 100, but at the same time changed refresh from 80 to 50 ms. Yes, the result is much better now.

slebetman Modified "anim" loop. Added framerate indicator. Now we can see canvas performance on individual machines (and it also gives us a benchmark for future modifications). Post your frame rates 500, 250 and 100 sprites! (And a brief description of your machine).

ZB Pentium II 400, Linux, ATI Radeon 9200 Pro - 250 sprites: 3,26 fps, 500: 1,87 fps, 100: 8,11 fps
DKF: 2.6GHz Intel Core 2 Duo, OSX 10.5.6, GeForce 8600M GT — 250 sprites: 12.74 fps, 500: 5.19, 100: 33 fps (approx: highly variable...)
Martyn Smith: 2.5GHz Intel Core 2 Duo (T9300), XP SP3, Intel 965 — 250 sprites: ~38 fps, 500: ~16, 100: ~70 fps (At the default resolution the bigger the window the slower they go!) (I have VMware, Outlook and Word as well). Donal if you have an iMac it is probably an M(for mobile) processor like the Graphics card.
DKF: I have a MacBook Pro; it's really a C2D.
slebetman: Hmm.. fixed the frame rate calculation to use long term average. Now the frame rate tends to stabilize after a couple of minutes making it easier to read. Anyway, here's my reading: 1.75GHz Pentium M, Windows XP NVidia GForce Go 6200 - 250 sprites: 26.04, 500: 9.80, 100: 42.25.
ralfixx Intel(R) Pentium(R) D CPU 2.80GHz 1MB Cache, Intel 82945G/GZ Integrated Graphics Controller, OpenSuse 11.1: 500 sprites 11 fps, 100 sprites 50 fps.
slebetman: In the "step" proc, changing:

    # from:
    #.c coords $units($id.sprite.tag) $units($id.x) $units($id.y)
    # to:
    .c move $units($id.sprite.tag) $xx $yy

gets me roughly double the framerate!

ZB Not so big boost on my machine - but still about 50% better, therefore it cannot be ignored.

ZB Using this code we can make a bit different test: what influence has sprite size. For example: how would be framerate, when the sprite will be 4 times larger, thus having 16x more pixels.


Code

#! /usr/bin/env wish

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

# 500 9.80
# 250 26.04
# 100 42.25

set NUMBER_OF_SPRITES 500
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 #999999 -anchor nw
set ratemsg [.c create text 20 40 -fill #999999 -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]
        catch {.c lower $item topitems}   ;# [Larry Smith] 1st time through no topitems defined
        .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}]
    ]
}

set timestamp [clock milliseconds]
set framerate 1
set framecount 0
proc anim {} {
    global units unit_ids timestamp framerate ratemsg framecount
    foreach x $unit_ids {
        step $x
    }
    sortCanvas
    incr framecount
    
    # Take sample every 10 frames:
    if {($framecount % 10) == 0} {
        set now [clock milliseconds]
        set thisrate [expr {$framecount*1000.0/($now-$timestamp)}]
        # Allow for +/- 1 fps jitter:
        if {abs($thisrate-$framerate) > 1} {
            set framerate $thisrate
            .c itemconfigure $ratemsg -text [format "%0.2f fps" $framerate]
        }
        # Reset counter every 2 million frames to avoid overflows
        # (We don't want bigint to slow us down):
        if {$framecount > 2000000} {
            set framecount 0
            set timestamp $now
        }
    }
    after 10 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
}