#!/bin/sh
# the next line restarts using wish \
exec wish "$0" "$@"

#   Tickletankle - a 2 player tank game with fractal terrain
#   Copyright (C) 2002, 2003 Markus Triska
#
#   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 USA
#
#   You can contact me via triska@gmx.at

if {[info tclversion] < 8.3} {
	puts "This program requires Tcl >= 8.3. You have: [info tclversion]"
	exit
}

# Some global constants and parameters

set version "0.8"
set protocol_version 2
set pi 3.1415926
set ticinterval 100
set width 600
set newwidth $width
set height 400
set newheight $height
set pwidth 20
set pheight 20
set plife 100
set shotsize 6
set shotimpactterrain 20
set shotimpactplayer  20
set bgcolor "#00009999ffff"
set fgcolor "#0000eeee0000"
set cannonrotationspeed 5
set cannonlength 15
set cannonloadingspeed 1
set playerspeed 3
set maxshotspeed 30
set gravity 1
set showcannonstatus 1
set netport "8563"

array set protocol {sendversion 1 loginok 2 loginrejected 3 tic 4 hit 5 \
	startnewgame 6 setparams 7}

set maxdistortion [expr $height / 2]
set playing 0
set growing 1
set netgame 0
set aigame  1
set sockfd -1
set listenfd -1
set maxticdiff 3
set gametic  0
set leasttic 0
set hosting 0
set serverip "127.0.0.1"

array set theterrain {}

array set player1  {}
array set player2  {}
array set aiplayer {}

array set gameswon {player1 0 player2 0}


# A list of currently flying shots. The next free shotid is 1 if there are no
# elements in the array, or max(shotids) + 1 otherwise. Because new shotids
# are appended to this list, it will always be sorted in ascending order.
set shotids {}
# Everything you want to know about a shot (position, angle, speed, gravity)
array set shotinfo {}

# Taken from "Algorithms in C" by Robert Sedgewick

set rand_m 100000000
set randomseed [clock clicks]

proc mult {p q} {
	global rand_m
	set m1 10000
	set p1 [expr $p / $m1]
	set p0 [expr $p % $m1]
	set q1 [expr $q / $m1]
	set q0 [expr $q % $m1]
	return [expr ((($p0 * $q1 + $p1 * $q0) % $m1)*$m1+$p0*$q0) % $rand_m]
}

proc random {} {
	global randomseed rand_m
	set b 31315821
	set multit [mult $randomseed $b]
	incr multit
	set randomseed [expr $multit % $rand_m]
	return $randomseed
}

proc make_terrain {x1 x2} {
	global theterrain
	# puts "Making fractal between $x1 and $x2"
	global maxdistortion growing height pheight

	if {[expr abs($x1 - $x2)] <= 1} { return }

	set y1 $theterrain($x1)
	set y2 $theterrain($x2)

	set midpointx [expr ($x1 + $x2) / 2]
	set midpointy [expr ($y1 + $y2) / 2]
	# Random midpoint displacement algorithm, dependent on distance l
	set l [expr $x2 - $x1]
	if {$growing == -1} {
		# During the game playing phase (i.e., when the terrain is not
		# generated anew, but only modified in places), distort less.
		set l [expr $l / 2]
	}
	set rrange [expr $maxdistortion % $l]
	if {$rrange > 0} {
		incr midpointy [expr ([random] % $rrange) * $growing]
		if {$midpointy >= $height} {
			set midpointy [expr $height - 2*$pheight]
		}
	}

	if {$growing == -1} {
		# This relies on the fact that we only set growing to -1 if
		# the terrain has already been computed completely
		if {$midpointy < $theterrain($midpointx)} {
			# ... we only lower, never raise the terrain then
			set theterrain($midpointx) $midpointy
		}
	} else {
		set theterrain($midpointx) $midpointy
	}
	make_terrain $x1 $midpointx
	make_terrain $midpointx $x2
}

proc redraw_playfield {x1 x2} {
	global theterrain height
	for {set i $x1} {$i <= $x2} {incr i} {
		.playfield coords heightline-$i $i $height $i [expr $height - $theterrain($i)]
	}
	draw_player player1
	draw_player player2
}

proc player_hit {playername} {
	upvar #0 $playername player
	global gameswon playing shotimpactplayer
	if {$playing == 0} { return }

	set player(life) [expr $player(life) - $shotimpactplayer]
	if {$player(life) <= 0} {
		set playing 0
		set playernum [string index $playername 6]
		set wonplayernum 1
		if {$playernum == 1} {
			set wonplayernum 2
		}
		incr gameswon(player$wonplayernum)
		set top [transient_window .newgame "Game won"]
		set info [dialog_info $top]
		label $info.wonmsg -text "Player $wonplayernum won the game!"
		pack $info.wonmsg -pady 4 -padx 10 -side left -expand yes
		set c [dialog_controls $top]
		global newgameok
		set newgameok ""
		pack [button $c.ok -text "  OK  " -command { set newgameok 1 }]
		set_geometry $top
		focus $c.ok
		tkwait variable newgameok
		destroy $top
		global netgame hosting
		# if we are the client, the server will send us new game msg
		if {!$netgame || $hosting} {
			start_new_game
		}
	}
	adjust_lifebar $playername
}

proc check_player_terrain_hit {playername xcoor} {
	# check whether this shot (which hit the terrain) also has any impact
	# on $playername (i.e., if it is within $shotimpactterrain)
	upvar #0 $playername player
	global shotimpactplayer shotimpactterrain
	set dist [expr abs($player(x) - $xcoor)]
	if {$dist == 0} { set dist 1 }
	if {$dist <= $shotimpactterrain} {
		set theimpact [expr $shotimpactplayer * 3 / $dist]
		set player(life) [expr $player(life) - $theimpact]
		player_hit $playername
	}
}

proc hit_terrain {xcoor} {
	global theterrain shotimpactterrain width
	set theterrain($xcoor) [expr $theterrain($xcoor) - $shotimpactterrain]
	set x1 [expr $xcoor - $shotimpactterrain]
	set x2 [expr $xcoor + $shotimpactterrain]
	if {$x1 < 0} {set x1 0}
	if {$x1 > $width} {set x1 $width}
	if {$x2 > $width} {set x2 $width}
	make_terrain $x1 $xcoor
	make_terrain $xcoor $x2

	check_player_terrain_hit player1 $xcoor
	check_player_terrain_hit player2 $xcoor
	redraw_playfield $x1 $x2
}

