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.
#!/usr/bin/env tclsh # http://wiki.tcl.tk/21673 package require Tk # tk_setPalette black # canvas item id for our lander/taxi rectangle set ::taxiID 0 # refreshtime set ::afterTime 300 proc new {} { if { [info exists ::mlID] } { after cancel $::mlID } if { [info exists ::elID] } { after cancel $::elID } # message delete if { [info exists ::msgID] } { .c delete $::msgID unset ::msgID } # Create lander if { [info exists ::taxiID] } { .c delete $::taxiID } set ::taxiID [.c create image 10 10 -image $::sprite1 -tags taxi] # Make it flying set ::flying yes # gravity in the X/Y directions (constant) set ::gravX 0 set ::gravY 1 # current lander velocity in the X/Y directions set ::velX 1 set ::velY 1 .c coords taxi 10 10 ;# 20 20 # start the game event loops movementLoop ".c" "taxi" mgl } # Separate event loop especially for smooth "lander" movement proc movementLoop { canv vehicle } { global afterTime flying velX velY mlID # 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 } # reached ground? (All ev. further collision-tests should be here) set coords [$canv coords $vehicle] ; # find the x1 y1 x2 y2 coords for the t if {[lindex $coords 1] >= [expr {[$canv cget -height] - 18}]} { set flying no } if { $flying } { $canv move $vehicle $xStep $yStep update idletasks set mlID [after $interval movementLoop $canv $vehicle] } else { return } } # Main Game Loop (has been named eventLoop before) 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 # reached ground? if { ! $::flying } { if {($::velY >= 5) || ($::velX >= 5)} { # hard crash set ::msgID [.c create text 200 100 -text crashed -fill red] # Show wreck .c delete $::taxiID set ::taxiID [.c create image [lindex $coords 0] [lindex $coords 1] -image $::sprite2 -tags taxi] } elseif {$::velY < 5 && $::velX < 5} { # soft land set ::msgID [.c create text 200 100 -text landed -fill green] } } else { incr ::velX $::gravX incr ::velY $::gravY set ::elID [after $::afterTime mgl] } } # callback for thruster proc thrustUp {} { incr ::velY -5 ; if { $::velY == 0 } { set ::velY 1 } } proc thrustDn {} { incr ::velY 5 ; if { $::velY == 0 } { set ::velY 1 } } proc thrustLt {} { incr ::velX -5 ; if { $::velX == 0 } { set ::velX 1 } } proc thrustRt {} { incr ::velX 5 ; if { $::velX == 0 } { set ::velX 1 } } # No speed = 0! Would be to easy, and protection against "div by 0 error" ### GUI # main frame pack [frame .fVel] -side top # current Y velocity pack [label .fVel.lLX -text "X Velocity:"] -side left pack [label .fVel.lVX -textvariable velX] -side left pack [label .fVel.lVY -textvariable velY] -side right pack [label .fVel.lLY -text "Y Velocity:"] -side right # main playing area pack [canvas .c] -side top # create our "lander" (sprite1) - and "wreck" (sprite2) set ::sprite1 [image create photo -data { R0lGODlhEAAQAMIDAAAAACIiIszMzP///4aGhgAAAEJCQv///yH5BAEAAAcALAAAAAAQABAA AANQeHrR3isGMYQlgpTIqL2ZJnkfRojKZKxsiwaGec6nsXWyTb9ZqNO3ySnzm90OBUHMUSDE jgtDAGjgKAobLBYJvXa5HKakcZwaU8CFFrpWJAAAOw==}] set ::sprite2 [image create photo -data { R0lGODlhEgASAKEBAAAAAP///////////yH5BAEKAAIALAAAAAASABIAAAI9lI+py+0PYwIU ILtA2PQqDQadYGGGxomceaXoO1WiXH2zSs3TXIV1e+NxWjkVTnTIgZZKpPL1wpV61CqlAAA7}] # [HE] The groundline .c create line 0 [expr {[.c cget -height] - 10}] [.c cget -width] [expr {[.c cget -height] - 10}] # allow the player to thrust bind . <Up> thrustUp bind . <Down> thrustDn bind . <Left> thrustLt bind . <Right> thrustRt bind . <Key-n> new bind . <Key-space> new bind . <Escape> exit new