another Asteroids

http://www.jeffgodfrey.com

Jeff Godfrey, 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...


JH Since this one was too fun to pass up, and there are lots of fun mods you can make to the game, it has been added to the TclApp module in the tcllib projects SF CVS area. Check that out to find the latest features. [L1 ]


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 [L2 ]. 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

[L3 ]


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

JAG, 23-Feb-2005 - Another update

Jeff Hobbs has done some experimenting with my original gameLoop proc. The original loop was not very CPU friendly, as it just ran the game as fast as it could inside a "while" loop. Jeff H. provided me with a modified version that relies on the standard event loop, which places much less of a load on the CPU. My initial testing shows that both the original and the new loops "feel" about the same during game play (at least on a fast system with little other CPU load). Because of that, Jeff H.'s new loop is currently being used.

Both version of the procedure are still in the code (gameLoop0 is the original, and gameLoop1 is Jeff H.'s modified version). Immediately below the two procs, one of them is being renamed to "gameLoop" for use by the application. So, for now, the new procedure is being used. If the new loop causes any (animation related) problems (which I doubt), just put the original loop back in place (by changing the "rename" code immediately below the two procs).

Also, I'm interested in any feedback regarding the two different loop styles.


Code

Note: The following code IS NOT the most current. This game is now being maintained as part of the tclapps module of tcllib. As such, the latest revision can be found here --> [L4 ]

 #############################################################################
 #
 # Asteroids.tcl - Tcl remake of the Atari arcade game classic
 # Jeff Godfrey, Feb-2005
 #
 # This has been added to tclapps in tcllib.  Find the latest revision at:
 # http://tcllib.cvs.sourceforge.net/*checkout*/tcllib/tclapps/apps/asteroids/asteroids.tcl?rev=HEAD
 # Revision History
 #
 # 23-Feb-2005
 #       - Added a second version of the "gameLoop" proc, provided by Jeff
 #         Hobbs.  The original version is not CPU friendly as it just runs
 #         the game as fast as it can inside a "while" loop.  Jeff H's mod
 #         uses the event loop for processing, and tends to place a much
 #         lighter load on the CPU.  Immediately below the two gameLoop procs
 #         (gameLoop0 and gameLoop1), you'll need to decide which one you want
 #         to use and "rename" one of them to gameLoop.  Currently, Jeff H's
 #         loop is being used.  If you have any animation problems with either
 #         loop, try the other one.  Both seem to provide a similar experience.
 #
 # 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 [clock clicks -milliseconds]
 }

 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> {}
     }
 }

 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
 }

 # --- original gameloop
 #     This is not CPU friendly, as it just cranks the game as fast as it can
 #     inside a while loop, though it seems to provide a good
 #     "gaming experience"
 proc gameLoop0 {time} {
     set ::TIGHTLOOP 1
     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)
              }
         # --- make sure we've used at least 10 ms for the current frame.
         #     otherwise, the timeslice value is *so* small, that some of the
         #     animation scaling tends to go whacky...
         #     This has the effect of limiting the max FPS to 100
              while {$timeAfter - $timeBefore < 10} {
                  set timeAfter [clock clicks -milliseconds]
              }
     }
 }

 # --- modified game loop (provided by Jeff Hobbs)
 #     This is a modification of the original gameloop code (above) that still
 #     uses the event loop for processing (no while loop).  Because the event
 #     loop is being used, it tends to be much more CPU friendly.  In my
 #     initial testing, it seems to provide basically the same feel as the
 #     original loop.  I don't know how it holds up under varying CPU loads,
 #     slower systems, etc...
 proc gameLoop1 {time} {
     set ::TIGHTLOOP 0
     if {$::globals(gameOn)} {
              set now [clock clicks -milliseconds]
              set delta [expr {$now - $time}]
              if {$delta} {
                  set timeSlice [expr {$delta / 1000.0}]
                  nextFrame $timeSlice
                  incr ::globals(frameCount)
              }
              after 5 [list gameLoop $now]
     }
 }

 # Rename either gameLoop0 or gameLoop1 to the *real* gameLoop
 rename gameLoop1 gameLoop

 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. I'd like to see a Tk battlezone using the same polygons.


DPE 23 Feb 2005 This really is excellent, very responsive and playable!


MPJ 3Mar2005: I just noticed from the TkChat logs that TclGuy has tried this out on his PocketPC so I thought I would give it a try too. I only had to make a couple of changes and the screen was full size and I coulf fire with the joypad on my Dell Axim.

Here are my changes (to version 1.9):

 wm geometry . +0+0     ;# used to hide the tile bar
 # below is needed so I could push the joypad and make it fire (no space bar)
 set FIRE_PRESS1    "<KeyPress-Return>"
 set FIRE_RELEASE1  "<KeyRelease-Return>"
 bind . $FIRE_PRESS1  {set ::keyStatus(FIRE) 1}
 bind . $FIRE_RELEASE1   {set ::keyStatus(FIRE) 0}

http://mywebpages.comcast.net/jakeforce/Ast_Welcome.jpg http://mywebpages.comcast.net/jakeforce/Ast_HighScore.jpg http://mywebpages.comcast.net/jakeforce/Ast_GamePlay.jpg

JH 8Mar2005: I'm a bit amazed it worked, since I never actually tested it on PocketPC, but that just shows the strength of Tk x-platform. :) I've added <Return> as an alias for Fire in v1.10, along with a hit accuracy counter.


Is anyone going to add the flying saucer that flys by occassionally and tries to shoot you? This would make this game very authentic if you did.

JAG, 08-Mar-2005 - Agreed. The flying saucer is the most obvious missing item. I do have plans to add it, if I could only find the time... (hopefully soon) ;^)


GWL 9-Apr-2005 - Needs to check to see if it is running from a starkit and save the high scores elsewhere. Currently on Windows this causes an I/O error when it attempts to save back to the .kit or .exe file.

JAG, 23-Apr-2005 - The above issue reported by GWL should now be fixed, and checked into CVS.


uniquename 2013jul29

In case the images above at 'external sites' comcast.net and jeffgodfrey.com go dead, here is a 'locally stored' image at the wiki.tcl.tk site. An image of this 'labor of love' deserves to have plenty of backup.

asteroids2_wiki13601_screenshot_805x621.jpg

(Thanks to 'gnome-screenshot', 'mtpaint', and ImageMagick 'convert' on Linux for, respectively, capturing the screen to a PNG file, cropping the image, and converting the resulting PNG file to a JPEG file about one-tenth the size of the PNG file. Thanks to FOSS developers everywhere --- including Linux kernel and Gnu developers. I used the 'mv' command and the ImageMagick 'identify' command in a shell script to easily rename the cropped image file to contain the image dimensions in pixels.)

This image shows a full-sized view of the playing area --- on a 1024x768 resolution monitor --- with a window border from Ubuntu 9.10 ('Karmic Koala', 2009 October version).