** Attributes **

   by:   [http://personalphao.wordpress.com%|%Pedro Henrique%|%]

   location:   [http://pastie.org/pastes/4568327/text%|%pastie.org%|%]

** Introduction **

A simple [Asteroids]-like game written by the author as a Tcl learning exercise


** Code **

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
======