proc create_player {playername colour} {
	upvar #0 $playername player
	global theterrain pwidth pheight
	set x $player(x)
	set y $theterrain($player(x))
	.playfield create oval [expr $x - $pwidth/2] [expr $y - $pheight/2] \
		[expr $x + $pwidth / 2] [expr $y + $pheight/2] -fill $colour \
		-tag $playername

	# we create the cannon here, but the coordinates are adjusted later
	.playfield create line $x $y $x $y -fill black -width 2.0 -tag $playername-cannon
	draw_player $playername
}

proc getfreeshotid {} {
	global shotids

	if {[llength $shotids] == 0} {
		set freeshotid 1
	} else {
		set freeshotid [expr [lindex $shotids end] + 1]
	}
	return $freeshotid
}

proc player_fire {playername} {
	upvar #0 $playername player
	global shotids shotinfo shotsize
	set player(fire) 0
	set player(loading) 0
	set shotid [getfreeshotid]
	set shotinfo($shotid-x) $player(cannonendx)
	set shotinfo($shotid-y) $player(cannonendy)
	set shotinfo($shotid-speed) $player(shotspeed)
	if {$shotinfo($shotid-speed) == 0} {
		set shotinfo($shotid-speed) 1
	}
	set shotinfo($shotid-gravity) 0
	set shotinfo($shotid-angle) $player(cannonangle)

	set x1 [expr $shotinfo($shotid-x) - $shotsize / 2]
	set y1 [expr $shotinfo($shotid-y) - $shotsize / 2]
	set x2 [expr $x1 + $shotsize]
	set y2 [expr $y1 + $shotsize]
	.playfield create oval $x1 $y1 $x2 $y2 -fill black -tags [list shot-$shotid theshots]
	# Race condition here: We could be interrupted by net_handle_receive
	# and the other player could have fired. [getfreeshotid] would return
	# the same ID we are working with now.
	lappend shotids $shotid

	set player(shotspeed) 0
	show_cannon_status $playername
	return $shotid
}

proc establish_bindings {} {
	global netgame aigame hosting

	# remove all existing bindings
	foreach binding [bind .playfield] {
		bind .playfield $binding ""
	}

	if {!$netgame || $hosting} {
	bind .playfield <KeyPress-Up> {          set player1(up) 1 }
	bind .playfield <KeyRelease-Up> {        set player1(up) 0 }
	bind .playfield <KeyPress-Down> {        set player1(down) 1 }
	bind .playfield <KeyRelease-Down> {      set player1(down) 0 }
	bind .playfield <KeyPress-Right> {       set player1(right) 1 }
	bind .playfield <KeyRelease-Right> {     set player1(right) 0 }
	bind .playfield <KeyPress-Left> {        set player1(left) 1 }
	bind .playfield <KeyRelease-Left> {      set player1(left) 0 }
	bind .playfield <KeyPress-Shift_R> {     set player1(loading) 1 }
	bind .playfield <KeyRelease-Shift_R> {   set player1(fire) 1 }
	# Windows for instance only delivers Shift_L, regardless which
	# key was pressed.
	bind .playfield <KeyPress-Shift_L> {     set player1(loading) 1 }
	bind .playfield <KeyRelease-Shift_L> {   set player1(fire) 1 }
	} elseif {$netgame && !$hosting} {
	# up and down directions are reversed if this player is the client,
	# because his tank will start on the right
	bind .playfield <KeyPress-Up> {          set player2(down) 1; }
	bind .playfield <KeyRelease-Up> {        set player2(down) 0 }
	bind .playfield <KeyPress-Down> {        set player2(up) 1 }
	bind .playfield <KeyRelease-Down> {      set player2(up) 0 }
	bind .playfield <KeyPress-Right> {       set player2(right) 1 }
	bind .playfield <KeyRelease-Right> {     set player2(right) 0 }
	bind .playfield <KeyPress-Left> {        set player2(left) 1 }
	bind .playfield <KeyRelease-Left> {      set player2(left) 0 }
	bind .playfield <KeyPress-Shift_R> {     set player2(loading) 1 }
	bind .playfield <KeyRelease-Shift_R> {   set player2(fire) 1 }
	bind .playfield <KeyPress-Shift_L> {     set player2(loading) 1 }
	bind .playfield <KeyRelease-Shift_L> {   set player2(fire) 1 }
	}


	if {$netgame || $aigame} { return }

	# Player 2
	# We have to bind upper- and lowercase letters because player 1
	# loads with shift!
	bind .playfield q {                      set player2(down) 1 }
	bind .playfield Q {                      set player2(down) 1 }
	bind .playfield <KeyRelease-q> {         set player2(down) 0 }
	bind .playfield <KeyRelease-Q> {         set player2(down) 0 }
	bind .playfield a {                      set player2(up) 1 }
	bind .playfield A {                      set player2(up) 1 }
	bind .playfield <KeyRelease-a> {         set player2(up) 0 }
	bind .playfield <KeyRelease-A> {         set player2(up) 0 }
	bind .playfield c {                      set player2(right) 1 }
	bind .playfield C {                      set player2(right) 1 }
	bind .playfield <KeyRelease-c> {         set player2(right) 0 }
	bind .playfield <KeyRelease-C> {         set player2(right) 0 }
	bind .playfield x {                      set player2(left) 1 }
	bind .playfield X {                      set player2(left) 1 }
	bind .playfield <KeyRelease-x> {         set player2(left) 0 }
	bind .playfield <KeyRelease-X> {         set player2(left) 0 }
	bind .playfield <KeyPress-Control_L> {   set player2(loading) 1 }
	bind .playfield <KeyRelease-Control_L> { set player2(fire) 1 }
	bind .playfield <KeyPress-Control_R> {   set player2(loading) 1 }
	bind .playfield <KeyRelease-Control_R> { set player2(fire) 1 }
}

