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. [http://tcllib.cvs.sourceforge.net/*checkout*/tcllib/tclapps/apps/asteroids/asteroids.tcl?rev=HEAD]''' ---- '''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.jeffgodfrey.com/download/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.jeffgodfrey.com/posted_pics/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 ---- [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 --> [http://tcllib.cvs.sourceforge.net/*checkout*/tcllib/tclapps/apps/asteroids/asteroids.tcl?rev=HEAD]''' ############################################################################# # # 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 . {} bind . newGame bind . newGame bind . appExit bind . appExit bind . displayHighScores bind . displayHighScores } elseif {$mode eq "highScores"} { bind . showMenu bind . {} bind . {} bind . {} bind . {} bind . {} bind . {} } elseif {$mode eq "game"} { bind . {} bind . {} bind . {} bind . {} bind . {} bind . {} bind . {} } } 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 [list $w.btnOK invoke] bind $w {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 "" set LEFT_RELEASE "" set RIGHT_PRESS "" set RIGHT_RELEASE "" set THRUST_PRESS "" set THRUST_RELEASE "" set HYPER_PRESS "" set HYPER_RELEASE "" set FIRE_PRESS "" set FIRE_RELEASE "" 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 "" set FIRE_RELEASE1 "" 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 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 site' comcast.net go dead, here is a 'locally stored' image at the wiki.tcl.tk site. [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). <> Games | Application