# -----------------------------------------------------------------
 #
 # Mobile Objects
 #
 # -----------------------------------------------------------------
 #
 # author: Jere McDevitt
 #
 # License: LGPL
 #
 # -----------------------------------------------------------------
 #
 # The Sprite allows the creation of a Sprite object that may have
 # attached to it a sequence of images that simulate animation.
 #
 # The basic idea is that each Sprite object creates an internal
 # canvas for the specific size of the sprite.  For each image provided,
 # an image item is created on the canvas.
 #
 # The sprites expect to operate within a parent component that is using
 # the place manager, so it can move cleanly.  The sprites do not move outside
 # the borders of the parent.
 #
 # If a sprite is to be animated, it must be added to the animation list
 # using
 #
 #   mob::animate mob
 #
 # To start animation, you need to call
 #
 #   mob::updateAnimation
 #
 #
 # -----------------------------------------------------------------
 #
 # ToDo
 #
 #  Collision Detection
 #  Stop animation for a given sprite
 #
 # -----------------------------------------------------------------
 #
 # This code was written using tclkit-win32.upx.exe
 # Appreciate any feedback
 # -----------------------------------------------------------------
 package provide app-mob 1.0
 package require Itcl
 package require Tk

 namespace eval mob {
    itcl::class Sprite {
        #--------------------------------
        #Common variables for all Sprites
        #--------------------------------
        #gives each sprite a unique index
        private common _SpriteCount  0

        #used to support movement
        public common DIRECTIONS { north south east west northeast southeast northwest southwest}

        #holds the sprites to be animated
        private common animationList {}

        #User supplied name of sprite.  Combined with
        #parent ($parent.$name) when creating the canvas object.
        private variable name

        #Keyed array holding details of parent. Keys are:
        #    parent(name)   ->  parent path
        #    parent(width)  ->  [winfo reqwidth $parent(name)]
        #    parent(height) ->  [winfo reqheight $parent(name)]
        #
        private variable parent

        #Will hold images for this sprite.  Animation in in list order
        private variable images  {}
        #Keeps track of visible image
        private variable curImgIdx 0

        #Size and location of the sprite
        private variable xpos    0
        private variable ypos    0
        private variable height  0
        private variable width   0

        #Holds the created canvas object
        private variable cnvs

        #The direction the sprite is moving
        private variable dir  north

        #The id of the sprite
        private variable idx

        #---------------------------------------------
        # constructs a sprite and sets the internal
        # data.
        #
        # @param   w       width
        # @param   h       height
        # @param   nm      name for the sprite
        # @param   p       parent object
        #---------------------------------------------
        constructor { w h nm p} {
            set height $h
            set width $w
            set name $nm

            set parent(name) $p
            set parent(width) [winfo reqwidth $p]
            set parent(height) [winfo reqheight $p]
            set cnvs [ canvas $parent(name).$name \
                           -width $width \
                           -height $height \
                           -bg black \
                           -highlightthickness 0 \
                           -borderwidth 0
                          ]
            set idx $_SpriteCount
            incr _SpriteCount
            $cnvs create text 0 10 -text $idx -tag "label" -fill yellow -anchor nw -font { Tahoma 8 bold }
            set images {}
        }


        #---------------------------------------------
        # sets the list of images.  This method will
        # read count images from the map (really a
        # large image) using the row variable as the
        # default upper y coordinate.
        #
        # @param  imgMap    list of images to use
        # @param  row       upper y to read from
        # @param  count     number of image frames
        #---------------------------------------------
        public method setImages { imgMap row count } {
            $cnvs delete "label"
            set ypos [expr $row * $height]
            for { set i 0 } { $i < $count } { incr i } {
                set sox [expr $i * $width]
                set soy $ypos
                set sdx [ expr $sox + $width ]
                set sdy [ expr $soy + $height ]
                set img [ image create photo -height $height -width $width ]
                $img copy $imgMap -from $sox $soy $sdx $sdy
                set tn ""
                append tn $name "_" $i
                lappend images [ $cnvs create image 0 0 -image $img -tag $tn -state hidden -anchor nw]
            }
        }


        #---------------------------------------------
        # Hides the current visible image, and shows
        # the next image.  If at end of image list,
        # rotates back to first.
        #---------------------------------------------
        public method nextImage { } {
            if { [llength $images] != 0 } {
                $cnvs itemconfigure all -state hidden
                incr curImgIdx
                if {$curImgIdx >= [llength $images]} {
                    set curImgIdx 0
                }
                append tn $name "_" $curImgIdx
                $cnvs itemconfigure $tn -state normal
            }
        }

        #---------------------------------------------
        # Attempts to move the sprite to the specified
        # x,y position within the parent (uses place
        # command).  This returns a 2 element array
        # indicating whether there was a failure moving
        # in either direction {xresult yresult}.  The
        # elements are boolean (0 or 1), 0 indicates
        # success.
        #
        # @param   x       x position to move to
        # @param   y       y position to move to
        # @return 2-element list {xresult yresult}
        #---------------------------------------------
        public method moveTo { x y } {
            set res {0 0}
            place forget $parent(name).$name
            if { $x >= 0 && [expr $x + $width] <= $parent(width) } {
                set xpos $x
            } else {
                lset res 0 1
            }

            if { $y >= 0 && [expr $y + $height <= $parent(height)] } {
                set ypos $y
            } else {
                lset res 1 1
            }
            place $parent(name).$name -x $xpos -y $ypos
            return $res
        }

        #---------------------------------------------
        # This method is called to have the sprite
        # move in the direction it is currently facing.
        #
        # The default deltas are 1 for both x and y
        # direction, but others can be provided.  This
        # calls through to the moveTo method so it
        # returns the same return (2-element list)
        # as moveTo does
        #
        # @param  sx      x step to move by
        # @param  sy      y step to move by
        # @return 2-element list {xresult yresult}
        #---------------------------------------------
        public method move { {sx 1} {sy 1} } {
            set dx 0
            set dy 0
            switch $dir {
                north {
                    set dy [expr -$sx]
                }
                northwest {
                    set dy [expr -$sy]
                    set dx [expr -$sx]
                }
                northeast {
                    set dy [expr -$sy]
                    set dx $sx
                }
                south {
                    set dy $sy
                }
                southwest {
                    set dy $sy
                    set dx [expr -$sx]
                }
                southeast {
                    set dy $sy
                    set dx $sx
                }
                east {
                    set dx $sx
                }
                west {
                    set dx [expr -$sx]
                }
                default {
                    set dir north
                }
            }
            return [$this moveTo [expr $xpos + $dx] [expr $ypos + $dy] ]
        }

        #---------------------------------------------
        # Changes the direction the sprite is moving.
        #
        # @param  d   Direction to change to
        #---------------------------------------------
        public method setDir { d } {
            set dir $d
        }


        #---------------------------------------------
        # This method reverses the direction of the
        # sprite.  There are three choices for
        # determining the direction to reverse, as
        # defined by the 'which' argument:
        #
        #   which = both , do a full reverse
        #   which = x    , only reverse x direction
        #   which = y    , only reverse y direction
        #
        #   Note that the diagonal movements are the
        #   ones really affected by using either 'x' or
        #   'y' for which.
        #
        # @param  which    which axes to reverse
        # @return  new direction
        #---------------------------------------------
        public method reverseDir { {which both} } {
            switch $which {
                both {
                    switch $dir {
                        north { set dir south }
                        northwest { set dir southeast }
                        northeast { set dir southwest }
                        south { set dir north }
                        southwest { set dir northeast }
                        southeast { set dir northwest }
                        east { set dir west }
                        west { set dir east }
                    }
                }
                x {
                    switch $dir {
                        northwest { set dir northeast }
                        northeast { set dir northwest }
                        southwest { set dir southeast }
                        southeast { set dir southwest }
                        east { set dir west }
                        west {set dir east }
                    }
                }
                y {
                    switch $dir {
                        north { set dir south }
                        northwest { set dir southwest }
                        northeast { set dir southeast }
                        south { set dir north }
                        southwest { set dir northwest }
                        southeast { set dir northeast }
                    }
                }
            }
            return $dir
        }

        #---------------------------------------------
        # This common procedure is called by the after
        # command and it loops through the list of
        # of sprites calling the nextImage.  Animation
        # is fixed a twice per second.
        #---------------------------------------------
        public proc updateAnimation { } {
            foreach x $Sprite::animationList {
                $x nextImage
            }
            after 500 mob::Sprite::updateAnimation
        }

        #---------------------------------------------
        # This method is called to add a sprite to
        # the animation list.  A sprite is only
        # added once.
        #
        # @param ai     sprite to add
        #---------------------------------------------
        public proc animate { ai } {
            set idx [ lsearch $Sprite::animationList $ai ]
            if { $idx == -1 } {
                lappend Sprite::animationList $ai
            }
        }

        #---------------------------------------------
        # Simple method to generate a random
        # direction parameter.
        #---------------------------------------------
        public proc randDir { } {
            lindex $Sprite::DIRECTIONS [ expr {int(rand() * [llength $Sprite::DIRECTIONS])}]
        }
    }
 }

 #Create a simple canvas to test the sprites on
 set blocks {}
 wm title . "Sprite Test"

 #Frame works just as well
 canvas .c1 -width 640 -height 640 -bg white -highlightthickness 0 -borderwidth 0
 pack .c1 -expand 1 -fill both

 #If you want to have animated images rotating, create
 #a collection of images X by X in size (match the size with the
 #size of the block.  Can have as many frames in a row as wish.  Load
 #the image and apply.  For example, assume a strip of 4 32x32 images
 #call blocks.gif
 #
 #set path [file dirname [info script]]
 #set imgMap [ image create photo -file [file join $path blocks.gif]]

 for { set i 0 } { $i < 100 } { incr i } {
    set x [ mob::Sprite block$i 32 32 "block$i" .c1 ]

    # If have images, can use them
 #   $x setImages $imgMap 0 4
 #   mob::Sprite::animate $x

    $x moveTo [expr rand() * 640 ] [expr rand() * 640]
    $x setDir [ mob::Sprite::randDir ]

    #Add to an array for later access
    lappend blocks $x
 }
 #mob::Sprite::updateAnimation

 #Simple method to manage movement of blocks
 proc moveBlocks { ms } {
    global blocks
    set dx 1
    set dy 1
    foreach s $blocks {
        set dx [ expr rand() * 4]
        set dy [ expr rand() * 4]
        set block [lindex $s 0]
        foreach {x y} [ $block move $dx $dy] {
            if { $x == 1 || $y == 1 } {
                $block setDir [ mob::Sprite::randDir ]
            }
        }
    }
    after $ms moveBlocks $ms
 }

 #Must adjust movement with number of blocks.  If goes to
 #fast, canvas can't keep up
 after 100 { moveBlocks 100 }

 #if there is any animation, call this to kickstart it
 bind .c1 <KeyPress-q> {exit}
 focus .c1