proc draw_cannon {playername} {
	upvar #0 $playername player
	global pheight cannonlength height pi
	set x1 $player(x)
	set y1 $player(y)
	set x2 [expr int($x1 + cos($player(cannonangle)*$pi/180)*$cannonlength)]
	set y2 [expr int($y1 - sin($player(cannonangle)*$pi/180)*$cannonlength)]
	set player(cannonendx) $x2
	set player(cannonendy) $y2
	.playfield coords $playername-cannon $x1 $y1 $x2 $y2
	.playfield raise $playername-cannon
}

proc draw_player {playername} {
	upvar #0 $playername player
	global theterrain height width pwidth pheight

	if {$player(x) < [expr $pwidth / 2]} {set player(x) [expr $pwidth / 2]}
	if {$player(x) > [expr $width - ($pwidth / 2)]} {
		set player(x) [expr $width - ($pwidth / 2)]
	}
	set player(y) [expr $height - $theterrain($player(x)) - ($pheight / 2)]

	set x $player(x)
	set y $player(y)
	.playfield coords $playername [expr $x - ($pwidth / 2)] \
			[expr $y - ($pheight / 2)] [expr $x + ($pwidth / 2)] \
			[expr $y + ($pheight / 2)]
	.playfield raise $playername
	draw_cannon $playername
}

proc remove_shot {shotid} {
	global shotids shotinfo
	set theindex [lsearch $shotids $shotid]
	set shotids [lreplace $shotids $theindex $theindex]
	unset shotinfo($shotid-angle)
	unset shotinfo($shotid-speed)
	unset shotinfo($shotid-x)
	unset shotinfo($shotid-y)
	unset shotinfo($shotid-gravity)
	.playfield delete shot-$shotid
}


proc check_player_hit {playername shotid} {
	upvar #0 $playername player
	global shotinfo pheight pwidth shotsize height
	set distx [expr $player(x) - $shotinfo($shotid-x)]
	set disty [expr $player(y) - $shotinfo($shotid-y)]
	set dist [expr int(hypot($distx, $disty))]

	# This relies on players and shots being circles (not ovals)
	set player_radius [expr $pwidth / 2]
	set shot_radius   [expr $shotsize / 2]
	set both_radius   [expr $player_radius + $shot_radius]

	if {$dist < $both_radius} {
		player_hit $playername
		return true
	}
	return false
}


proc shot_one_tic {shotid} {
	global shotinfo pi shotsize width height theterrain gravity

	# move this bullet further along its way
	set angle $shotinfo($shotid-angle)
	set distx [expr int(cos($angle*$pi/180)*$shotinfo($shotid-speed))]
	set disty [expr int(sin($angle*$pi/180)*$shotinfo($shotid-speed))]
	# simulate gravity
	incr shotinfo($shotid-gravity) $gravity

	set curx $shotinfo($shotid-x)
	set cury $shotinfo($shotid-y)
	set targetx [expr $curx + $distx]
	set targety [expr $cury - $disty + $shotinfo($shotid-gravity)]
	set stepx 1
	set stepy 1
	if {$targetx < $curx} { set stepx -1 }
	if {$targety < $cury} { set stepy -1 }

	# we now move the shot pixel by pixel to its intermediate destination
	# (a very rough approximation, but better than nothing)
	while {$shotinfo($shotid-x) != $targetx || $shotinfo($shotid-y) != $targety} {
		if {$shotinfo($shotid-x) != $targetx} {
			incr shotinfo($shotid-x) $stepx
		}
		if {$shotinfo($shotid-y) != $targety} {
			incr shotinfo($shotid-y) $stepy
		}

		set x1 [expr $shotinfo($shotid-x) - $shotsize / 2]
		set y1 [expr $shotinfo($shotid-y) - $shotsize / 2]
		set x2 [expr $x1 + $shotsize]
		set y2 [expr $y1 + $shotsize]

		.playfield coords shot-$shotid $x1 $y1 $x2 $y2

		# if this has moved the bullet out of sight, we are done
		if {$shotinfo($shotid-x) <= 0 || $shotinfo($shotid-x) >= $width} {
			remove_shot $shotid
			return 0
		}

		if {$y2 >= [expr $height - $theterrain($shotinfo($shotid-x))]} {
			# we hit the ground
			hit_terrain $shotinfo($shotid-x)
			remove_shot $shotid
			return 0
		}

		foreach player {player1 player2} {
			if {[check_player_hit $player $shotid]} {
				remove_shot $shotid
				return 0
			}
		}
	}

	return 1
}

proc broadcast_tic {playername} {
	global protocol
	# We use the shadowed variable here to make sure that the peer gets
	# exactly the keys that we handled in player_ticker
	upvar #0 $playername-shadow pshadow
	lappend cmd $protocol(tic)
	foreach param {globalid tic up right down left loading fire} {
		lappend cmd $pshadow($param)
	}
	set pshadow(havebroadcasted) 1
	foreach p {player1 player2} {
		upvar #0 $p pl
		if {!$pl(localplayer)} {
			puts $pl(sockfd) $cmd
		}
	}
}


proc straight_shot_possible {} {
	# returns whether a straight shot at player1 is possible
	global player1 player2 theterrain height shotimpactterrain

	if {$player1(x) >= $player2(cannonendx)} { return 0 }
	set currentx $player2(cannonendx)
	set nearplayer [expr $currentx - $shotimpactterrain]
	set endx $player1(x)
	# We construct a line between player1 and player2 in the form
	# y = ax + d
	set a [expr ($player1(y).0 - $player2(cannonendy)) / ($player1(x) - $player2(cannonendx))]
	set d [expr $player1(y) - $a*$player1(x)]
	set step -12

	# In steps of |$step| pixel, check if there is any mountain between
	# here and player1 that would block a straight shot.
	while {1} {
		if {$currentx <= $endx} { break }
		set liney [expr $height - ($a * $currentx + $d)]
		if {$theterrain($currentx) > $liney} {
			return 0
		}
		if {$currentx > $nearplayer} {
			# higher resolution in our direct neighbourhood
			# to avoid firing directly into the ground before us
			incr currentx -1
		} else {
			incr currentx $step
		}
	}
	return 1
}

proc far_enough {target} {
	global aiplayer
	if {[expr abs($aiplayer(target) - $target)] < 25} {
		return 0
	}
	return 1
}

proc random_between {min max} {
	# random integer in the interval [min($min, $max), max($min, $max)]
	return [expr int($min + ($max-$min)*rand())]
}

