#!/usr/bin/wish

# Asteroids.tcl by SIYB (siyb@geekosphere.org)
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.

if {$tcl_version != 8.4} {
	puts "*** WARNING *** THIS PROGRAM HAS BEEN TESTED WITH TCL/TK 8.4, THERE MIGHT BE SOME PERFORMANCE IMPLICATIONS WHEN USING A DIFFERENT VERSION. IF YOU EXPERIENCE PERFORMANCEDROPS ADJUST THE GAMELEVELS!"
}	

namespace eval asteroids {
	
	#
	# Engine related variables
	#
	
	# system 
	variable version
	set version 1.0
	variable debug; set debug 0
	
	variable after_move
	variable after_spawn
	variable after_osd
	
	
	# game level
	variable lifes 3
	variable maxlevel 
	set maxlevel 7
	variable lvl; if {$argv == ""} { set lvl 1 } { set lvl $argv }; if {$argv > $maxlevel} { set lvl $maxlevel }
	variable level
	array set level {
		overall,score 0
		
		1,spawinterval 1000
		1,movementinterval 50
		1,movedistance 1
		1,enemies 1
		1,score 1500
		
		2,spawinterval 800
		2,movementinterval 40
		2,movedistance 2
		2,enemies 2
		2,score 5000
		
		3,spawinterval 800
		3,movementinterval 35
		3,movedistance 2
		3,enemies 3
		3,score 15000
			
		4,spawinterval 600
		4,movementinterval 30
		4,movedistance 2
		4,enemies 4
		4,score 40000
		
		5,spawinterval 500
		5,movementinterval 20
		5,movedistance 2
		5,enemies 5
		5,score 130000
		
		6,spawinterval 450
		6,movementinterval 10
		6,movedistance 3
		6,enemies 5
		6,score 350000
		
		7,spawinterval 350
		7,movementinterval 5
		7,movedistance 4
		7,enemies 5
		7,score 1000000
	}
	
	# misc
	variable osd
	set osd ""
	
	# ships
	variable hitlist
	set hitlist { }
	variable eneiter; set eneiter 0
	variable shipiter
	variable ship
	array set ship {
		pl,ship ""
	}
	
	# directions
	variable left -10,0
	variable right 10,0
	variable down 0,$level($lvl,movedistance)

	#
	# Window Settings
	#
	wm resizable . 0 0
	wm title . "Asteroids $version"

	#
	# Drawing battleground
	#
	pack [canvas .c -width 500 -height 500 -background black] -expand 1 -fill both
	
	bind . <Left> {asteroids::move $asteroids::left }
	bind . <Right> { asteroids::move $asteroids::right }
	bind . <h> {asteroids::showhighscore }
	bind . <Key> { asteroids::debug "init: key -> %K" }
	
	pack [button .b1 -text "Start" \
		-command { 
			if {$asteroids::lvl > $asteroids::maxlevel} { set asteroids::lvl $asteroids::maxlevel }
			asteroids::start
			.f2.e1 config -state disabled
			.b1 config -state disabled
		}
	] -expand 1 -fill x 
	
	# score
	pack [frame .f1] -fill both -expand 1 -side bottom
	pack [label .f1.l1 -text "Score"] -expand 1 -fill x -side left
	pack [entry .f1.e1 -textvariable asteroids::level(overall,score)] -expand 1 -fill x -side right
	.f1.e1 config -state disabled
	
	# level
	pack [frame .f2] -fill both -expand 1 -side bottom
	pack [label .f2.l1 -text "Level"] -expand 1 -fill x -side left
	pack [entry .f2.e1 -textvariable asteroids::lvl] -expand 1 -fill x -side right
	
	# lifes
	pack [frame .f3] -fill both -expand 1 -side bottom
	pack [label .f3.l1 -text "Lifes "] -expand 1 -fill x -side left
	pack [entry .f3.e1 -textvariable asteroids::lifes] -expand 1 -fill x -side right
	.f3.e1 config -state disabled


	#
	# Routine
	#
	
	# debugging
	proc debug {msg} {
		if {$asteroids::debug} { puts "*** DEBUG *** $msg"}
	}
	
	# start the game
	proc init {} {
		global ship
		set asteroids::ship(pl,cx) 0
		set asteroids::ship(pl,cy) 450
		set asteroids::ship(pl,ship) [.c create oval 20 20 0 0 -fill white]; # create the ship
		
		.c move $asteroids::ship(pl,ship) $asteroids::ship(pl,cx) $asteroids::ship(pl,cy); # get the ship into the right position
	}
	
	# move the player's ship
	proc move {direction} {
		set coords [.c coords $asteroids::ship(pl,ship)]
		set barrier [lindex [split $coords] 2]
		if {($barrier >= 499 && $direction != $asteroids::left)  || $barrier <= 24 && $direction != $asteroids::right} { return }
		.c move $asteroids::ship(pl,ship) [lindex [split $direction ,] 0] [lindex [split $direction ,] 1]
		asteroids::debug "move: coords -> $coords"
	}
	
