[JAG], 20-Feb-2005 - Prompted by the [Asteroids] page, I decided to cleanup and release an Asteroids clone I wrote about a year ago.  Other than the fact that it's still missing the enemy ship that should roll through the galaxy every so often, it's a fairly accurate remake of the original Atari arcade game, right down to the vector style graphics and cheesey sound effects.  The code's a bit ugly and not well commented, but I doubt I'll ever get around to cleaning it up, so here it is - as is...

'''Sound'''

If you just cut/paste the source code below, the game will run, but without sound effects.  In order to get the sounds, you'll need to download a small group of sound files from [http://www.iland.net/~jgodfrey/asteroid_sounds.zip].  Also, you'll need to have the [Snack] sound library available.  Just place the archive contents in the same directory as the source code.  If [Snack] or the sound files can't be located, the sound will be disabled automatically.

'''Animation Info'''

The code uses "timeslice" style animation.  That is, it monitors the internal framerate and makes appropriate adjustments to the animation cycles in order to make the game "feel" approximately the same regardless of the horsepower of the host CPU.  While this method seems to work reasonably well, it does break down on fairly low-end systems.  For instance, the game runs *great* on my 3.0 GHz P4, but is somewhat choppy (though playable) on my 300 MHz P2.  The current framerate is displayed at the bottom of the screen.

'''Levels'''