proc ai_player_tic {} {
	global aiplayer player1 player2 width pwidth height pheight
	# puts "position: $player2(x) - target: $aiplayer(target)"
	if {$player1(x) > $player2(x)} {
		if {$aiplayer(movingleft)} {
			# force AI player to move right
			set aiplayer(target) $width
		}
	}

	if {$aiplayer(movingleft)} {
		if {$player2(x) < $aiplayer(target) || $player1(x) >= $player2(x)} {
			set aiplayer(movingleft) 0
			if {$player1(x) > $player2(x)} {
				set target $width
			} else {
				set i 0
				for {} {$i <= 5} {incr i} {
					set interval [expr $width - $player1(x)]
					set min [expr $player1(x) + ($interval / 2)]
					set target [random_between $min $width]
					if {$target < $player2(x) || ![far_enough $target]} {
						continue
					}
					set aiplayer(target) $target
					break
				}
				if {$i >= 6} {
					# found no new target in 6 attempts
					set aiplayer(target) $width
				}
			}
		}
		set player2(left)  1
		set player2(right) 0
	} else {
		if {$player2(x) >= [expr $width - $pwidth / 2] || $player2(x) >= $aiplayer(target)} {
			set i 0
			for {} {$i <= 5} {incr i} {
				set interval [expr $width - $player1(x)]
				set max [expr $interval*0.9]
				set target [random_between $player1(x) $max]
				if {$target > $player2(x) || ![far_enough $target]} {
					continue
				}
				set aiplayer(target) $target
				break
			}
			if {$i >= 6} {
				set aiplayer(target) $player1(x)
			}

			# only move left if first player is far enough away
			if {$player1(x) < [expr $width - $pwidth]} {
				set aiplayer(movingleft) 1
			}
		}
		set player2(left)  0
		set player2(right) 1
	}

	# compute the slope of the terrain in this place
	global cannonlength pi theterrain
	set hdifference 0
	set refx [expr $player2(x) - $cannonlength]
	if {$refx >= 0} {
		set hdifference [expr $theterrain($refx) - $theterrain($player2(x))]
	}
	set tan [expr ($hdifference.0 / $cannonlength.0)]
	set maxangle [expr 180 - (atan($tan)*180)/$pi]

	if {!$aiplayer(aiming)} {
		# make sure that we don't hit the terrain before us when firing
		if {$player2(cannonangle) > $maxangle} {
			set player2(down) 1
			set player2(up)   0
		} else {
			set player2(down) 0
			set player2(up)   0
		}
	}

	set player2(loading) 1

	# which angle would a straight shot require? (aim at the topmost
	# pixel of player1)
	set deltax [expr $player2(cannonendx) - $player1(x)]
	set deltay [expr $player2(cannonendy) - ($player1(y) - ($pheight / 2))]
	set angle 0
	if {$deltax == 0} {
		set angle 180
	} else {
		set tan [expr $deltay.0 / $deltax.0]
		set angle [expr 180 - (atan($tan)*180)/$pi]
	}

	if {$angle <= $maxangle && $deltax < 300} {
		if {[straight_shot_possible]} {
			set aiplayer(aiming) 1
		} else {
			set aiplayer(aiming) 0
		}
	} else {
		set aiplayer(aiming) 0
	}

	if {!$aiplayer(aiming) && 0} {
		# always head the cannon towards player1 if possible
		# (disabled feature - makes the opponent too strong)
		if {$angle <= $maxangle} {
			if {$player2(cannonangle) > $angle} {
				set player2(down) 1
				set player2(up)   0
			} else {
				set player2(up)   1
				set player2(down) 0
			}
		}
	}


	if {$aiplayer(aiming) && $player2(shotspeed) >= 20} {
		# puts "Angle needed: $angle - current: $player2(cannonangle)"
		# stay here while aiming
		set player2(left)  0
		set player2(right) 0
		global cannonrotationspeed
		set min [expr $angle - round($cannonrotationspeed/2.0)]
		set max [expr $angle + round($cannonrotationspeed/2.0)]
		if {$player2(cannonangle) >= $min && $player2(cannonangle) <= $max} {
			if {$player2(cannonangle) <= $angle && [expr rand()] >= 0.5 } {
				# keep it a bit higher every once in a while
				# to anticipate gravity
			} else {
				# OK, OK - this is cheating
				set player2(cannonangle) [expr round($angle)]
			}
			draw_cannon player2
			set player2(fire) 1
			set player2(down) 0
			set player2(up)   0
		} elseif {$player2(cannonangle) > $angle} {
			set player2(down) 1
			set player2(up)   0
		} else {
			set player2(up)   1
			set player2(down) 0
		}
	}
}

proc game_ticker {} {
	global netgame ticinterval gametic player1 player2 maxticdiff aigame

	if {$netgame} {
		# stay in sync
		set leasttic -1
		foreach p {player1 player2} {
			upvar #0 $p pl
			if {$leasttic == -1 || (!$pl(localplayer) && $pl(tic) < $leasttic)} {
				set leasttic $pl(tic)
			}
		}
		if {$gametic - $maxticdiff > $leasttic} {
			after $ticinterval game_ticker
			return
		}
	}

	if {$aigame} { ai_player_tic }
	incr gametic

	foreach p {player1 player2} {
		upvar #0 $p player
		if {$player(localplayer)} {
			player_ticker $p
			if {$netgame} { broadcast_tic $p }
		}
	}

	shots_ticker
	after $ticinterval game_ticker
}

set shotscolorchange 0
proc shots_ticker {} {
	global shotscolorchange shotids

	if {[llength shotids] == 0} { return }

	foreach shotid $shotids {
		shot_one_tic $shotid
	}

	set shotscolor "red"
	incr shotscolorchange
	if {$shotscolorchange >= 2} {
		set shotscolor "yellow"
		set shotscolorchange 0
	}
	.playfield itemconfigure theshots -fill $shotscolor
}

