[Brian Embleton] : Clone of the Atari classic.  This is more of a toy than a game - the player gets infinite lives and there's no difficulty adjustment.  I also added sound support using [Snack] with the original Asteroids sound effects [http://www.ece.utexas.edu/~embleton/files/media.zip] (link broken).  The result was was quite enjoyable.  If you would like to use sounds, unzip the media folder and place it in the same folder as the source.

   * Asteroids are randomly shaped
   * The rocks come in 3 sizes, breaking down into smaller ones
   * Mouse aiming, firing and thrusters (left and right buttons)
   * Collision detection for the ship and each bullet
   * Sound support with [Snack]

----
See also [another Asteroids], and [Simple Space Ship Game]
----
======
 # Create an asteroid at X,Y
 proc asteroid {size X Y} {
         global rocks options
         
         set coords {}
         set points [expr $size*5.0]
         for {set i 0} {$i < $points} {incr i} {
                 set r [expr $size*(rand()*2 + 3)]
                 set rad [expr 2*3.14159 * $i/$points]
                 set x [expr $X + $r*cos($rad)]
                 set y [expr $Y + $r*sin($rad)]
                 
                 lappend coords $x
                 lappend coords $y
         }
         
         set id [.c create polygon $coords -fill gray[expr int(rand()*5)*5+40] -tags rock]
         set dx [expr (rand()*$options(rock_speed)+.3)*pow(-1,int(rand()*2)) ]
         set dy [expr (rand()*$options(rock_speed)+.3)*pow(-1,int(rand()*2)) ]
         
         set rocks($id) [list $id $size $X $Y $dx $dy]
         return $id
 }
 
 # Create the ship object
 # Place it in the middle of the field.
 # I dont do any proximity calculations so there is a good
 # chance the ship will blow up right away.
 proc makeShip {} {
         global ship canvas_width canvas_height score
         global ship_dir
         
         incr score(ships)
         
         set x [expr $canvas_width/2]
         set y [expr $canvas_height/2]
         
         set dx 0
         set dy 0
         
         # ship_dir is in radians
         set ship_dir 0
         
         set id [.c create line $x $y [expr $x+1] $y -fill blue -width 1 -arrow last -arrowshape {12 14 5} -tags ship]
         set ship [list $id "" $x $y $dx $dy]
 }
 
 # The ship crashed.  Remove the canvas object and reset the global variable
 proc resetShip {} {
         global ship
         
         set id [lindex $ship 0]
         .c delete $id
         set ship ""
         after 4000 makeShip
 }
 
 proc drawShip {} {
         global ship ship_dir after_procs
         
         if {$ship == ""} { return }
         
         foreach {id size x y dx dy} $ship {}
         set x2 [expr $x+10*cos($ship_dir)]
         set y2 [expr $y+10*sin($ship_dir)]
         
         .c coords $id $x $y $x2 $y2
 }
 
 # Adjust the ships angle to 0-2pi
 proc correctShipDir {} {
         global ship_dir
         
         set twopi [expr 2*3.14159]
         if {$ship_dir < 0} { set ship_dir [expr $twopi+$ship_dir] }
         if {$ship_dir > $twopi} { set ship_dir [expr $ship_dir-$twopi] }
 }
 
 # increment the ships direction to the left or right
 proc rotateShip {dir} {
         global ship ship_dir options
         
         if {$ship == ""} { return }
         
         set ship_dir [expr $ship_dir + $dir*$options(ship_turn_speed)]
         correctShipDir
 }
 
 # For Mouse Aiming
 # Immediately adjust the ships direction to point
 # directly at the cursor.  Perhaps I could add in stepper logic
 # to slowly rotate the ship around, as if the player was actually
 # using the keyboard controls, to make gameplay more like the original
 proc mouseOver {x y} {
         global ship ship_dir
         
         if {$ship == ""} { return }
         
         foreach {id size X Y dx dy} $ship {}
         set dx [expr $x.0-$X]; set dy [expr $y.0-$Y]
         set ship_dir [expr atan2($dy, $dx)]
         
         correctShipDir
 }
 
 # Mouse control header.
 # use [after] to implement repeating thruster controls
 proc thrust_mouse {} {
         global mouse_timers options
         shipThrust
         set mouse_timers(thrust) [after 100 "thrust_mouse"]
 }
 
 # ... and to turn off the thrusters when button 3 is released
 proc cancel_thrust_mouse {} {
         global mouse_timers
         
         after cancel $mouse_timers(thrust)
 }
 
 # Ship thruster adjustment
 # change the ships velocity based on the current direction and speed
 # Also, prevent the ship from going faster than the max speed
 proc shipThrust {} {
         global ship ship_dir options
         
         if {$ship == ""} { return }
         
         # add a small proportion of the ships dir to the movement vectors
         set dx [lindex $ship 4]
         set dy [lindex $ship 5]
         
         set dx [expr $dx + $options(ship_thrust) * cos($ship_dir)]
         set dy [expr $dy + $options(ship_thrust) * sin($ship_dir)]
         
         set mag [expr sqrt($dx*$dx + $dy*$dy)]
         if {$mag > $options(max_ship_velocity)} {
                 set dx [expr $options(max_ship_velocity)*cos($ship_dir)]
                 set dy [expr $options(max_ship_velocity)*sin($ship_dir)]
         }
         
         lset ship 4 $dx
         lset ship 5 $dy
         
         if {!$options(playing_thrust)} {
                 playSound thrust
                 set options(playing_thrust) 1
                 after 500 {
                         global options
                         set options(playing_thrust) 0
                 }
         }
 }
 
 # Mouse control header for button 1 down
 proc fire_mouse {} {
         global mouse_timers options
         fire
         set mouse_timers(fire) [after 200 "fire_mouse"]
 }
 
 # Mouse button 1 release
 proc cancel_fire_mouse {} {
         global mouse_timers
         
         after cancel $mouse_timers(fire)
 }
 
 # Create a new bullet with the same direction as the ship
 # The maximum number of bullets is defined in the options,
 # as well as rate of fire and maximum range
 proc fire {} {
         global ship ship_dir bullets options score
         
         if {$ship == ""} { return }
         
         # only x bullets on the screen at a time
         if {[array size bullets] == $options(max_bullets)} { return }
         
         incr score(shots_fired)
         
         # create a new bullet at the front of the ship
         foreach {id size x y dx dy} $ship {}
         set X [expr $x+12*cos($ship_dir)]
         set Y [expr $y+12*sin($ship_dir)]
         set x1 [expr $X-1]; set x2 [expr $X+1]
         set y1 [expr $Y-1]; set y2 [expr $Y+1]
         
         set id [.c create oval $x1 $y1 $x2 $y2 -fill white -outline gray75 -tags bullet]
         set dx [expr $options(bullet_speed)*cos($ship_dir)]
         set dy [expr $options(bullet_speed)*sin($ship_dir)]
         
         set bullet [list $id "" $X $Y $dx $dy]
         set bullets($id) $bullet
         
         # destroy bullets after x seconds
         after [expr 1000*$options(bullet_range)/$options(bullet_speed)/$options(frame_rate)] "dropBullet $id"
         
         playSound fire
 }
 
 # Destroy the bullet objects when they get to their maximum range
 proc dropBullet {id} {
         global bullets
         
         array unset bullets $id
         .c delete $id
 }
 
 # For when the asteroids are shot or the ship crashes
 # there are 3 sizes of rocks: 1, 2 and 3
 # sizes 2 and 3 break into 3 or 4 rocks of sizes 1 and 2
 proc explode {id} {
         global rocks
         
         foreach {id size X Y dx dy} $rocks($id) {}
         
         .c delete $id
         array unset rocks $id
         
         # all rocks gone now?
         if {[array size rocks] == 0} { after 3000 newLevel }
         
         # if size is 2 or 3, make 3 or 4 smaller rocks
         if {$size > 1} {
                 set size [incr size -1]
                 set n [expr int(rand()*2+3)]
                 for {set i 0} {$i < $n} {incr i} {
                         set rad [expr 2*3.14159*$i/$n]
                         set x [expr $X + $size*2*cos($rad)]
                         set y [expr $Y + $size*2*sin($rad)]
                         
                         asteroid $size $x $y
                 }
         }
         
         playSound boom
 }
 
 # Generic movement function
 # given an object {id size x y dx dy},
 # add the velocities to the locations, use the canvas move command,
 # and return the new item properties
 proc move {item} {
         global canvas_height canvas_width
         
         foreach {id size x y dx dy} $item {}
         set nx [expr $x+$dx]
         set ny [expr $y+$dy]
         if {$nx < 0} { set nx [expr $canvas_width+$nx] }
         if {$ny < 0} { set ny [expr $canvas_height+$ny] }
         if {$nx > $canvas_width} { set nx [expr $nx-$canvas_width] }
         if {$ny > $canvas_height} { set ny [expr $ny-$canvas_height] }
         
         lset item 2 $nx
         lset item 3 $ny
         
         set ddx [expr $nx-$x]
         set ddy [expr $ny-$y]
         .c move $id $ddx $ddy
         
         return $item
 }
 
 # Detects rock collisions with the given canvas object
 # If there is a rock at the same location, return its id
 # otherwise, return null
 proc detectCollision {item} {
         foreach {id size x y dx dy} $item {}
         set ids [lsort -integer [.c find overlapping [expr $x-3] [expr $y-3] [expr $x+3] [expr $y+3]]]
         if {[llength $ids] > 1} {
                 set i [lsearch $ids $id]
                 set object [lindex [lreplace $ids $i $i] 0]
                 if {[.c gettags $object] == "rock"} { return $object }
         }
         return ""
 }
 
 proc updateScreen {} {
         global rocks ship bullets score
         
         # move each rock
         foreach id [array names rocks] {
                 set rock $rocks($id)
                 set rocks($id) [move $rock]
         }
         
         if {$ship != ""} {
                 # move the ship
                 set ship [move $ship]
                 set id [lindex $ship 0]
                 drawShip
                 
                 # check for ship collisions
                 set rock_id [detectCollision $ship]
                 if {$rock_id != ""} {
                         resetShip
                         explode $rock_id
                 }
         }
         
         # move the bullets
         foreach id [array names bullets] {
                 set bullet $bullets($id)
                 set bullets($id) [move $bullet]
                 
                 # check for collisions
                 set rock_id [detectCollision $bullet]
                 if {$rock_id != ""} {
                         dropBullet $id
                         switch [lindex $rocks($rock_id) 1] {
                                 1 {incr score(small_rocks)}
                                 2 {incr score(med_rocks)}
                                 3 {incr score(big_rocks)}
                         }
                         updateHitScore
                         explode $rock_id
                 }
         }
 }
 
 proc newLevel {} {
         global canvas_height canvas_width score
         
         incr score(stage)
         
         # create random field
         for {set i 0} {$i < 30} {incr i} {
                 asteroid [expr int(rand()*3)+1] [expr rand()*$canvas_width] [expr rand()*$canvas_height]
         }
 }
 
 # not actually used, but useful for debugging
 proc clear {} {
         global rocks
         foreach id [array names rocks] {
                 array unset rocks $id
                 .c delete $id
         }
 }
 
 proc updateHitScore {} {
         global score
         
         foreach {var val} [array get score] { set $var $val }
         
         set score(total_rocks) [expr $small_rocks+$med_rocks+$big_rocks]
         set score(rocks) "$score(total_rocks) ($small_rocks/$med_rocks/$big_rocks)"
         set score(accuracy) [format %.1f%% [expr 100.0*$score(total_rocks)/$shots_fired]]
 }
 
 proc resetScore {} {
         global score
         
         array set score {
                 ships 0
                 stage 0
                 shots_fired 0
                 accuracy 0
                 small_rocks 0
                 med_rocks 0
                 big_rocks 0
                 total_rocks 0
                 rocks "0 (0/0/0)"
                 rating "ensign"
         }
 }
 
 proc loadSounds {} {
         # define the sound objects
         snack::sound sound_music 
         snack::sound sound_thrust
         snack::sound sound_fire
         snack::sound sound_boom
         
         # if the files dont exist, it wont affect playing the sounds
         catch {
                 sound_music configure -load "media/duduhn.wav"
                 sound_thrust configure -load "media/fhhh.wav"
                 sound_fire configure -load "media/bullet.wav"
                 sound_boom configure -load "media/boom.wav"
         }
 }
 
 proc playMusic {} {
         global options
         
         if {$options(play_music)} {
                 sound_music play -command "after 100 playMusic"
         } else {
                 after 500 playMusic
         }
 }
 
 proc playSound {snd} {
         sound_$snd play
 }
 
 proc doLoop {} {
         global options rocks
         
         updateScreen
         after [expr 1000/$options(frame_rate)] doLoop
 }
 
 package require snack
 
 set canvas_height 480
 set canvas_width 640
 
 array set options {
         frame_rate 30
         rock_speed 1.8
         ship_turn_speed 0.2
         ship_thrust 0.3
         max_ship_velocity 2
         max_bullets 10
         bullet_speed 4
         bullet_range 400
         play_music 1
         playing_thrust 0
 }
 
 frame .f
         label .f.l1 -bg black -fg green -text "New Ships: "
         label .f.l2 -bg black -fg green -width 5 -anchor w -textvariable score(ships)
         label .f.l3 -bg black -fg green -text "Level: "
         label .f.l4 -bg black -fg green -width 5 -anchor w -textvariable score(stage)
         label .f.l5 -bg black -fg green -text "Shots Fired: : "
         label .f.l6 -bg black -fg green -width 6 -anchor w -textvariable score(shots_fired)
         label .f.l7 -bg black -fg green -text "Hits: "
         label .f.l8 -bg black -fg green -width 15 -anchor w -textvariable score(rocks)
         label .f.l9 -bg black -fg green -text "Accuracy: "
         label .f.l10 -bg black -fg green -width 6 -anchor w -textvariable score(accuracy)
         
         for {set i 1} {$i <= 10} {incr i} {
                 pack .f.l$i -side left
         }
 
 canvas .c -width $canvas_width -height $canvas_height -bg black -cursor tcross
 bind . <Key-Up> {shipThrust}
 bind . <Key-Left> {rotateShip -1}
 bind . <Key-Right> {rotateShip 1}
 bind . <Key-space> {fire}
 bind .c <Motion> "mouseOver %x %y"
 bind .c <Button-1> {fire_mouse}
 bind .c <ButtonRelease-1> {cancel_fire_mouse}
 bind .c <Button-3> {thrust_mouse}
 bind .c <ButtonRelease-3> {cancel_thrust_mouse}
 
 checkbutton .music -text "Music On" -variable options(play_music) 
 label .help -justify left -text "Aim:\tMouse or Left/Right\nFire:\tButton 1 or Spacebar\nThrust:\tButton 2 or Up"
 
 pack .f .c .music .help -side top
 
 loadSounds
 resetScore
 makeShip
 newLevel
 playMusic
 
 doLoop
======
----

It looks great! Is there away to tweak the moving right or left so it's more responsive? The arrow key are a little sluggish by default.
----

Nice, but I bet you'd get noticeably better performance if you braced your expressions. It's a good habit to get into.

----

I didn't know about the performance benefit of placing expressions in braces.  Thanks for the info!

<<categories>> Category Games | Broken Links