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. Added a groundline.
# canvas item id for our lander/taxi rectangle set ::taxiID 0 # refreshtime set ::afterTime 500 proc new {} { # message delete catch {.c delete $::msgID} set ::msgID 0 # 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 loop eventLoop } # main event loop, currently running at 0.5 Hz (poor refresh, simple logic!) proc eventLoop {} { # check for the taxi being destroyed if {$::taxiID == 0} { return } # find the x1 y1 x2 y2 coords for the taxi set coords [.c coords taxi] # if the taxi is moving up (taking off) or has not moved into the ground (aka hard crash or soft land) if {$::velY < 0 || [lindex $coords 3] < [.c cget -height]} { # accelerate incr ::velX $::gravX incr ::velY $::gravY # move according to velocity .c move taxi $::velX $::velY } # reached ground? if {[lindex $coords 1] >= [expr {[.c cget -height] - 10}]} { if {$::velY >= 5 && $::msgID == 0} { # hard crash set ::msgID [.c create text 200 100 -text crashed -fill red] } elseif {$::velY < 5 && $::msgID == 0} { # soft land set ::msgID [.c create text 200 100 -text landed -fill green] } } else { # [ZB] Introduced "else"... prevents event-looping after the game has been ended already # post next update event after $::afterTime eventLoop } } # callback for thruster proc thrustUp {} { incr ::velY -10 } proc thrustLt {} { incr ::velX -5 } proc thrustRt {} { incr ::velX 5 } ### 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 'taxi', a yellow rectangle # set ::taxiID [.c create rectangle 10 10 20 20 -fill yellow -tags taxi] # [ZB] Replaced with GIF "sprite" set tmpData [image create photo -data { R0lGODlhEAAQAMIDAAAAACIiIszMzP///4aGhgAAAEJCQv///yH5BAEAAAcALAAAAAAQABAA AANQeHrR3isGMYQlgpTIqL2ZJnkfRojKZKxsiwaGec6nsXWyTb9ZqNO3ySnzm90OBUHMUSDE jgtDAGjgKAobLBYJvXa5HKakcZwaU8CFFrpWJAAAOw==}] set ::taxiID [.c create image 10 10 -image $tmpData -tags taxi] unset tmpData # [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 . <Left> thrustLt bind . <Right> thrustRt bind . <Key-n> new new