Attributes edit
- by
- Pedro Henrique
- location
- pastie.org
Introduction edit
A simple
Asteroids-like game written by the author as a Tcl learning exercise
Newer code may be available at the author's website
package require Tk
package require Img
# Each missle image has a unique name; missle_index helps generate that name.
set missle_index 0
set ast_index 0
set ast_count 0
set destroyed 0
set shots 0
# Is the player shooting?
set is_shooting 0
# Some sizes
set win_height 600
set win_width 800
set ship_height 84
set ship_width 61
set ship_init_x [expr {$::win_width/2}]
set ship_init_y [expr {$::win_height-$::ship_height/2}]
# Moving values, direction to go and direction to gravitates towards
set goto_Right 0
set goto_Left 0
set goto_Up 0
set goto_Down 0
set grav_Right 0
set grav_Left 0
set grav_Up 0
set grav_Down 0
# Data for asteroids
set asts_light_data [list]
set asts_dark_data [list]
proc every {ms body} {
eval $body
after $ms [info level 0]
}
proc move_ship {} {
set move_hor [expr {$::grav_Right-$::grav_Left}]
set move_vert [expr {$::grav_Down-$::grav_Up}]
set coords [.space coords $::ship]
set cur_x [lindex $coords 0]
set cur_y [lindex $coords 1]
set new_x [expr {$cur_x+$move_hor}]
set new_y [expr {$cur_y+$move_vert}]
foreach dir {Left Up Down Right} {
set goto [set ::goto_$dir]
set grav [set ::grav_$dir]
if {$goto} {
if {$grav >= 0 && $grav <= 10} {
incr ::grav_$dir
}
} else {
if {$grav > 0} {
incr ::grav_$dir -1
}
}
}
if {$new_x < ($::ship_width/2)} {
incr move_hor [expr {int($::ship_width/2 - $new_x)}]
} elseif {$new_x > ($::win_width-$::ship_width/2)} {
incr move_hor [expr {int(($::win_width-$::ship_width/2)-$new_x)}]
}
if {$new_y > $::ship_init_y} {
incr move_vert [expr {int($::ship_init_y-$new_y)}]
} elseif {$new_y < $::ship_height/2} {
incr move_vert [expr {int($::ship_height/2-$new_y)}]
}
.space move $::ship $move_hor $move_vert
after 20 move_ship
}
proc missle_1 {canvas_name image_name} {
set coords [.space coords $canvas_name]
set y [lindex $coords 1]
if {$y < -50} {
.space delete $canvas_name
image delete $image_name
} else {
set x [lindex $coords 0]
set x [expr {int($x)}]
set y [expr {int($y)}]
set results [.space find overlapping $x $y $x [expr {$y-10}]]
set len [llength $results]
for {set i 0} {$i < $len} {incr i} {
set item [lindex $results $i]
if {$item == $::ship} {
continue
} elseif {[lsearch [.space gettags $item] missle] >= 0} {
continue
} else {
.space delete $canvas_name
image delete $image_name
#set coords [.space coords $item]
.space addtag destroyed withtag $item
incr ::destroyed
#explosion [expr {int([lindex $coords 0])}] [expr {int([lindex $coords 1])}]
return
}
}
.space move $canvas_name 0 -10
after 10 [list missle_1 $canvas_name $image_name]
}
}
proc shoot {} {
set missle_name "missle_1_$::missle_index"
incr ::missle_index
image create photo $missle_name -file missle_1_1.gif
set coords [.space coords $::ship]
set x [lindex $coords 0]
set x [expr {int($x)}]
set y [lindex $coords 1]
set y [expr {int($y-$::ship_height/2)+5}]
set canvas_name [.space create image $x $y -image $missle_name]
.space addtag missle withtag $canvas_name
missle_1 $canvas_name $missle_name
}
proc shooting_engine {} {
if {$::is_shooting} {
shoot
incr ::shots 2
after 50 shoot
}
after 150 shooting_engine
}
proc die {} {
.space configure -state disabled
tk_messageBox -message "Dead\nKilled: $::destroyed\nShot: $::shots\nAsteroids: $::ast_count"
exit
}
proc rotate_ast {type cname name x y n} {
if {$n < 32} {
if {[lsearch [.space gettags $cname] destroyed] < 0 && $x > -50 && $x < 850 && $y > -50 && $y < 650} {
.space delete $cname
catch {image delete $name}
image create photo $name -data [lindex [set ::asts_${type}_data] $n]
set cname [.space create image $x $y -image $name]
.space addtag asteroid withtag $cname
set results [.space find overlapping [expr {$x-22}] [expr {$y-22}] [expr {$x+22}] [expr {$y+22}]]
foreach res $results {
if {$res ne $cname} {
if {$res eq $::ship} {
.space delete $cname
die
}
.space delete $res
}
}
if [llength $results]==1 {
set inch [expr {int(rand()*5-2)}]
set incv [expr {int(rand()*3)}]
after 25 "rotate_ast $type $cname $name [expr {$x+$inch}] [expr {$y+$incv}] [expr {$n+1}]"
} else {
.space delete $cname
image delete $name
}
} else {
.space delete $cname
image delete $name
}
} else {
rotate_ast $type $cname $name $x $y 0
}
}
proc asteroids_spawner {} {
set rand [expr {int(rand()*1000)}]
set rand_n [expr {int(rand()*32)}]
set rand_x [expr {int(rand()*$::win_width)}]
set rand_y [expr {int(rand()*$::win_height/2)}]
set type 0
if {rand() < 0.5} {
set type light
} else {
set type dark
}
incr ::ast_index
incr ::ast_count
rotate_ast $type "" "ast_$::ast_index" $rand_x $rand_y $rand_n
after $rand asteroids_spawner
}
proc load_asts {} {
set i 0
image create photo asts_all -file asts.gif
for {} {$i < 32} {incr i} {
set row [expr {$i%8}]
set col [expr {$i/8}]
lappend ::asts_light_data [asts_all data -format gif -from [expr {$row*45}] [expr {$col*45}] [expr {$row*45+45}] [expr {$col*45+45}]]
}
for {} {$i < 64} {incr i} {
set row [expr {$i%8}]
set col [expr {$i/8}]
lappend ::asts_dark_data [asts_all data -format gif -from [expr {$row*45}] [expr {$col*45}] [expr {$row*45+45}] [expr {$col*45+45}]]
}
image delete asts_all
}
image create photo ship -file ship.gif
wm title . "Space Ship"
wm minsize . $::win_width $::win_height
wm maxsize . $::win_width $::win_height
tk::canvas .space -width $::win_width -height $::win_height -background #000000
grid .space -column 0 -row 0 -sticky nswe
focus .space
bind .space <KeyPress-Left> {set ::goto_Left 1; set ::goto_Right 0}
bind .space <KeyPress-Right> {set ::goto_Right 1; set ::goto_Left 0}
bind .space <KeyPress-Up> {set ::goto_Up 1; set ::goto_Down 0}
bind .space <KeyPress-Down> {set ::goto_Down 1; set ::goto_Up 0}
bind .space <KeyPress-f> {set ::is_shooting 1}
bind .space <KeyRelease> {
set key %K
if {$key eq "Right" || $key eq "Left" || $key eq "Up" || $key eq "Down"} {
set ::goto_$key 0
} elseif {$key eq "f"} {
set ::is_shooting 0
}
}
set ship [.space create image $::ship_init_x $::ship_init_y -image ship]
load_asts
move_ship
shooting_engine
asteroids_spawner
