#!/usr/bin/env tclsh

# http://wiki.tcl.tk/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

 # 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 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]
 }

 proc gameNew { canvasName } {
   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)

   # current lander velocity in the X/Y directions
   set velX 1
   set velY 1
   set score 0
   set startTimer 0
   set lives 3
   if { [info exists mlID] } { after cancel $mlID }
   if { [info exists elID] } { after cancel $elID }

   # (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]
   set flying yes ; # Make it flying
   set crashed no ; # It's new!
   set config(gameStarted) yes

   $canvasName coords taxi 80 10

   msgDisplay .c "Get ready" yellow
   update idletasks
   after 1000
   $canvasName delete $msgID

   set startTimer [clock seconds]

   # start the game event loops   
   movementLoop $canvasName "taxi"
   mgl
 }

 proc game { canvasName } {
   global lives score startTimer mlID elID roomID msgID taxiID sprite1 la ground
   global fuel flying crashed velX velY startTimer
   global config

   if {!$config(gameStarted)} {
        return
   }
   set fuel $config(fuel); # Fill the tank up (also belongs to "room description" - but done always)

   # current lander velocity in the X/Y directions
   set velX 1
   set velY 1
   # HE: score only set to 0 in gameNew
   #set score 0
   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 } {
     msgDisplay .c "Game over" white
     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]
   set flying yes ; # Make it flying
   set crashed no ; # It's new!

   $canvasName coords taxi 80 10

   msgDisplay .c "Get ready" yellow
   update idletasks
   after 1000
   $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
     update idletasks
     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 mgl]
   } else {
     if { $::crashed } {
       .c delete $::taxiID
       set ::taxiID [.c create image [lindex $coords 0] [lindex $coords 1] -image $::sprite2 \
           -anchor nw -tags taxi]
       update idletasks
       msgDisplay .c "Crashed" red
       incr ::lives -1
       incr ::score -100
     } 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>     { gameNew ".c" }
 bind . <Key-space> { game ".c" }
 bind . <Escape>    exit

 # HE: Auskommentiert damit Spiel nicht sofort startet
 #game ".c"
 gameCreate .c