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 [namespace code [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