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

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