Space Invaders
Jos Decoster A Tcl implementation of an old DOS game.
To get 'auto fire', replace the "incr cbln -1" in ::si::start_bl with "after 10 {::si::start_bl}". With this, level 46 is as far as i can get.
Jos Decoster In a first version, shooting was bound to 'KeyPress-Space'. The kids pretty soon found out that moving to the side and holding the space bar down was the easiest way to clear a level.
MG A great little game, thanks for sharing it :) I found a bug, though - when you lose because you ran out of the bullets, the Pause button doesn't turn into a "new game" button, like it does when you lose for another reason. In the '4' part of the switch in ::si::loop, should that closing } be after the $name configure instead of after the puts where it is now?
Jos Decoster Thanks. You are right about case '4'. Fixed it in the code below.
Brian Theado - added package require Tk so it will work in a slave interpreter (i.e. Tk Game Pack)
ZB I'm wondering, why it is so carefully made all in its own namespace? Of course, there's nothing wrong with that - but, actually, what's the point? What are advantages of moving it all into own namespace?
I'm asking, because it's not an extension, neither any library - but a game, I mean: "standalone" software.
jdc Now I only have to add package provide si 1.0 and a pkgIndex.tcl file to make it an extension :-) No special reason to use namespaces here other than me prefering to use variable iso global.
PocketPC version at Pocket Space Invaders
package require Tk
namespace eval ::si {
variable cstat -1
variable ccnt
variable clvl 0
variable cscore 0
variable cbln 0
variable cpath
variable cv_w 500
variable cv_h 500
variable cafter -1
}
proc ::si::init_cv { lvl } {
variable cpath
variable cv
variable cv_w
variable cv_h
variable catt_x 10
variable catt_y 10
variable catt_r 7
variable catt_c 7
variable catt_w 30
variable catt_h 30
variable catt_ix 50
variable catt_iy 50
variable catt_sx 20
variable catt_sy 30
variable csh_w 60
variable csh_h 30
variable csh_sx 20
variable cbl_iy -10
variable cbl_r 3
variable cbll {}
variable csh_id
variable cstat 0
variable ccnt 0
variable cafter -1
variable cbln
if { [info exists cv] && [winfo exists $cv] } {
::destroy $cv
}
set cv [canvas $cpath -width $cv_w -height $cv_h -bg black]
pack $cv
focus $cv
set nat 0
for { set r 0 } { $r < $catt_r} { incr r } {
for { set c 0 } { $c < $catt_c } { incr c } {
set x0 [expr {$catt_x + $c*$catt_ix}]
set x1 [expr {$x0 + $catt_w}]
set y0 [expr {$catt_y + $r*$catt_iy}]
set y1 [expr {$y0 + $catt_h}]
set t [format "att_%d_%d" $r $c]
$cv create rectangle $x0 $y0 $x1 $y1 -tag [list att $t] -fill yellow
incr nat
set rr [expr {int((20+$lvl) * rand())}]
if { $rr > 20 } {
$cv create rectangle $x0 $y0 $x1 $y1 -tag [list att $t] -fill cyan
incr nat
if { $rr > 25 } {
$cv create rectangle $x0 $y0 $x1 $y1 -tag [list att $t] -fill green
incr nat
if { $rr > 30 } {
$cv create rectangle $x0 $y0 $x1 $y1 -tag [list att $t] -fill purple
incr nat
if { $rr > 35 } {
$cv create rectangle $x0 $y0 $x1 $y1 -tag [list att $t] -fill blue
incr nat
}
}
}
}
}
}
set cbln [expr {$cbln + round($nat * 1.4)}]
set cvw2 [expr {$cv_w / 2}]
set shw2 [expr {$csh_w / 2}]
set x0 [expr {$cvw2 - $shw2}]
set y0 [expr {$cv_h - 1}]
set x1 [expr {$cvw2 + $shw2}]
set y1 $y0
set x2 $cvw2
set y2 [expr {$cv_h - $csh_h}]
set csh_id [$cv create polygon $x0 $y0 $x1 $y1 $x2 $y2 -tag sh -fill red]
bind $cv <Left> [list ::si::step_sh l]
bind $cv <Right> [list ::si::step_sh r]
bind $cv <KeyRelease-space> [list ::si::start_bl]
}
proc ::si::step_sh { dir } {
variable cv
variable cv_w
variable csh_sx
variable cstat
if { $cstat != 0 } {
return
}
foreach {mx my Mx My} [$cv bbox sh] { break }
if { $dir == "l" } {
if { [expr {$mx - $csh_sx}] > 0 } {
$cv move sh -$csh_sx 0
}
} else {
if { [expr {$Mx + $csh_sx}] < $cv_w } {
$cv move sh $csh_sx 0
}
}
}
proc ::si::step_att { } {
variable cv
variable cv_w
variable cv_h
variable catt_w
variable catt_sx
variable catt_sy
variable cstat
set dx 0
set dy 0
set bbox [$cv bbox att]
if { [llength $bbox] } {
foreach {mx my Mx My} $bbox { break }
if { $My > $cv_h } {
set cstat 1
} elseif { $catt_sx < 0 } {
if { [expr {$mx + $catt_sx}] < 0 } {
set dy $catt_sy
set catt_sx [expr {-$catt_sx}]
} else {
set dx $catt_sx
}
} else {
if { $Mx > [expr {$cv_w - $catt_w - $catt_sx}] } {
set dy $catt_sy
set catt_sx [expr {-$catt_sx}]
} else {
set dx $catt_sx
}
}
}
$cv move att $dx $dy
}
proc ::si::step_bl { } {
variable cv
variable cbl_iy
$cv move bl 0 $cbl_iy
}
proc ::si::start_bl { } {
variable cv
variable cbl_r
variable cbll
variable cstat
variable cbln
if { $cstat != 0 || $cbln <= 0 } {
return
}
foreach {mx my Mx My} [$cv bbox sh] { break }
set x [expr {($mx+$Mx)/2}]
set y [expr {$my - $cbl_r}]
set x0 [expr {$x - $cbl_r}]
set x1 [expr {$x + $cbl_r}]
set y0 [expr {$y - $cbl_r}]
set y1 [expr {$y + $cbl_r}]
set id [$cv create oval $x0 $y0 $x1 $y1 -tag bl -fill orange]
$cv raise $id
lappend cbll $id
incr cbln -1
}
proc ::si::detect_col { } {
variable cv
variable cbll
variable csh_id
variable cstat
variable cscore
variable cbln
set nbll {}
foreach bli $cbll {
set bb [$cv bbox $bli]
if { [lindex $bb 3] < 0 } {
continue
}
set il [eval $cv find overlapping $bb]
set col 0
for { set idx [expr {[llength $il]-1}] } { $idx >= 0 } { incr idx -1 } {
set i [lindex $il $idx]
if { $i != $bli } {
$cv delete $i $bli
incr cscore 10
incr col
break
}
}
if { !$col } {
lappend nbll $bli
}
}
set cbll $nbll
set il [eval $cv find overlapping [$cv bbox sh]]
foreach i $il {
if { $i != $csh_id } {
$cv delete $csh_id
set cstat 3
return
}
}
set bbox [$cv bbox att]
if { [llength $bbox] == 0 } {
set cstat 2
return
}
if { ($cbln <= 0) && ([llength $cbll] == 0) } {
set cstat 4
}
}
proc ::si::loop { } {
variable cstat
variable ccnt
variable clvl
variable cafter
variable cv
variable cv_w
variable cv_h
variable ngame
incr ccnt
if { $clvl >= 50 || $ccnt == [expr {50-$clvl}] } {
::si::step_att
set ccnt 0
}
::si::step_bl
::si::detect_col
if { $cstat == 0 } {
set cafter [after 10 ::si::loop]
} else {
switch -exact $cstat {
1 {
$cv create text [expr {$cv_w/2}] [expr {$cv_h/2}] -text "Game over ...\nAttackers at bottom." -font "Helvetica 24" -fill white -justify center
update
puts "att at bottom"
$ngame configure -text "New game" -command ::si::new_game
}
2 {
$cv create text [expr {$cv_w/2}] [expr {$cv_h/2}] -text "Level $clvl\ncompleted!" -font "Helvetica 24" -fill white -justify center
update
after 1000
incr clvl
::si::init_cv $clvl
set cafter [after 10 ::si::loop]
puts "all att hit"
}
3 {
$cv create text [expr {$cv_w/2}] [expr {$cv_h/2}] -text "Game over ...\nYou were hit by attacker." -font "Helvetica 24" -fill white -justify center
update
puts "sh hit by att"
$ngame configure -text "New game" -command ::si::new_game
}
4 {
$cv create text [expr {$cv_w/2}] [expr {$cv_h/2}] -text "Game over ...\nYou ran out of bullets." -font "Helvetica 24" -fill white -justify center
update
puts "out of bl"
$ngame configure -text "New game" -command ::si::new_game
}
}
}
}
proc ::si::start { } {
variable cpath
variable cstat
variable cv
variable cv_w
variable cv_h
variable ngame
expr srand([pid])
set tf [frame .tf]
set lf [frame .lf]
set title [label $lf.title -text "Space Invaders"]
grid $title -
set llabel [label $lf.llabel -text "Level"]
set ltext [label $lf.ltext -textvariable ::si::clvl]
grid $llabel $ltext
set blabel [label $lf.blabel -text "Bullets"]
set btext [label $lf.btext -textvariable ::si::cbln]
grid $blabel $btext
set slabel [label $lf.slabel -text "Score"]
set stext [label $lf.stext -textvariable ::si::cscore]
grid $slabel $stext
set ngame [button $lf.ngame -text "New game" -command ::si::new_game]
grid $ngame -
pack $tf $lf -side left
set cpath $tf.cv
set cv [canvas $cpath -width $cv_w -height $cv_h -bg black]
pack $cv
focus $cv
$cv create text [expr {$cv_w/2}] [expr {$cv_h/2}] -text "Space\nInvaders" -font "Helvetica 24" -fill white -justify center
set cstat -1
}
proc ::si::new_game { } {
variable cafter
variable ngame
if { $cafter >= 0 } {
after cancel $cafter
}
variable cstat 0
variable clvl 0
variable cscore 0
variable cbln 0
$ngame configure -text Pause -command ::si::pause
::si::init_cv 0
::si::loop
}
proc ::si::pause { } {
variable cafter
variable ngame
if { $cafter >= 0 } {
after cancel $cafter
}
$ngame configure -text Resume -command ::si::resume
}
proc ::si::resume { } {
variable cafter
variable ngame
variable cstat
if { $cstat == 0 } {
$ngame configure -text Pause -command ::si::pause
::si::loop
}
}
::si::start