	# rand function
	proc rand  {min max} {
		set maxf [expr [expr $max + 1] - $min]
		set value [expr int([expr rand() * 500])]
		set value [expr [expr $value % $maxf] + $min]
		return $value
	}

	
	# create and place enemies
	proc createenemy {} {
		for {set iter 0} {$iter < $asteroids::level($asteroids::lvl,enemies)} {incr iter} {
			set rand [rand 0 476]
			if {$asteroids::debug} { set asteroids::ship(enemy,$asteroids::eneiter) [.c create text 20 20 -fill red -text $asteroids::eneiter -tags enemy] } else { set asteroids::ship(enemy,$asteroids::eneiter) [.c create oval 0 0 10 10 -fill red -tags enemy] }
			asteroids::debug "createenemy: rand -> $rand"
			.c move $asteroids::ship(enemy,$asteroids::eneiter) $rand 0
			incr asteroids::eneiter
		}
		set asteroids::after_spawn [after $asteroids::level($asteroids::lvl,spawinterval) { asteroids::createenemy }]
	}
	
	# move enemies
	proc movee {} {
		foreach {item content} [array get asteroids::ship enemy,*] {
			.c move $asteroids::ship($item) [lindex [split $asteroids::down ,] 0] [lindex [split $asteroids::down ,] 1]
			set coords [.c coords $asteroids::ship($item)]
			asteroids::debug "movee: enemy coords -> $item @ $coords"
			foreach coord $coords {
				if {$coord >= 500} { 
					if {[info exists asteroids::ship($item)]} {
						.c delete $asteroids::ship($item)
						unset asteroids::ship($item)
						score $asteroids::lvl
						set check 1
						break
					}
					asteroids::debug "movee: enemy ship $item has left the grid." 
				}
			}
			if {![info exists check]} { collision $asteroids::ship($item) }
		}
		set asteroids::after_move [after $asteroids::level($asteroids::lvl,movementinterval) { asteroids::movee }]
	}
	
	# check for a collision
	proc collision {eship} {
		if {[info exists ::gameover]} { return }
		set ecoords [.c coords $eship]
		set pcoords [.c coords $asteroids::ship(pl,ship)]
		.c addtag overlapping overlapping [lindex [split $pcoords] 0] [lindex [split $pcoords] 1] [lindex [split $pcoords] 2] [lindex [split $pcoords] 3]
		set overlapping [.c find withtag overlapping]
		if {[llength $overlapping] > 1} {
			foreach item $overlapping {
				if {$item == 1} { continue }
				if {[lsearch $asteroids::hitlist $item] == -1} {
					set asteroids::hitlist [lappend asteroids::hitlist $item]
					asteroids::die
					asteroids::debug "collision: hitlist -> $asteroids::hitlist"
				}
			}
		}
		asteroids::debug "colide: overlapping -> $overlapping ecoords -> $ecoords pcoords -> $pcoords"
	}
	
	# called when player looses a life
	proc die {} {
		set asteroids::lifes [expr $asteroids::lifes - 1]

		if {$asteroids::lifes < 0} {
			set asteroids::lifes DEAD
			set ::gameover 1
			asteroids::highscore
			
		} else {
			asteroids::osd "You lost a life" 1000
		}
	}
	
	# calculate score
	proc score {level} {
		if {[info exists ::gameover]} { return }
		set asteroids::level(overall,score) [expr $asteroids::level(overall,score) + (10*$level)]
		advance2next
	}
	
	# advance to next level
	proc advance2next {} {
		if {$asteroids::level(overall,score) >= $asteroids::level($asteroids::lvl,score) && $asteroids::lvl < $asteroids::maxlevel} {
			asteroids::debug "advance2next: OverallScore -> $asteroids::level(overall,score) || AdvanceScore -> $asteroids::level($asteroids::lvl,score)"
			incr asteroids::lvl
			asteroids::osd "You reached the next level: $asteroids::lvl" 1000
		}
	}
	
	# cleanup after game
	proc cleanup {} {
		foreach aft [after info] { after cancel $aft }
		
		foreach item [.c find withtag all] {
			.c delete $item
		}
		
		set asteroids::lifes 3
		set asteroids::level(overall,score) 0
		set asteroids::lvl 1
		set asteroids::hitlist { }
	}
	
	# osd
	proc osd {msg time} {
		if {$asteroids::osd != ""} { after cancel $asteroids::after_osd; .c delete $asteroids::osd; set asteroids::osd "" }
		set asteroids::osd [.c create text 0 0 -text "$msg" -fill green]
		.c move $::asteroids::osd 250 250
		set asteroids::after_osd [after $time { .c delete $asteroids::osd; set asteroids::osd "" }]
	}
	
	# recordhighscore
	proc highscore {} {
		if {[winfo exists .highscore]} { return }
		set ::score $asteroids::level(overall,score)
		set ::level $asteroids::lvl
		toplevel .highscore
		pack [entry .highscore.e1 -textvariable ::name]
		pack [button .highscore.b1 -text "Submit" \
				-command {
					if {$::name == ""} { return }
					set fl [open highscore a+];puts $fl "$::score $::name $::level"; close $fl
					exit
				}
			]
	}
	
	# display highscore
	proc showhighscore {} {
		if {[winfo exists .highscorewindow] || ![file exists highscore]} { return }
		toplevel .highscorewindow
		pack [text .highscorewindow.t1] -expand 1 -fill both
		
		set fl [open highscore r]; set data [split [read $fl] \n];close $fl
		
		set iter 1
		.highscorewindow.t1 insert end "Score	Nick	Level\n"
		foreach item $data {
			if {$item != "" } {
				.highscorewindow.t1 insert end "$iter) $item\n"
				incr iter
			}
		}
		
		.highscorewindow.t1 config -state disabled
	}
	
	# start game
	proc start {} {
		asteroids::init;# create player ship and bind keys
		asteroids::createenemy;# creates enemies according to level
		set asteroids::after_move [after $asteroids::level($asteroids::lvl,movementinterval) { asteroids::movee }];# move enemies
	}
}