Version 0 of Space Invaders

Updated 2005-03-17 12:06:52

Jos Decoster A Tcl implementation of an old DOS game.

---

  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