[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>> CToys | Exatmpleg | Games | Canvas | Torys and Games | Graphics | Tcl/Tk Games | Application | Animation |Broken Links