proc player_ticker {playername} {
	upvar #0 $playername player
	upvar #0 $playername-shadow pshadow
	global theterrain playerspeed cannonrotationspeed maxshotspeed
	global cannonloadingspeed

	# We shadow the player here, to avoid any interference from the
	# bindings until we broadcast (the user could otherwise then have
	# released a key that was pressed when we were here).
	# We run no tic until the broadcast is performed successfully.

	global netgame
	if {$netgame && [info exists pshadow(havebroadcasted)]} {
		if {$player(localplayer) && !$pshadow(havebroadcasted)} {
			return
		}
	}

	array set pshadow [array get player]
	if {$pshadow(localplayer)} { set pshadow(havebroadcasted) 0 }

	if {$pshadow(up) && $pshadow(down)} {
		# cannot decide what to do
	} elseif {$pshadow(up)} {
		# "up" means counterclockwise
		set player(cannonangle) [expr ($player(cannonangle) + $cannonrotationspeed) % 360]
		draw_cannon $playername
	} elseif {$pshadow(down)} {
		# "down" means clockwise
		set player(cannonangle) [expr ($player(cannonangle) - $cannonrotationspeed + 360) % 360]
		draw_cannon $playername
	}

	if {$pshadow(right) && $pshadow(left)} {
		# cannot decide what to do
	} elseif {$pshadow(right)} {
		set player(x) [expr $player(x) + $playerspeed]
		draw_player $playername
	} elseif {$pshadow(left)} {
		set player(x) [expr $player(x) - $playerspeed]
		draw_player $playername
	}

	if {$pshadow(fire)} {
		set pshadow(loading) 0
		set newshot [player_fire $playername]
		if {!$player(localplayer)} {
			# try our best to synchronize shots
			global gametic
			set newtics [expr $gametic - $player(tic)]
			while {$newtics > 0} {
				if {![shot_one_tic $newshot]} { break }
				incr newtics -1
			}
		}
	}

	if {$pshadow(loading)} {
		if {$player(shotspeed) < $maxshotspeed} {
			incr player(shotspeed) $cannonloadingspeed
			show_cannon_status $playername
		}
	}
	incr player(tic)
}

proc create_cannon_status {win side playername} {
	global maxshotspeed
	canvas $win.$playername-cstatus -borderwidth 0 -background white \
		-highlightthickness 0 -width [expr $maxshotspeed * 2 + 1] -height 20

	set linexformula {expr $i * 2}
	if {$side == "right"} {
		# let the bar advance to the left
		set linexformula {expr $maxshotspeed * 2 - $i*2}
	}

	for {set i 0} {$i <= $maxshotspeed} {incr i} {
		set xcoor [eval $linexformula]
		$win.$playername-cstatus create line $xcoor 0 $xcoor 20 -fill black -tags $playername-cstatus-$i

	}
	pack $win.$playername-cstatus -side $side -padx 4 -pady 4 -expand yes
}

proc show_cannon_status {playername} {
	upvar #0 $playername player
	global maxshotspeed showcannonstatus cannonloadingspeed
	if {$showcannonstatus == 0} { return }
	set side "leftside"
	if {$playername == "player2"} {
		set side "rightside"
	}
	if {$player(shotspeed) == 0} {
		# The player has fired - reset everything
		for {set i 0} {$i <= $maxshotspeed} {incr i} {
			.statusbar.$side.$playername-cstatus itemconfigure \
				$playername-cstatus-$i -fill black
		}
	} else {
		# We only have to color the lines that have changed
		set from [expr $player(shotspeed) - $cannonloadingspeed]
		set to [expr $player(shotspeed)]

		for {set i $from} {$i <= $to} {incr i} {
			.statusbar.$side.$playername-cstatus itemconfigure \
				$playername-cstatus-$i -fill red
		}
	}
}

proc create_lifebar {win side playername} {
	global plife
	canvas $win.$playername-lifebar -borderwidth 0 -background white \
		-highlightthickness 0 -width $plife -height 20
	pack $win.$playername-lifebar -side $side -padx 4 -pady 4 -expand yes
	$win.$playername-lifebar create rectangle 0 0 $plife 20 \
		-fill "#0000aaaaffff" -tags $playername-lifebar
	$win.$playername-lifebar create text [expr 0.5*$plife] 10 \
		-anchor c -text "$plife%" -tags $playername-lb-value
}

proc adjust_lifebar {playername} {
	upvar #0 $playername player
	set value $player(life)
	set msg [format "%3.0f%%" $value]
	set side "leftside"
	if {$playername == "player2"} {
		set side "rightside"
	}
	.statusbar.$side.$playername-lifebar itemconfigure \
		$playername-lb-value -text $msg
	.statusbar.$side.$playername-lifebar coords $playername-lifebar \
		0 0 $value 20
}

proc center_window {win} {
	set x [expr {[winfo rootx .] + [winfo reqwidth .]/2 \
		- [winfo reqwidth $win]/2}]
	set y [expr {[winfo rooty .] + [winfo reqheight .]/2 \
		- [winfo reqheight $win]/2}]
	wm geometry $win "+$x+$y"
}

proc set_geometry {win} {
	wm withdraw $win
	update idletasks
	center_window $win
	wm deiconify $win
	wm minsize $win [winfo reqwidth $win] [winfo reqheight $win]
}

proc transient_window {win title} {
	if {[winfo exists $win]} {
		center_window $win
		return ""
	}
	toplevel $win
	wm title $win $title
	wm transient $win .
	frame $win.info
	pack $win.info -fill both -padx 2 -pady 2
	frame $win.sep -height 2 -borderwidth 1 -relief sunken
	pack $win.sep -fill x -pady 4
	frame $win.controls
	pack $win.controls -padx 4 -pady 4 -expand yes
	return $win
}

proc dialog_info {win} {
	return "$win.info"
}

proc dialog_controls {win} {
	return "$win.controls"
}

