[Jos Decoster] A Tcl implementation of an old DOS game. [WikiDbImage si.gif] ---- 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]) ---- [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 [list ::si::step_sh l] bind $cv [list ::si::step_sh r] bind $cv [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 ---- !!!!!! |[Category Games]| !!!!!!