Moon Lander

summary

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"

Description

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)!

Changes

HE 2008-10-03: Added the following:

  • Bugfix second line: set ::gravY 0 => set ::gravX 0
  • grouped some initialisation inside a proc
  • New start with key n
  • detect hard crash (>=5) or soft land (<5)
  • refreshtime set in global variable ::afterTime and default to 500

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

  • major change: separated event loops. First one especially for "sprite"
   movement, the second one exclusively as "main game loop" (reading controls,
   gravity, etc.). Such way we've got smooth movement of our "lander"
  • added sprite for "wreck" (not especially fancy, but looks out like debris,
   anyway)
  • added "reverse thrust" (down)
  • added restart with space bar (more comfortable restart with left thumb, if
   you've got both hands on the keyboard)
  • added "quit game " with Escape
  • some additional sanitization of the code

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

  • added landscape
  • added fuel counter
  • added lives counter
  • safe landing requires: a) Touchdown on landing area (thick black line) ...while having: b) X-velocity < 4, c) Y-velocity < 6
  • score counting: 500 points for safe landing + 10 pts for every unit of fuel saved - 1 pt for every second of mission duration (when mission has been completed). When incomplete: -100 pts for every wreck (3 lives)
  • there can be a wind (horizontal force), not just gravity (vertical one)
  • better collision detection
  • several other changes / code sanitization

HE 2009-04-13: Some changes I made:

  • now the program do not start directly after loading
  • now the program do not end after losing all lives
  • key n starts a new game. key space starts a new approach for a landing
  • state messages are set with procedure msgDisplay for easier management (for example: to display the text in the middle of the playground)
  • some values are defined outside the code for easier changes
  • inside a game the scores of all approaches for a landing are added now (before every approach are reseting the soore)
  • avoiding to change the size of the window

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.


Code

# 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

Moon Lander screen.png

gold