proc start_new_game {{localinit 1}} {
	global width height fgcolor shotids shotinfo newwidth newheight

	.playfield delete all
	establish_bindings

	if {$width != $newwidth || $height != $newheight} {
		set width $newwidth
		set height $newheight

		.playfield configure -width $width -height $height
		adjust_main_window
	}

	global theterrain maxdistortion growing
	set maxdistortion [expr $height / 2]
	set theterrain(0) [expr ([random] % ($height / 3))]
	set theterrain($width) [expr ([random] % ($height / 3))]

	set growing 1
	make_terrain 0 $width
	set growing -1
	# We create each line upwards (that's what the terrain is made of) here
	# and only adjust their height when parts of the terrain are destroyed
	for {set i 0} {$i <= $width} {incr i} {
		.playfield create line $i $height $i [expr $height - $theterrain($i)] -fill $fgcolor -tags heightline-$i
	}

	global player1 player2 aiplayer plife
	array set player1 [list up 0 down 0 right 0 left 0 cannonangle 0 \
			life $plife loading 0 shotspeed 0 fire 0 tic 0]

	array set player2 [array get player1]
	set player2(cannonangle) 180

	set player1(x) 0
	set player2(x) $width
	show_cannon_status player1
	show_cannon_status player2

	array set aiplayer {movingleft 1 aiming 0}
	set min [expr 0.5 * $width]
	set max [expr 0.8 * $width]
	set aiplayer(target) [random_between $min $max]

	global hosting netgame sockfd
	set player1(globalid) 1
	set player2(globalid) 2

	set player1(localplayer) 1
	set player2(localplayer) 1

	if {$netgame} {
		if {$hosting} {
			set player2(sockfd) $sockfd
			set player2(localplayer) 0
		} else {
			set player1(sockfd) $sockfd
			set player1(localplayer) 0
		}
		global protocol
		if {$localinit} {
			puts $sockfd $protocol(startnewgame)
		}
	}

	create_player player1 red
	create_player player2 yellow

	set shotids {}

	adjust_lifebar player1
	adjust_lifebar player2

	# also redraws the players
	redraw_playfield 0 0

	global gametic playing
	set gametic 0
	set playing 1
}

proc valid_packet {packet length type} {
	if {[llength $packet] < $length} {
		return 0;
	}

	if {[lindex $packet 0] != $type} {
		return 0;
	}

	return 1;
}

proc net_handle_receive {win} {
	global protocol sockfd
	if {[gets $sockfd line] < 0} {
		# could also happen if no complete line was found in buffer!
		close $sockfd
		set sockfd -1
		$win insert end "Peer closed connection."
		global netgame
		set netgame 0
		start_new_game
		return
	}
	set params [split $line]
	set code [lindex $params 0]
	# puts "Received: $line"
	if {$code == $protocol(tic)} {
		set pid [lindex $params 1]
		upvar #0 player$pid player
		set i 2
		foreach param {tic up right down left loading fire} {
			set player($param) [lindex $params $i]
			incr i
		}
		player_ticker player$pid
	} elseif {$code == $protocol(loginok)} {
		$win insert end "Login OK."
	} elseif {$code == $protocol(loginrejected)} {
		$win insert end "Login rejected."
	} elseif {$code == $protocol(startnewgame)} {
		start_new_game 0
	} elseif {$code == $protocol(setparams)} {
		set numparams [lindex $params 1]
		for {set i 2} {$i <= $numparams*2} {incr i 2} {
			set theparam [lindex $params $i]
			set thevalue [lindex $params [expr $i + 1]]
			# puts "Setting $theparam = $thevalue"
			upvar #0 $theparam p
			set p $thevalue
		}
	}
}

proc netgame_init_host {win newsock ip port} {
	# lisbox $win.f1.status and button $win.start are assumed to exist
	global protocol protocol_version player1 player1
	set stats $win.f1.status
	fconfigure $newsock -buffering line
	$stats insert end "Connection from $ip."

	set valid 1
	global netgame
	if {$netgame} {
		$stats insert end "Rejecting additional player."
		set valid 0
	} else {
		$stats insert end "Determining protocol version..."
	}

	if {[gets $newsock line] < 0} {
		$stats insert end "Peer closed connection."
		set valid 0
	}


	if {$valid} {
		set answ [split $line]
		if {![valid_packet $answ 2 $protocol(sendversion)]} {
			$stats insert end "Unknown or invalid reply."
			set valid 0
		}
	}

	if {$valid} {
		set clprot [lindex $answ 1]
		if {$clprot < $protocol_version} {
			$stats insert end "Client uses outdated protocol."
			set valid 0
		} elseif {$clprot > $protocol_version} {
			$stats insert end "Server uses outdated protocol."
			set valid 0
		}
	}

	if {!$valid} {
		set cmd {
			puts $newsock $protocol(loginrejected)
			close $newsock
		}
		catch $cmd
		return
	}

	$stats insert end "Protocol version OK."
	puts $newsock $protocol(loginok)

	lappend parcmd $protocol(setparams)
	set plist {randomseed ticinterval newwidth newheight \
		shotimpactterrain shotimpactplayer cannonloadingspeed \
		playerspeed showcannonstatus}

	lappend parcmd [llength $plist]

	foreach param $plist {
		upvar #0 $param p
		lappend parcmd $param $p
		# puts "Sending: $param = $p"
	}
	puts $newsock $parcmd

	global sockfd
	set sockfd $newsock
	fileevent $sockfd readable "net_handle_receive $stats"
	global netgame hosting aigame
	set aigame  0
	set netgame 1
	set hosting 1
	start_new_game
	# $win.start configure -state normal
}


proc netgame_init_client {win} {
	# entry $win.f1.ipentry and lisbox $win.f2.status are available
	global netport protocol protocol_version serverip
	set stats $win.f2.status
	set serverip [$win.f1.ipentry get]
	if {[regexp "^127.0.0.1$" $serverip] || $serverip == "localhost"} {
		$stats insert end "Cannot connect to myself."
		return
	}
	global sockfd
	set cmd {
		set sockfd [socket -async $serverip $netport]
	}
	if {[catch $cmd]} {
		$stats insert end "Host is unreachable."
		set sockfd -1
		set netgame 0
		return
	}
	fileevent $sockfd readable "net_handle_receive $stats"
	fconfigure $sockfd -buffering line
	if {[catch { puts $sockfd "$protocol(sendversion) $protocol_version" }]} {
		$stats insert end "Error connecting."
		close $sockfd
		set sockfd -1
		set netgame 0
		return
	}
	global netgame aigame hosting
	set netgame 1
	set aigame  0
	set hosting 0
}

