[nedbrek] - This page will document the development of a simple game, similar to the old games "Moon Lander" and "Hey! Taxi!". [ZB]03.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:
   * 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.
----
======

#!/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
======

----
!!!!!!
%| [Category Games] | [Category Animation] | [Category Example] | [Category Tk] |%
!!!!!!