The levels in the game are fairly basic, in that with each new level you just get more asteroids, that (can) move faster.  Since the levels are programatically created, there's always another level, and you '''will''' eventually lose.

'''Controls'''
   * Left Arrow  - rotate CCW
   * Right Arrow - rotate CW
   * Up Arrow    - Thrust
   * Space - Fire
   * Down Arrow  - Hyperspace (moves ship to a random screen coordinate)

'''High Scores'''

The game maintains the top 10 high scores in a file named "asteroids_hs.txt", which is stored in the same folder as the source code and sound files.

'''Screen Shot'''

[http://www.iland.net/~jgodfrey/asteroids_small.jpg]

----
[JAG], 22-Feb-2005 - A few minor updates...

    * Score and level information are now '''drawn''' for a more authentic look
    * Our hero (that'd be you...) can earn an extra ship every 10,000 points
----

'''Code'''

 #############################################################################
 #
 # Asteroids.tcl - Tcl remake of the Atari arcade game classic
 # Jeff Godfrey, Feb-2005
 #
 # Revision History
 #
 # 22-Feb-2005
 #       - Score and level info is now *drawn* for a more authentic look
 #       - Extra ship every 10,000 points
 #       - Added "Help | About" menu
 #       - Fixed bug when "High Score" dialog is closed using window decoration
 #
 # 20-Feb-2005
 #       - Initial release to Tcl Wiki
 #
 #############################################################################

 package require Tk

 proc main {} {
     initVars
     testForSounds
     calcMotionVectors
     buildUI
     bindGameKeys
     showMenu
     loadHighScores
     updateScore
     updateLives

     after 1000 updateFPS
     gameLoop
 }

 proc appExit {} {
     set ::globals(gameOn) 0
     exit
 }

 proc gameOver {} {
     heartBeatOff
     checkHighScore
 }

 proc bindNavKeys {mode} {
     if {$mode eq "menu"} {
         bind . <KeyPress-Escape> {}
         bind . <KeyPress-N> newGame
         bind . <KeyPress-n> newGame
         bind . <KeyPress-E> appExit
         bind . <KeyPress-e> appExit
         bind . <KeyPress-H> displayHighScores
         bind . <KeyPress-h> displayHighScores
     } elseif {$mode eq "highScores"} {
         bind . <KeyPress-Escape> showMenu
         bind . <KeyPress-N> {}
         bind . <KeyPress-n> {}
         bind . <KeyPress-E> {}
         bind . <KeyPress-e> {}
         bind . <KeyPress-H> {}
         bind . <KeyPress-h> {}
     } elseif {$mode eq "game"} {
         bind . <KeyPress-Escape> {}
         bind . <KeyPress-N> {}
         bind . <KeyPress-n> {}
         bind . <KeyPress-E> {}
         bind . <KeyPress-e> {}
         bind . <KeyPress-H> {}
         bind . <KeyPress-h> {}
     }
 }
console show
 proc checkHighScore {} {
     loadHighScores
     set lowScoreSet [lindex $::globals(highScores) end]
     set lowScore [lindex $lowScoreSet 1]
     if {$::globals(score) > $lowScore} {
         set w .hs
         toplevel $w -borderwidth 10
         wm title $w "New High Score!"
         wm resizable $w 0 0
         set l [label $w.label -text "Name:"]
         set e [entry  $w.entry -textvar ::_name -width 30]
         set b [button $w.btnOK -text OK -width 12 \
            -command {set _res ""}]
         grid   $l $e -sticky news -padx 4 -pady 2
         grid   $b -column 1 -sticky e -padx 4 -pady 2
         bind $w <Return> [list $w.btnOK invoke]
         bind $w <Destroy> {set _res ""}
         $e selection range 0 end
         $e icursor 0
         focus -force $e
         raise $w
         grab set $w
         vwait _res
         destroy $w
         if {$::_name eq ""} {set ::_name "Unknown"}
         lappend ::globals(highScores) [list $::_name $::globals(score)]
         set ::_name ""
         cleanHighScores
         saveHighScores
         displayHighScores
     } else {
         showMenu
     }
 }
 proc displayHighScores {} {

     bindNavKeys highScores
     loadHighScores
     .c1 delete menu
     set scoreString ""
     set count 0
     set yLoc [expr {(($::globals(screenHeight) / 2) - \
         (([llength $::globals(highScores)] / 2) * 30))}]
     foreach scoreSet $::globals(highScores) {
         foreach {name score} $scoreSet {
             incr count
             set score [format %07d $score]
             .c1 create text 300 $yLoc -text "${count}." -anchor e \
                 -font {Arial 14} -fill white -tag highScore
             .c1 create text 320 $yLoc -text $name -anchor w \
                 -font {Arial 14} -fill white -tag highScore
             .c1 create text 460 $yLoc -text $score -anchor w \
                 -font {Arial 14} -fill white -tag highScore
             incr yLoc 30
         }
     }

     .c1 create text 400 500 -text "Press \[Escape\] to return to Menu" \
         -anchor c -font {Arial 14} -fill white -tag highScore
 }

 proc loadHighScores {} {
     set ::globals(highScores) [list]
     if {[file readable $::globals(highScoreFile)]} {
         set fileID [open $::globals(highScoreFile) RDONLY]
         set ::globals(highScores) [read $fileID]
         close $fileID
     }
     cleanHighScores
 }

 proc cleanHighScores {} {
     set hs $::globals(highScores)
     for {set i [llength $hs]} {$i <= 10} {incr i} {
         lappend hs [list Blank 0]
     }
     set hs [lsort -index 1 -integer -decreasing $hs]
     set hs [lrange $hs 0 9]
     set ::globals(highScores) $hs
 }

 proc saveHighScores {} {
     set fileID [open $::globals(highScoreFile) {WRONLY CREAT TRUNC}]
     puts $fileID $::globals(highScores)
     close $fileID
 }


 proc showMenu {} {
     .c1 delete rock
     .c1 delete highScore
     addRock 1 4
     addRock 2 4
     addRock 3 4
     .c1 create text 400 250 -anchor c  \
         -text "\[ N \] ew Game\n\n\[ H \] igh Scores\n\n\[ E \] xit" \
         -fill white -font {Arial 14} -tags menu
     bindNavKeys menu
 }

 proc newGame {} {
     bindNavKeys game
     .c1 delete menu
     set ::globals(lives) 3
     set ::globals(score) 0
     set ::globals(level) 0
     updateScore
     updateLives
     nextLevel
 }

 proc updateScore {{incrScore 0}} {

     incr ::globals(score) $incrScore
     
     # --- did our hero earn another ship?
     if {$::globals(score) >= $::globals(nextLife)} {
         updateLives 1
         incr ::globals(nextLife) $::globals(lifeEvery)
     }
     
     .c1 delete score
     drawNumber 150 30 $::globals(score) score
 }

 proc updateLives {{incrLives 0}} {
     .c1 delete life
     incr ::globals(lives) $incrLives
     for {set i 1} {$i <= $::globals(lives)} {incr i} {
         set obj [.c1 create polygon $::globals(shipCoords) -outline white \
         -fill "" -tag life]
         .c1 move $obj [expr {20 + ($i * 18)}] 65
     }
 }

 proc nextLevel {} {
     .c1 delete rock
     .c1 delete missile
     .c1 delete level
     incr ::globals(level)
     drawNumber 730 30 $::globals(level) level
     addRock 1 [expr {3 + $::globals(level)}]
     if {!$::globals(shipExists)} {after 1000 addShip}

     # --- speed up the heartbeat...
     if {$::globals(sndOK)} {
         if {$::globals(beatDelay) > 200} {
             incr ::globals(beatDelay) -50
         }
         heartBeatOff
         heartBeat 0
     }
 }

 # --- draw integer value using vectors (very Asteroids like...)
 proc drawNumber {xloc yloc val tag} {
     set digitList [split $val ""]
     set count 0
     for {set i [llength $digitList]; incr i -1} {$i >= 0} {incr i -1} {
         incr count
         set digit [lindex $digitList $i]
         set item [.c1 create line $::numbers($digit) -fill white -tags $tag]
         .c1 move $item [expr {$xloc - ($count * 19)}] $yloc
     }
 }

 proc initVars {} {
     set ::globals(gameOn) 1
     set ::globals(level) 0
     set ::globals(score) 0
     set ::globals(lives) 3
     set ::globals(timeStart) [clock clicks -milliseconds]
     set ::globals(frameCount) 0
     set ::globals(screenWidth)  800
     set ::globals(screenHeight) 600
     set ::globals(highScoreFile) \
         [file join [file dirname [info script]] "asteroids_hs.txt"]

     set ::globals(lifeEvery) 10000  ;# new life every 10000 pts
     set ::globals(nextLife) $::globals(lifeEvery)
     set ::globals(newMissileOK) 1
     set ::globals(shipExists) 0
     set ::globals(hyperOK) 1

     set ::globals(sndThrust) 0
     set ::globals(beatDelay) 750
     set ::globals(sndOK) 0

     set ::globals(shipCoords) [list 0 -11 -7 11 -3 7 3 7 7 11 0 -11]
     set ::globals(flameCoords) [list -2 7 0 12 2 7 -2 7]
     # --- Large rock coords
     set ::globals(rockCoords,1) {-39 -25 -33 -8 -38 21 -23 25 -13 39 24 \
        34 38 7 33 -15 38 -31 16 -39 -4 -34 -16 -39}
     set ::globals(rockCoords,2) {-32 35 -4 32 24 38 38 23 31 -4 38 -25 14 \
        -39 -28 -31 -39 -16 -31 4 -38 22}
     set ::globals(rockCoords,3) {12 -39 -2 -26 -28 -37 -38 -14 -21 9 -34 \
        34 -6 38 35 23 21 -14 36 -25}
     # --- Medium rock coords
     set ::globals(rockCoords,4) {-7 -19 -19 -15 -12 -5 -19 0 -19 13 -9 19 \
        12 16 18 11 13 6 19 -1 16 -17}
     set ::globals(rockCoords,5) {9 -19 18 -8 7 0 15 15 -7 13 -16 17 -18 3 \
        -13 -6 -16 -17}
     set ::globals(rockCoords,6) {2 18 18 10 8 0 18 -13 6 -18 -17 -14 -10 \
        -3 -13 15}
     # --- Small rock coords
     set ::globals(rockCoords,7) {-8 -8 -5 -1 -8 3 0 9 8 4 8 -5 1 -9}
     set ::globals(rockCoords,8) {-6 8 1 4 8 7 10 -1 4 -10 -8 -6 -4 0}
     set ::globals(rockCoords,9) {-8 -9 -5 -2 -8 5 6 8 9 6 7 -3 9 -9 0 -7}
     
     set ::numbers(0) [list -7 -10 -7 10 7 10 7 -10 -7 -10]
     set ::numbers(1) [list 0 -10 0 10]
     set ::numbers(2) [list -7 -10 7 -10 7 0 -7 0 -7 10 7 10]
     set ::numbers(3) [list -7 -10 7 -10 7 10 -7 10 7 10 7 0 -7 0]
     set ::numbers(4) [list -7 -10 -7 0 7 0 7 -10 7 10]
     set ::numbers(5) [list -7 10 7 10 7 0 -7 0 -7 -10 7 -10]
     set ::numbers(6) [list -7 -10 -7 10 7 10 7 0 -7 0]
     set ::numbers(7) [list -7 -10 7 -10 7 10]
     set ::numbers(8) [list -7 -10 7 -10 7 10 -7 10 -7 -10 -7 0 7 0]
     set ::numbers(9) [list 7 0 -7 0 -7 -10 7 -10 7 10]
 }

 proc buildUI {} {
     # --- menu
     menu .m -tearoff 0
     . configure -menu .m
     menu .m.help -tearoff 0
     .m add cascade -menu .m.help -label "Help" -underline 0
     .m.help add command -label About -under 0 -command About
     
     canvas .c1 -width $::globals(screenWidth) \
                -height $::globals(screenHeight) -bg black
     .c1 create text 20 30 -fill white -anchor w -tag score -font {Arial 20}
     .c1 create text 780 30 -fill white -anchor e -tag level -font {Arial 20}
     label .l1 -textvariable ::globals(fps)

     wm title . "Asteroids"
     pack .c1
     pack .l1 -fill x -expand 1
     focus -force .c1
     wm protocol . WM_DELETE_WINDOW appExit
 }

 proc calcMotionVectors {} {
     set PI 3.1415926
     for {set i 0} {$i <= 360} {incr i} {
         set ::vector(x,$i) [expr {cos($i * $PI / 180.0)}]
         set ::vector(y,$i) [expr {sin($i * $PI / 180.0) * -1}]
     }
 }

 proc updateFPS {} {
         set timeNow [clock clicks -milliseconds]
         set elapsedTime [expr {($timeNow - $::globals(timeStart)) / 1000.0}]
         set ::globals(fps) [expr {$::globals(frameCount) / $elapsedTime}]
         after 500 updateFPS
 }

 proc gameLoop {} {
     set timeBefore $::globals(timeStart)
     set timeAfter $::globals(timeStart)
     while {$::globals(gameOn)} {
         set timeDelta [expr {$timeAfter - $timeBefore}]
         set timeBefore $timeAfter
         if {$timeDelta} {
             set timeSlice [expr {$timeDelta / 1000.0}]
             nextFrame $timeSlice
             incr ::globals(frameCount)
         }
         while {$timeAfter - $timeBefore < 10} {
             set timeAfter [clock clicks -milliseconds]
         }
     }
 }

 proc nextFrame {timeSlice} {

     set screenHeight $::globals(screenHeight)
     set screenWidth  $::globals(screenWidth)

     # --- dust motion
     foreach item [.c1 find withtag dust] {
         .c1 move $item $::dust($item,xDelta) $::dust($item,yDelta)
         incr ::dust($item,life) -1
         if {$::dust($item,life) <= 0} {
             .c1 delete $item
             array unset ::dust "$item,*"
         }
     }

     # --- wreckage motion
     foreach item [.c1 find withtag wreckage] {
         .c1 move $item $::wreckage($item,xDelta) $::wreckage($item,yDelta)
         incr ::wreckage($item,life) -1
         if {$::wreckage($item,life) <= 0} {
             .c1 delete $item
             array unset ::wreckage "$item,*"
         }
     }

     # --- missile motion
     foreach shot [.c1 find withtag heroMissile] {
         set xCen $::missile($shot,xCen)
         set yCen $::missile($shot,yCen)
         set xDelta $::missile($shot,xDelta)
         set yDelta $::missile($shot,yDelta)
         .c1 move $shot $xDelta $yDelta
         set xCen [expr {$xCen + $xDelta}]
         set yCen [expr {$yCen + $yDelta}]

         # --- if off the screen, wrap it
         if {$xCen > $screenWidth} {
             set xCen [expr {$xCen - $screenWidth}]
             .c1 move $shot -$screenWidth 0
         } elseif {$xCen < 0} {
             set xCen [expr {$xCen + $screenWidth}]
             .c1 move $shot $screenWidth 0
         }
         if {$yCen > $screenHeight} {
             set yCen [expr {$yCen - $screenHeight}]
             .c1 move $shot 0 -$screenHeight
         } elseif {$yCen < 0} {
             set yCen [expr {$yCen + $screenHeight}]
             .c1 move $shot 0 $screenHeight
         }
         incr ::missile($shot,life) -1
         if {$::missile($shot,life) <= 0} {
             .c1 delete $shot
             array unset ::missile "$shot,*"
             continue
         }

         set xPrev [expr {$xCen - $xDelta}]
         set yPrev [expr {$yCen - $yDelta}]
         set ::missile($shot,xCen) $xCen
         set ::missile($shot,yCen) $yCen

         # --- Since our animation is scaled by our timeSlice, it is possible
         #     that on a slow computer, a missile may be on one side of a
         #     target in one frame, and be on the other side in the next frame,
         #     without ever having triggered a collision.  To fix this, we'll
         #     create a line between the current missile position and the previous
         #     position and see if the line intersects any asteroids...
         set ray [.c1 create line $xCen $yCen $xPrev $yPrev -fill white]
         foreach rock [.c1 find withtag "rock"] {
             set overlapList [eval .c1 find overlapping [.c1 bbox $rock]]
             if {[lsearch $overlapList $ray] >= 0} {
                 # --- we've got a hit
                 killRock $rock $timeSlice
                 .c1 delete $shot
                 array unset ::missile "$shot,*"
                 break
             }
         }
         .c1 delete $ray
     }

     # --- rock motion and rotation
     foreach obj [.c1 find withtag rock] {
         foreach {xmin ymin xmax ymax} [.c1 bbox $obj] {break}
         set xCen [expr {($xmax + $xmin) / 2}]
         set yCen [expr {($ymax + $ymin) / 2}]
         set xDim [expr {$xmax - $xmin}]
         set yDim [expr {$ymax - $ymin}]
         rotateItem .c1 $obj $xCen $yCen [expr {$::rock($obj,rot) * $timeSlice}]
         .c1 move $obj [expr {$::rock($obj,xVel) * $timeSlice}] \
                       [expr {$::rock($obj,yVel) * $timeSlice}]
         if {$xmin > $screenWidth} {
             .c1 move $obj [expr {($screenWidth + $xDim) * -1}] 0
         } elseif {$xmax < 0} {
             .c1 move $obj [expr {$screenWidth + $xDim}] 0
         }
         if {$ymin > $screenHeight} {
             .c1 move $obj 0 [expr {($screenHeight + $yDim) * -1}]
         } elseif {$ymax < 0} {
             .c1 move $obj 0 [expr {$screenHeight + $yDim}]
         }
     }

     # --- Ship ---
     if {$::globals(shipExists)} {
         set xDelta $::ship(xDelta)
         set yDelta $::ship(yDelta)
         set xCen   $::ship(xCen)
         set yCen   $::ship(yCen)
         set dir    $::ship(direction)

         # --- ship rotation
         if {$::keyStatus(LEFT) || $::keyStatus(RIGHT)} {
             if {$::keyStatus(LEFT)} {
                 set rotSpeed -$::ship(rotSpeed)
             } else {
                 set rotSpeed $::ship(rotSpeed)
             }
             set thisAngle [expr {$rotSpeed * $timeSlice}]
             rotateItem .c1 ship $xCen $yCen $thisAngle
             rotateItem .c1 flame $xCen $yCen $thisAngle
             set dir [expr {$dir - $thisAngle}]
             if {$dir > 360} {
                 set dir [expr {$dir - 360}]
             } elseif {$dir < 0} {
                 set dir [expr {$dir + 360}]
             }
         }

         # --- ship motion
         if {$::keyStatus(THRUST)} {
             # --- don't overlap thrust sounds, as Snack sometimes crashes...
             if {$::globals(sndThrust) == 0} {
                 sndPlay sndThrust
                 set ::globals(sndThrust) 1
                 after 250 {set ::globals(sndThrust) 0}
             }
             incr ::ship(flameTimer)
             if {$::ship(flameTimer) > 5} {
                 set ::ship(flameTimer) 0
                 if {$::ship(flameOn)} {
                     .c1 itemconfigure flame -state hidden
                     set ::ship(flameOn) 0
                 } else {
                     .c1 itemconfigure flame -state normal
                     set ::ship(flameOn) 1
                 }
             }
             set maxPerFrame [expr {$::ship(velocityMax) * $timeSlice}]
             set newDelta [expr {$::ship(velocityMax) / ($::ship(thrust) / \
                 $timeSlice / $timeSlice)}]
             set intDir [expr {int($dir)}]
             set xVector $::vector(x,$intDir)
             set yVector $::vector(y,$intDir)
             if {abs($xDelta) <= $maxPerFrame && abs($yDelta) <= $maxPerFrame} {
                 set xDelta [expr {$xDelta + ($newDelta * $xVector)}]
                 set yDelta [expr {$yDelta + ($newDelta * $yVector)}]
             }
         } else {
             if {$::ship(flameOn)} {
                 set ::ship(flameOn) 0
                 .c1 itemconfigure flame -state hidden
             }
         }

         # --- decay the current speed, unless we're nearly stopped
         if {abs($xDelta) > .001} {
             set xDelta [expr {$xDelta * .99}]
         } else {
             set xDelta 0
         }
         if {abs($yDelta) > .001} {
             set yDelta [expr {$yDelta * .99}]
         } else {
             set yDelta 0
         }

         .c1 move ship $xDelta $yDelta
         .c1 move flame $xDelta $yDelta

         set xCen [expr {$xCen + $xDelta}]
         set yCen [expr {$yCen + $yDelta}]
         if {$xCen > $screenWidth} {
             set xCen [expr {$xCen - $screenWidth}]
             .c1 move ship -$screenWidth 0
             .c1 move flame -$screenWidth 0
         } elseif {$xCen < 0} {
             set xCen [expr {$xCen + $screenWidth}]
             .c1 move ship $screenWidth 0
             .c1 move flame $screenWidth 0
         }
         if {$yCen > $screenHeight} {
             set yCen [expr {$yCen - $screenHeight}]
             .c1 move ship 0 -$screenHeight
             .c1 move flame 0 -$screenHeight
         } elseif {$yCen < 0} {
             set yCen [expr {$yCen + $screenHeight}]
             .c1 move ship 0 $screenHeight
             .c1 move flame 0 $screenHeight
         }

         # --- see if we've been hit...
         foreach {xmin ymin xmax ymax} [.c1 bbox ship] {break}
         foreach item [.c1 find overlapping $xmin $ymin $xmax $ymax] {
             set tagList [.c1 gettags $item]
             if {[lsearch $tagList rock] >= 0} {
                 killRock $item $timeSlice
                 addWreckage $timeSlice
                 .c1 delete ship
                 .c1 delete flame
                 set ::globals(shipExists) 0
                 updateLives -1
                 after 3000 addShip
                 return
             }
         }

         set ::ship(xCen)      $xCen
         set ::ship(yCen)      $yCen
         set ::ship(xDelta)    $xDelta
         set ::ship(yDelta)    $yDelta
         set ::ship(direction) $dir

         # --- handle FIRE!
         if {$::keyStatus(FIRE)} {
             addMissile $timeSlice
         }

         # --- handle HYPERSPACE
         if {$::keyStatus(HYPER)} {
             if {$::globals(hyperOK)} {
                 set ::globals(hyperOK) 0
                 set newX [random $screenWidth]
                 set newY [random $screenHeight]
                 set xDelta [expr {$newX - $::ship(xCen)}]
                 set yDelta [expr {$newY - $::ship(yCen)}]
                 .c1 move ship $xDelta $yDelta
                 set ::ship(xCen) $newX
                 set ::ship(yCen) $newY
                 .c1 move flame $xDelta $yDelta
                 # --- don't allow another hyper-jump for 1/2 seconds
                 after 500 {set ::globals(hyperOK)} 1
             }
         }
     }

     # --- draw the frame
     update
 }

 proc killRock {rock timeSlice} {
     sndPlay sndExplosion
     foreach {xmin ymin xmax ymax} [.c1 bbox $rock] {break}
     set xCen [expr {($xmax + $xmin) / 2}]
     set yCen [expr {($ymax + $ymin) / 2}]
     addDust $xCen $yCen $timeSlice
     set type $::rock($rock,type)
     if {$type == 1} {updateScore 20}
     if {$type == 2} {updateScore 50}
     if {$type == 3} {updateScore 100}
     incr type
     if { $type <= 3} {
         addRock $type 1 $xCen $yCen
         addRock $type 1 $xCen $yCen
     }
     .c1 delete $rock
     array unset ::rock "$rock,*"
     if {![llength [.c1 find withtag "rock"]]} {
         after 2500 nextLevel
     }
 }

 proc addDust {xLoc yLoc timeSlice} {
     for {set i 0} {$i <= 8} {incr i} {
         set dustSpeed [expr {30 + [random 30]}]
         set ang [expr {int([random 360])}]
         set obj [.c1 create rectangle $xLoc $yLoc $xLoc $yLoc \
             -outline white -fill white -tag dust]
         set ::dust($obj,xDelta) [expr {$::vector(x,$ang) * $dustSpeed * \
             $timeSlice}]
         set ::dust($obj,yDelta) [expr {$::vector(y,$ang) * $dustSpeed * \

             $timeSlice}]
         # --- calculate the approximate number of frames in 1/2 second
         #     this will be the life of our dust particle
         set ::dust($obj,life) [expr {int(1/$timeSlice)}]
     }
 }

 proc addWreckage {timeSlice} {
     set wreckageSpeed 25
     set coordList [.c1 coords ship]
     for {set i 0} {$i < [llength $coordList] - 2} {incr i} {
         set ang [expr {int([random 360])}]
         set xs [lindex $coordList $i]
         set ys [lindex $coordList [expr {$i + 1}]]
         set xe [lindex $coordList [expr {$i + 2}]]
         set ye [lindex $coordList [expr {$i + 3}]]
         set obj [.c1 create line $xs $ys $xe $ye -fill white -tag wreckage]
         set ::wreckage($obj,xDelta) [expr {$::vector(x,$ang) * \
             $wreckageSpeed * $timeSlice}]
         set ::wreckage($obj,yDelta) [expr {$::vector(y,$ang) * \
             $wreckageSpeed * $timeSlice}]
         set ::wreckage($obj,life) [expr {int(1.5/$timeSlice)}]
         incr i
     }

 }

 proc addMissile {timeSlice} {
     if {!$::globals(newMissileOK)} {return}
     if {[llength [.c1 find withtag heroMissile]] >= 4} {return}
     sndPlay sndShot
     set ::globals(newMissileOK) 0
     set missileSpeed 600  ; # pixels per second
     set ang [expr {int($::ship(direction))}]
     set xs  [expr {$::ship(xCen) + $::vector(x,$ang) * 16}]
     set ys  [expr {$::ship(yCen) + $::vector(y,$ang) * 16}]
     set obj [.c1 create rectangle $xs $ys $xs $ys -outline white -fill white -tag heroMissile]
     set ::missile($obj,xDelta) [expr {$::vector(x,$ang) * $missileSpeed * \
         $timeSlice}]
     set ::missile($obj,yDelta) [expr {$::vector(y,$ang) * $missileSpeed * \
         $timeSlice}]
     set ::missile($obj,xCen) $xs
     set ::missile($obj,yCen) $ys
     set ::missile($obj,life) [expr {int(1.2/$timeSlice)}]
     # --- limit firing of a new missile to every 100 ms
     after 100 {set ::globals(newMissileOK) 1}
 }

 proc addShip {} {
     if {$::globals(shipExists)} {return}
     if {!$::globals(lives)} {
         gameOver
         return
     }
     set screenWidth $::globals(screenWidth)
     set screenHeight $::globals(screenHeight)
     # --- Create a 150 pixel square "zone" around the ship.  If anything is
     #     intersecting the zone, don't place the ship yet.  We want to give our
     #     hero a fighting chance...
     set screenXCen [expr {$screenWidth / 2}]
     set screenYCen [expr {$screenHeight / 2}]
     set xMin [expr {($screenWidth - 100) / 2}]
     set xMax [expr {($screenWidth + 100) / 2}]
     set yMin [expr {($screenHeight - 100) / 2}]
     set yMax [expr {($screenHeight + 100) / 2}]
     if {[llength [.c1 find overlapping $xMin $yMin $xMax $yMax]] > 0} {
         # --- Something is *very* close to the ship - wait and try again.
         after 100 addShip
         return
     }

     set obj [.c1 create polygon $::globals(shipCoords) -outline white \
         -fill "" -tag ship]
     .c1 move $obj $screenXCen $screenYCen
     set obj [.c1 create polygon $::globals(flameCoords) -outline white \
         -fill "" -state hidden -tag flame]
     .c1 move $obj $screenXCen $screenYCen
     set ::ship(direction) 90
     set ::ship(flameOn) 0
     set ::ship(flameTimer) 0 ; # flicker the flame every 5 frames
     set ::ship(rotSpeed) 270 ; # degrees per second
     set ::ship(velocity) 0 ; # pixels per second
     set ::ship(xCen) $screenXCen
     set ::ship(yCen) $screenYCen
     set ::ship(xDelta) 0
     set ::ship(yDelta) 0
     set ::ship(velocityMax) 250 ; # pixels per second
     set ::ship(velocityDecay) 3 ; # ship takes 3 seconds to stop from full speed
     set ::ship(thrust) .75      ; # ship takes 1 second to reach full speed
     set ::globals(shipExists) 1
 }

 proc addRock {type {num 1} {xLoc ""} {yLoc ""}} {
     for {set i 1} {$i <= $num} {incr i} {
         set coordList \
            $::globals(ro\ckCoords,[expr {([random 3] + 1) + (3 * ($type - 1))}])
         set xVel [expr {10 + [random 40] + \
             ($type * ([random 40] + 1)) + \
             ($::globals(level) * ([random 5] + 1))}]
         set yVel [expr {10 + [random 40] + \
             ($type * ([random 40] + 1)) + \
             ($::globals(level) * ([random 5] + 1))}]
         set rotation [expr {20 + [random 40]}]
         if {[random 2]} {set xVel -$xVel}
         if {[random 2]} {set yVel -$yVel}
         if {[random 2]} {set rotation -$rotation}
         # --- don't set a rock on top of the ship
         while {1} {
             set obj [.c1 create polygon $coordList -outline white \
                 -fill "" -tag rock]
             foreach {xmin ymin xmax ymax} [.c1 bbox $obj] {break}
             set xCen [expr {($xmax + $xmin) / 2}]
             set yCen [expr {($ymax + $ymin) / 2}]
             rotateItem .c1 $obj $xCen $yCen [random 360]
             if {$xLoc eq "" || $num > 1} {set xLoc [random 600]}
             if {$yLoc eq "" || $num > 1} {set yLoc [random 400]}
             .c1 move $obj $xLoc $yLoc
             if {$type != 1} {break}
             if {!$::globals(shipExists)} {break}
             set xCen $::ship(xCen)
             set yCen $::ship(yCen)
             set xMin [expr {$xCen - 75}]
             set xMax [expr {$xCen + 75}]
             set yMin [expr {$yCen - 75}]
             set yMax [expr {$yCen + 75}]
             set overlap [.c1 find overlapping $xMin $yMin $xMax $yMax]
             if {[lsearch $overlap $obj] >= 0} {
                 .c1 delete $obj
             } else {
                 break
             }
         }
         set ::rock($obj,xVel) $xVel
         set ::rock($obj,yVel) $yVel
         set ::rock($obj,rot)  $rotation
         set ::rock($obj,xLoc) $xLoc
         set ::rock($obj,yLoc) $yLoc
         set ::rock($obj,type) $type
     }
 }

 proc random {{range 100}} {
     return [expr {int(rand()*$range)}]
 }

 proc rotateItem {w tagOrId Ox Oy angle} {
     set angle [expr {$angle * atan(1) * 4 / 180.0}]
     foreach id [$w find withtag $tagOrId] {
         set xy {}
         foreach {x y} [$w coords $id] {
             # rotates vector (Ox,Oy)->(x,y) by angle clockwise
             set x [expr {$x - $Ox}]             ;# Shift to origin
             set y [expr {$y - $Oy}]
             set xx [expr {$x * cos($angle) - $y * sin($angle)}] ;# Rotate
             set yy [expr {$x * sin($angle) + $y * cos($angle)}]
             set xx [expr {$xx + $Ox}]           ;# Shift back
             set yy [expr {$yy + $Oy}]
             lappend xy $xx $yy
         }
         $w coords $id $xy
     }
 }

 proc bindGameKeys {} {

     set LEFT_PRESS     "<KeyPress-Left>"
     set LEFT_RELEASE   "<KeyRelease-Left>"
     set RIGHT_PRESS    "<KeyPress-Right>"
     set RIGHT_RELEASE  "<KeyRelease-Right>"
     set THRUST_PRESS   "<KeyPress-Up>"
     set THRUST_RELEASE "<KeyRelease-Up>"
     set HYPER_PRESS    "<KeyPress-Down>"
     set HYPER_RELEASE  "<KeyRelease-Down>"
     set FIRE_PRESS     "<KeyPress-space>"
     set FIRE_RELEASE   "<KeyRelease-space>"


     bind . $LEFT_PRESS   {set ::keyStatus(LEFT) 1}
     bind . $RIGHT_PRESS  {set ::keyStatus(RIGHT) 1}
     bind . $THRUST_PRESS {set ::keyStatus(THRUST) 1}
     bind . $FIRE_PRESS   {set ::keyStatus(FIRE) 1}
     bind . $HYPER_PRESS  {set ::keyStatus(HYPER) 1}

     bind . $LEFT_RELEASE   {set ::keyStatus(LEFT) 0}
     bind . $RIGHT_RELEASE  {set ::keyStatus(RIGHT) 0}
     bind . $THRUST_RELEASE {set ::keyStatus(THRUST) 0}
     bind . $FIRE_RELEASE   {set ::keyStatus(FIRE) 0}
     bind . $HYPER_RELEASE  {set ::keyStatus(HYPER) 0}

     set ::keyStatus(LEFT) 0
     set ::keyStatus(RIGHT) 0
     set ::keyStatus(THRUST) 0
     set ::keyStatus(FIRE) 0
     set ::keyStatus(HYPER) 0
 }

 proc testForSounds {} {
     # --- define sndPlay as a no-op proc in case we don't have the required
     #     sound support

     proc sndPlay {snd} {}

     # --- if the Snack package can't be found, return...
     if {[catch {package require snack}]} return

     # --- load the sounds if available
     foreach {snd file} [list sndShot shot.wav sndExplosion explosion.wav \
         sndThrust thrust.wav sndBeat1 beat1.wav sndBeat2 beat2.wav] {
         if {[file readable $file]} {
             sound $snd -file $file
         } else {
             return
         }
     }

     # --- OK, here we have the necessary sound support, so redefine the sndPlay
     proc sndPlay {snd} {
             $snd play
     }
     set ::globals(sndOK) 1
 }

 # --- manage the heartbeat sound
 proc heartBeat {count} {
     if {$count == 0} {
         set snd sndBeat1
         set count 1
     } else {
         set snd sndBeat2
         set count 0
     }
     sndPlay $snd
     after $::globals(beatDelay) heartBeat $count
 }

 # --- cancel the heartbeat sound
 proc heartBeatOff {} {
     after cancel {heartBeat 0}
     after cancel {heartBeat 1}
 }
 
  proc About {} {
     set msg "Asteroids\n\nJeff Godfrey          \nFebruary, 2005"
     tk_messageBox -title About -message $msg
  }

 main

----
[SS] 21Feb2005: Cool! I like the technique used to avoid keyboard-autorepeat (i.e. to use the Press/Release event and handle a 'state'), this makes
the game very playable compared to every other Tcl arcade game I ever seen.
----

Woooh!!! It looks good and plays even better. The game controls are very responsive. Tcl/Tk?...no way...just kidding. This is one of the best Tk games I've seen.

----


[Category Games]

[Category Application]