nedbrek - This page will document the development of a simple game, similar to the old games "Moon Lander" and "Hey! Taxi!". ZB03.10.2008. It was "Space Taxi"
The code will be presented piecemeal, in the history. (Please comment in the history based on what type of changes added - "added $feature", "fixed bug", "added comments")
It can also be used to demonstrate simple physics (gravity/acceleration, velocity, and position).
It's amazing how much more fun it is when you add left and right thrust! That's 22 (base, no comments, no blanks) to 35 lines of code (with X thrust)!
HE 2008-10-03: Added the following:
ZB Introduced "else"... prevents event-looping after the game has been ended already
HE 2008-10-12: With ZB's change the game cannot started again with key n. I moved
# start the game event loop eventLoop
at the end of the code in the proc new. Now the game can started again with key n.
ZB 2008-10-19 Isn't it nicer with "real lander"? ;)
HE 2008-10-20 The lander lands outside the canvas (ZB It was because the moon dust is very soft, so the lander partially digged in itself while landing ;). Added a groundline.
ZB 2009-04-05
JAG 2009-04-05 The code below is currently broken. Look for "groundline" in the code and notice that the canvas line command is incomplete. ZB - thanks, fixed.
ZB 2009-04-11
#!/usr/bin/env tclsh # http://wiki.tcl.tk/21673 package require Tk set ::taxiID 0 ; # canvas item id for our lander/taxi rectangle set ::afterTime 300 ; # refreshtime set ::lives 3 proc game { canvasName } { global lives score startTimer mlID elID roomID msgID taxiID sprite1 la ground global fuel flying crashed wind gravity velX velY startTimer # The playground is created below if { ! [info exists roomID] } { set ch [$canvasName cget -height] set cw [$canvasName cget -width] # gravity (Y direction) and ev. wind (X direction) - constant set wind 1 set gravity 2 # The landscape set ground [$canvasName create rectangle 0 [expr {$ch - 10}] $cw $ch -fill brown4 -outline brown4 \ -tag "ground"] # The landing area set la [$canvasName create line 0 [expr {$ch - 12}] 100 [expr {$ch - 12}] -fill black -width 3 \ -tag "land_here"] $canvasName move $la 120 0 # We can add handful of stars then for {set ii 0} {$ii < 100} {incr ii} { set rxpos [expr {round(rand() * $cw)}] set rypos [expr {round(rand() * ($ch - 15))}] $canvasName create line $rxpos $rypos [expr {$rxpos + 1}] $rypos -fill white -width 1 \ -tag "nothing" } # Room name set roomID [$canvasName create text 20 10 -text "Earth" -fill green1] } set fuel 20 ; # Fill the tank up (also belongs to "room description" - but done always) # End of playground definition # current lander velocity in the X/Y directions set velX 1 set velY 1 set score 0 set startTimer 0 if { [info exists mlID] } { after cancel $mlID } if { [info exists elID] } { after cancel $elID } # message delete (if exists) if { [info exists msgID] } { $canvasName delete $msgID unset msgID } # Out of landers? Exit... if { $lives == 0 } { set msgID [$canvasName create text 160 100 -text "Game over" -fill white] update idletasks after 2000 $canvasName delete $msgID exit } # (Still) alive? Create new lander if { [info exists taxiID] } { $canvasName delete $taxiID } set taxiID [$canvasName create image 10 10 -image $sprite1 -anchor nw -tags taxi] set flying yes ; # Make it flying set crashed no ; # It's new! $canvasName coords taxi 80 10 set msgID [$canvasName create text 160 100 -text "Get ready" -fill yellow] update idletasks after 1000 $canvasName delete $msgID set startTimer [clock seconds] # start the game event loops movementLoop $canvasName "taxi" mgl } # callback for thruster proc thrust { direction } { global fuel velY velX flying if { ! $flying } { return } if { $direction eq "up" || $direction eq "left" } { set velDiff -5 } else { set velDiff 5 } if { $direction eq "up" || $direction eq "down" } { set whichVel "velY" } else { set whichVel "velX" } if { $fuel } { incr fuel -1 incr $whichVel $velDiff } } proc onTheMove { canv vehicle } { global flying crashed velY velX la ground set coords [$canv coords $vehicle] set x1 [lindex $coords 0] set x2 [expr {$x1 + [image width [$canv itemcget $vehicle -image]]}] set y1 [lindex $coords 1] set y2 [expr {$y1 + [image height [$canv itemcget $vehicle -image]]}] set collision [$canv find overlapping $x1 $y1 $x2 $y2] if { $la in $collision || $ground in $collision } { set flying no if { $ground in $collision || ($velY > 5) || (abs($velX) > 3) } { set crashed yes } else { set crashed no } return no } else { set flying yes return yes } } # Separate event loop especially for smooth "lander" movement proc movementLoop { canv vehicle } { global afterTime flying crashed velX velY mlID if { $velX == 0 } { set velX 1 } if { $velY == 0 } { set velY 1 } # No speed = 0! Would be to easy (there's no speed=0 while flying; you're # always on the move), and protection against "div by 0 error" # Speed=1 -> 1px/100ms, 2 -> 2px/100ms (=1px/50ms) etc. set baseInterval 100 # $interval not shorter than 10ms! if { abs($velY) >= abs($velX) } { set interval [expr {abs($baseInterval / $velY)}] set xStep [expr {$velX * 1.0 / abs($velY)}] set yStep [expr {($velY >= 0) ? 1 : -1}] } else { set interval [expr {abs($baseInterval / $velX)}] set yStep [expr {$velY * 1.0 / abs($velX)}] set xStep [expr {($velX >= 0) ? 1 : -1}] } if { $interval < 10 } { set coeff [expr {10 / $interval}] set yStep [expr {round($yStep * $coeff)}] set xStep [expr {round($xStep * $coeff)}] set interval 10 } if { [onTheMove $canv $vehicle] } { $canv move $vehicle $xStep $yStep update idletasks set mlID [after $interval movementLoop $canv $vehicle] } } # Main Game Loop proc mgl {} { # check for the taxi being destroyed if {$::taxiID == 0} { return } set coords [.c coords taxi] ; # find the x1 y1 x2 y2 coords for the taxi if { $::flying } { incr ::velX $::wind incr ::velY $::gravity set ::elID [after $::afterTime mgl] } else { if { $::crashed } { .c delete $::taxiID set ::taxiID [.c create image [lindex $coords 0] [lindex $coords 1] -image $::sprite2 \ -anchor nw -tags taxi] update idletasks set ::msgID [.c create text 160 100 -text "Crashed" -fill red] incr ::lives -1 incr ::score -100 } else { incr ::score [expr {500 + $::fuel*10 - ([clock seconds] - $::startTimer)}] set ::msgID [.c create text 160 100 -text "Landed" -fill green] } } } ### GUI # main frame pack [frame .fVel] -side top # current Y velocity pack [label .fVel.lLX -text "X-Vel: " -justify left] -side left pack [label .fVel.lVX -textvariable velX -width 3 -justify right] -side left pack [label .fVel.lLY -text "Y-Vel: " -justify left] -side left pack [label .fVel.lVY -textvariable velY -width 3 -justify right] -side left pack [label .fVel.f1 -text "Fuel: " -justify left] -side left pack [label .fVel.f2 -textvariable fuel -width 2 -justify right] -side left pack [label .fVel.l1 -text "Lives: " -justify left] -side left pack [label .fVel.l2 -textvariable lives -justify right] -side left pack [label .fVel.s1 -text "Score: " -justify left] -side left pack [label .fVel.s2 -textvariable score -width 5 -justify right] -side left # Main playing area. pack [canvas .c -background blue4] -side top # sprite1 - "lander", sprite2 - "wrecked lander" set ::sprite1 [image create photo -data { R0lGODlhEAAQAMIDAAAAACIiIszMzP///4aGhgAAAEJCQv///yH5BAEAAAcALAAAAAAQABAA AANQeHrR3isGMYQlgpTIqL2ZJnkfRojKZKxsiwaGec6nsXWyTb9ZqNO3ySnzm90OBUHMUSDE jgtDAGjgKAobLBYJvXa5HKakcZwaU8CFFrpWJAAAOw==}] set ::sprite2 [image create photo -data { R0lGODlhEgASAKEBAAAAAP///////////yH5BAEKAAIALAAAAAASABIAAAI9lI+py+0PYwIU ILtA2PQqDQadYGGGxomceaXoO1WiXH2zSs3TXIV1e+NxWjkVTnTIgZZKpPL1wpV61CqlAAA7}] # allow the player to thrust bind . <Up> { thrust "up" } bind . <Down> { thrust "down" } bind . <Left> { thrust "left" } bind . <Right> { thrust "right" } bind . <Key-n> { game ".c" } bind . <Key-space> { game ".c" } bind . <Escape> exit game ".c"