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
movement, the second one exclusively as "main game loop" (reading controls, gravity, etc.). Such way we've got smooth movement of our "lander"
anyway)
you've got both hands on the keyboard)
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
HE 2009-04-13: Some changes I made:
PYK 2012-12-09: removed update. Added start message. Space key is only bound when a game is in progress.
Jeff Smith 2019-07-20 : Fifty years ago today! Below is an online demo using CloudTk
1969-07-20 : Neil Armstrong - “Houston, Tranquility Base here. The Eagle has landed”
Unfortunately this script produces the below error when holding the key so no Moon Lander demo today!
divide by zero
while executing
"expr {10 / $interval)
(procedure "movementLoop line 22)
invoked from within
"movementLoop .c taxi"
("after" script) Jeff Smith 2020-08-25 : This demo still produces the above error but runs "Moon Lander" in an Alpine Linux Docker Container. It is a 27.4MB image which is made up of Alpine Linux + tclkit + Moon-Lander.kit + + libx11 + libxft + fontconfig + ttf-linux-libertine. It is run under a user account in the Container. The Container is restrictive with permissions for "Other" removed for "execute" and "read" for certain directories.
# https://wiki.tcl-lang.org/21673
package require Tk
set ::taxiID 0 ; # canvas item id for our lander/taxi rectangle
set ::afterTime 300 ; # refreshtime
set ::lives 3 ;# Lives
set flying no ;# lander isn't flying yet
set config(fuel) 20 ;# fuel value to use
set config(wind) 1 ;# wind value to use
set config(gravity) 2 ;# gravity value to use
set config(gameStarted) no ;# if no then proc game isn't execute
set ::next {}
# HE: To get the Messages more in the middle
proc msgDisplay { canvasName msg color} {
global msgID
catch {$canvasName delete $msgID}
set ch [$canvasName cget -height]
set cw [$canvasName cget -width]
set msgID [$canvasName create text [expr {$cw / 2}] [expr {$ch / 2}] -text $msg -fill $color]
return $msgID
}
proc welcome {} {
set msg {Press @CONTINUE@"n" to @START@}
set continue {}
set start start
if {$::config(gameStarted)} {
set continue "space to continue or "
set start restart
}
set msg [string map [list @CONTINUE@ $continue @START@ $start] $msg]
msgDisplay .c $msg yellow
}
proc gameover {} {
bind . <Key-space> { game .c }
set ::config(gameStarted) no
msgDisplay .c {Game Over} white
after idle {
after 1500
welcome
}
}
proc gameCreate { canvasName } {
global wind gravity roomID la ground
global config
set ch [$canvasName cget -height]
set cw [$canvasName cget -width]
# gravity (Y direction) and ev. wind (X direction) - constant
set wind $config(wind)
set gravity $config(gravity)
# 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]
welcome
}
proc game { canvasName } {
after cancel $::next
bind . <Key-space> { game .c }
global lives score startTimer mlID elID roomID msgID taxiID sprite1 la ground
global fuel flying crashed velX velY startTimer
global config
set fuel $config(fuel); # Fill the tank up (also belongs to "room description" - but done always)
if {!$config(gameStarted)} {
#new game
set score 0
set lives 3
}
set config(gameStarted) yes
# current lander velocity in the X/Y directions
set velX 1
set velY 1
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 } {
gameover
return
}
# (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]
$canvasName coords taxi 80 10
msgDisplay .c "Get ready" yellow
after 1000 [list run $canvasName $msgID]
}
proc run {canvasName msgID} {
set flying yes ; # Make it flying
set crashed no ; # It's new!
$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
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 [list after idle mgl]]
} else {
if { $::crashed } {
.c delete $::taxiID
set ::taxiID [.c create image [lindex $coords 0] [lindex $coords 1] -image $::sprite2 \
-anchor nw -tags taxi]
after idle {
msgDisplay .c "Crashed" red
incr ::lives -1
incr ::score -100
set ::next [after 1500 {
if {$::lives > 0} {
welcome
} else {
gameover
}
}]
}
} else {
incr ::score [expr {500 + $::fuel*10 - ([clock seconds] - $::startTimer)}]
msgDisplay .c "Landed" 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
# HE: Don't resize
wm resizable . 0 0
# 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> { set ::config(gameStarted) no ;game .c }
bind . <Escape> exit
# HE: Auskommentiert damit Spiel nicht sofort startet
#game ".c"
gameCreate .c