proc netgame_host {} {
	if {[winfo exists .hostgame]} {
		raise .hostgame
		return
	}
	set win [toplevel .hostgame]
	wm title $win "Hosting game"

	global netport
	wm protocol $win WM_DELETE_WINDOW { disconnect; destroy .hostgame }

	set f [frame $win.f1]
	listbox $f.status -width 45 -yscrollcommand "$f.sbar set"
	$f.status insert end "Waiting for connections on port $netport..."
	pack $f.status -fill both -side left -expand yes

	scrollbar $f.sbar -command "$f.status yview"
	pack $f.sbar -fill y -side right

	pack $f -fill both -padx 4 -pady 4 -expand yes

	button $win.stop -text "Stop" -command { disconnect; destroy .hostgame }
	pack $win.stop -padx 4 -pady 4

	set_geometry $win

	global listenfd
	set cmd {
		set listenfd [socket -server "netgame_init_host $win" $netport]
	}

	if {[catch $cmd]} {
		$f.status insert end "An error occurred while opening the socket."
		set listenfd -1
	}
}

proc netgame_join {} {
	if {[winfo exists .joingame]} {
		raise .joingame
		return
	}
	set win [toplevel .joingame]
	wm title $win "Joining game"
	wm protocol $win WM_DELETE_WINDOW { disconnect;	destroy .joingame }
	set f [frame $win.f1]
	label $f.iplabel -text "IP or domain name:"
	pack $f.iplabel -side left -anchor w -padx 4 -pady 4

	global serverip
	entry $f.ipentry -width 30
	$f.ipentry insert end $serverip
	pack $f.ipentry -side right -anchor e -padx 4 -pady 4 -fill x
	pack $f

	set f [frame $win.f2]
	listbox $f.status -width 45 -yscrollcommand "$f.sbar set"
	pack $f.status -fill both -side left -expand yes

	scrollbar $f.sbar -command "$f.status yview"
	pack $f.sbar -fill y -side right

	pack $f -fill both -padx 4 -pady 4 -expand yes

	button $win.join -text "Connect" -command "netgame_init_client $win"
	pack $win.join -pady 4 -padx 4
	set_geometry $win
}

proc disconnect {{usercall 0}} {
	global netgame hosting
	if {!$netgame && $usercall} {
		tk_messageBox -title "Disconnect" -icon info -message "You are currently not connected to any peer."
	} else {
		global sockfd listenfd
		if {$sockfd != -1} { close $sockfd; set sockfd -1}
		if {$listenfd != -1} {
			close $listenfd
			set hosting 0
			set listenfd -1
		}
		set netgame 0
		start_new_game
	}
}

proc helpscreen {} {
	set top [transient_window .helpwin "Help for Tickletankle"]
	if {$top == ""} { return }
	set info [dialog_info $top]
	text $info.help -width 60 -height 12
	$info.help insert end {Player 1:
	Arrow left/right: Move left/right
	Arrow up:         Rotate cannon counterclockwise
	Arrow down:       Rotate cannon clockwise
	Shift:            Load cannon

Player 2:
	x/c:              Move left/right
	a:                Rotate cannon counterclockwise
	q:                Rotate cannon clockwise
	Control:          Load cannon}
	$info.help configure -state disabled
	pack $info.help -expand yes
	button $top.ok -text "OK" -command { destroy .helpwin }
	pack $top.ok -pady 4
	set_geometry $top
	focus $top.ok
}

proc numeric_entry {win value} {
	entry $win -width 3
	$win insert end $value
	bind $win  <KeyPress> {
		if {![regexp "\[0-9\b\]" "%A"] &&
			("%A" != "{}") && ("%K" != "Delete") } { break }
	}
	pack $win -side left -padx 4 -pady 4
	return $win
}

proc settingsscreen {} {
	global playerspeed shotimpactplayer shotimpactterrain
	global ticinterval newwidth newheight cannonloadingspeed netport
	global showcannonstatus cbshowcannonstatus netgame aigame cbaigame

	if {$netgame} {
		tk_messageBox -title "Settings" -icon info -message "You may not change settings while a network game is in progress."
		return
	}

	set top [transient_window .settings "Settings"]
	if {$top == ""} { return }
	set info [dialog_info $top]

	set f [frame $info.f0]
	label $f.label1 -text "Game heartbeat frequency:"
	label $f.label2 -text "Hz" -padx 4 -pady 4
	pack $f.label1 -side left -pady 4 -padx 4 -expand yes -anchor w
	set freq [numeric_entry $f.hbfreq [expr int(1000 / $ticinterval)]]
	pack $f.label2 -side left -pady 4 -expand yes
	pack $f -fill both -expand yes

	set f [frame $info.f1]
	label $f.pslabel -text "Tank speed: "
	label $f.lpspeed -text $playerspeed
	set pspeed [scale $f.psscale -from 0 -to 10 -orient horizontal -showvalue false -command "$f.lpspeed configure -text"]
	$pspeed set $playerspeed

	grid $f.pslabel $f.lpspeed $pspeed -padx 4
	grid configure $f.pslabel -sticky w
	grid configure $f.lpspeed -sticky e

	label $f.cllabel -text "Cannon loading speed: "
	label $f.lclspeed -text $cannonloadingspeed
	set clspeed [scale $f.clscale -from 1 -to 10 -orient horizontal -showvalue false -command "$f.lclspeed configure -text"]
	$clspeed set $cannonloadingspeed

	grid $f.cllabel $f.lclspeed $clspeed -padx 4
	grid configure $f.cllabel -sticky w
	grid configure $f.lclspeed -sticky e
	grid columnconfigure $f 0 -weight 1
	pack $f -fill both -expand yes

	set f [frame $info.f2]
	label $f.label1 -text "Playfield dimensions (active in next new game)"
	pack $f.label1 -anchor w -padx 4 -pady 4
	label $f.wlabel -text "Width:" -pady 4 -padx 4
	pack $f.wlabel -side left -expand yes
	set wentry [numeric_entry $f.wentry $newwidth]
	label $f.hlabel -text "Height: " -pady 4 -padx 4
	pack $f.hlabel -side left -expand yes
	set hentry [numeric_entry $f.hentry $newheight]
	pack $f -fill both -expand yes

	set f [frame $info.f3]
	label $f.label -text "Bullet impact radius:"
	pack $f.label -side left -expand yes -padx 4 -pady 4 -anchor w
	set impterrain [numeric_entry $f.impterrain $shotimpactterrain]
	pack configure $impterrain -expand yes -anchor e
	pack $f -fill both -expand yes

	set f [frame $info.f4]
	label $f.label -text "Bullet damage to player:"
	pack $f.label -side left -expand yes -padx 4 -pady 4 -anchor w
	set impplayer [numeric_entry $f.impplayer $shotimpactplayer]
	pack configure $impplayer -expand yes -anchor e
	pack $f -fill both -expand yes

	set f [frame $info.f5]
	label $f.label -text "Show cannon loading status:"
	pack $f.label -side left -expand yes -padx 4 -pady 4 -anchor w
	checkbutton $f.cbshowcannonstatus
	set cbshowcannonstatus $showcannonstatus
	pack $f.cbshowcannonstatus -expand yes -anchor e
	pack $f -fill both -expand yes

	set f [frame $info.f6]
	label $f.label -text "Network port:"
	pack $f.label -side left -expand yes -padx 4 -pady 4 -anchor w
	set portentry [numeric_entry $f.netport $netport]
	$portentry configure -width 4
	pack configure $portentry -expand yes -anchor e
	pack $f -fill both -expand yes

	set f [frame $info.f7]
	label $f.label -text "Second player is computer (AI player):"
	pack $f.label -side left -expand yes -padx 4 -pady 4 -anchor w
	checkbutton $f.cbaigame
	set cbaigame $aigame
	pack $f.cbaigame -expand yes -anchor e
	pack $f -fill both -expand yes


	global settingsbutton
	set settingsbutton ""
	set controls [dialog_controls $top]
	button $controls.ok -text "  OK  " -command { set settingsbutton 1 }
	button $controls.cancel -text "Cancel" -command { set settingsbutton 0 }
	pack $controls.ok -side left -padx 5 -pady 5
	pack $controls.cancel -side left -padx 5 -pady 5
	set_geometry $top

	tkwait variable settingsbutton

	if {$settingsbutton == 1} {
		set newwidth [$wentry get]
		set newheight [$hentry get]
		set playerspeed [$pspeed get]
		set cannonloadingspeed [$clspeed get]
		set shotimpactterrain [$impterrain get]
		set shotimpactplayer [$impplayer get]
		set ticinterval [expr int(1000 / [$freq get])]
		set showcannonstatus $cbshowcannonstatus
		set netport [$portentry get]
		set aigame $cbaigame
		establish_bindings
	}
	destroy $top
}

proc aboutscreen {} {
	set aboutwin [transient_window .aboutwin "About Tickletankle"]
	if {$aboutwin == ""} { return }
	set info [dialog_info $aboutwin]
	label $info.copyright -text \
	"Tickletankle - a 2 player tank game with fractal terrain.\n\n\
	http://triskam.virtualave.net/tickletankle/tickletankle.html\n\n\
	Tickletankle comes with ABSOLUTELY NO WARRANTY. This is free\n\
	software, and you are welcome to distribute it under certain\n\
	conditions. Read the file COPYING for more information.\n\n\
	Copyright (C) 2002, 2003 Markus Triska triska@gmx.at"
	pack $info.copyright -pady 10 -padx 10 -expand yes
	set controls [dialog_controls $aboutwin]
	button $controls.ok -text "OK" -command { destroy .aboutwin }
	pack $controls.ok -pady 4
	set_geometry $aboutwin
	focus $controls.ok
}

proc quit_yesno {} {
	set response [tk_messageBox -icon question -type yesno -title "Quit" -message "Really quit Tickletankle?"]
	if {$response} { exit }
}

proc adjust_main_window {} {
	set win .
	wm withdraw $win
	update idletasks
	set x [expr {[winfo screenwidth $win]/2 - [winfo reqwidth $win]/2}]
	set y [expr {[winfo screenheight $win]/2 - [winfo reqheight $win]/2}]
	wm geometry $win "+$x+$y"
	# In theory, the next command should resize the window to its natural
	# size. It does not work for me, so I commented it out (who knows...)
	# wm geometry $win ""
	wm deiconify $win
	wm minsize $win [winfo reqwidth $win] [winfo reqheight $win]
}


wm title . "Tickletankle $version"
wm protocol . WM_DELETE_WINDOW { quit_yesno }

frame .themenu
menubutton .themenu.file -text "File" -menu .themenu.file.m
set m [menu .themenu.file.m]
$m add command -label "New game" -command start_new_game
$m add command -label "Settings..." -command settingsscreen
$m add command -label "Host game..." -command netgame_host
$m add command -label "Join game..." -command netgame_join
$m add command -label "Disconnect" -command "disconnect 1"
$m add separator
$m add command -label "Quit" -command { quit_yesno }

menubutton .themenu.help -text "Help" -menu .themenu.help.m
set m [menu .themenu.help.m]
$m add command -label "Help..." -command helpscreen
$m add separator
$m add command -label "About..." -command aboutscreen

pack .themenu.file -side left -padx 5 -pady 5
pack .themenu.help -side right -padx 5 -pady 5
pack .themenu -fill x

canvas .playfield -background $bgcolor -width $width -height $height
pack .playfield -expand yes

frame .statusbar
frame .statusbar.leftside
frame .statusbar.rightside
button .statusbar.newgame -text "New game" -command { start_new_game }
label .statusbar.leftside.gameswon1 -textvariable gameswon(player1)
label .statusbar.rightside.gameswon2 -textvariable gameswon(player2)

pack .statusbar.leftside.gameswon1 -padx 10 -pady 4 -side left
pack .statusbar.rightside.gameswon2 -padx 10 -pady 4 -side right
create_lifebar .statusbar.leftside left player1
create_lifebar .statusbar.rightside right player2
create_cannon_status .statusbar.leftside left player1
create_cannon_status .statusbar.rightside right player2
pack .statusbar.leftside -side left -expand yes -fill x
pack .statusbar.newgame -pady 4 -padx 4 -side left
pack .statusbar.rightside -side right -expand yes -fill x
pack .statusbar -fill both -expand yes

adjust_main_window

start_new_game
focus .playfield
after $ticinterval game_ticker

# Useful for debugging and testing:
# bind .playfield <ButtonPress-1> { hit_terrain %x }
# bind .playfield <KeyRelease> { puts "Released: %A %K" }
# netgame_host
# netgame_join
