#
# Copyright (c) 1995 Sun Microsystems, Inc.
# All rights reserved.
# 
# Permission is hereby granted, without written agreement and without
# license or royalty fees, to use, copy, modify, and distribute this
# software and its documentation for any purpose, provided that the
# above copyright notice and the following two paragraphs appear in
# all copies of this software.
# 
# IN NO EVENT SHALL SUN MICROSYSTEMS, INC. BE LIABLE TO ANY PARTY FOR
# DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES ARISING
# OUT OF THE USE OF THIS SOFTWARE AND ITS DOCUMENTATION, EVEN IF SUN
# MICROSYSTEMS, INC. HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
# 
# SUN MICROSYSTEMS, INC. SPECIFICALLY DISCLAIMS ANY WARRANTIES, INCLUDING,
# BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY, FITNESS
# FOR A PARTICULAR PURPOSE, AND NON-INFRINGEMENT.  THE SOFTWARE PROVIDED
# HEREUNDER IS ON AN "AS IS" BASIS, AND SUN MICROSYSTEMS, INC. HAS NO
# OBLIGATION TO PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR
# MODIFICATIONS.
#

### Configuration variables ###

if {[lindex $argv 0] == "-debug"} {
    proc DEBUG {} {return 1}
} else {
    proc DEBUG {} {return 0}
}

if {![info exists env(DAHOST)]} {
    set serverHost __DAHOST__
} else {
    set serverHost $env(DAHOST)
}
set serverPort 7269

set suspendTimeout 300000

set readylist(0) 0
unset readylist(0)
set playlist(0) 0
unset playlist(0)
set suspendlist(0) 0
unset suspendlist(0)

set skillStrings { \
    {I'm too young to die} \
    {Hey, not too rough} \
    {Hurt me plenty} \
    {Ultra-Violence} \
    {Nightmare!} \
}

set ServerVariables {
    gSkill
    gLevel
    gSublevel
    gTurbo

    altdeath
    deathmatch
    nomonsters
    respawn
}

set SafeCmd {
    AppendMessage
    ContributeWad
    Doom1Wad_Update
    Doom2Wad_Update
    FragInfo
    GetFrags
    JoinServer
    LogGame
    PlayerAwake
    PlayerExit
    PlayerSleeping
    RequestFragInfo
    RerunClients
    ReInit
    SafeArray
    SafeSet
    SetFragInfo
    SetUserID
    StartDoom
    StartDoomSelected
    UpdateWadList
    WRJoin
    WRLeave
    WRPlay
    WRReady
    WRResetLists
    WRSuspend
    Wakeup
}


### Defaults ###

set gWadFile doom1
set gSubdir {}
set gSkill [lindex $skillStrings 3]
set gLevel 1
set gSublevel 1
set gTurbo 100

set altdeath 1
set deathmatch 0
set nomonsters 0
set respawn 0

### Retry write command ###

proc puts_retry {fd message} {
    global errorCode

    set error EAGAIN
    while {$error == "EAGAIN"} {
	if {[catch {puts $fd $message} retval] != 0} {
	    set error [lindex $errorCode 1]
	} else {
	    set error ""
	}
    }
    if {$error != ""} {
	error $retval
    } else {
	return $retval
    }
}

### Safe set command ###

proc SafeSet {key value} {
    global ServerVariables

    if {[lsearch -exact $ServerVariables $key] != -1 ||
        $key == "gWadFileList"} {
	uplevel #0 "set [list $key] [list $value]"
    } else {
	error "SafeSet: Illegal access: $key"
    }
}

proc SafeArray {cmd array value} {
    if {[string match "*@*" $array] == 1 ||
	$array == "readylist" ||
	$array == "suspendlist" ||
	$array == "playlist"} {

	uplevel #0 "array $cmd [list $array] [list $value]"
    } else {
	error "SafeArray: Illegal access: $array"
    }
}

### Init commands ###

proc WRInitCommand {} {
    set cmd {WRResetLists}
    foreach wrlist "readylist playlist suspendlist" {
	upvar #0 $wrlist v1

	set size [array size v1]
	for {set i 0} {$i < $size} {incr i} {
	    upvar #0 $v1($i) v2
	    set cmd "$cmd ; SafeArray set $v1($i) [list [array get v2]]"
	}
	set cmd "$cmd ; SafeArray set $wrlist [list [array get v1]]"
    }
    return $cmd
}

proc WRResetLists {} {
    foreach wrlist "readylist playlist suspendlist" {
	upvar #0 $wrlist v1
	set size [array size v1]
	for {set i 0} {$i < $size} {incr i} {
	    upvar #0 $v1($i) v2
	    catch {unset v2}
	}
	catch {unset v1}
	set v1(0) 0
	unset v1(0)
    }
}

proc InitVarsCommand {} {
    global ServerVariables

    set cmd {}
    foreach var $ServerVariables {
	global $var
	set cmd "$cmd SafeSet $var [list [set $var]] ; "
    }
    return $cmd
}

proc InitMenuCommand {} {
    global wadType gWadFileList gWadFile gSubdir menuLevels menuSublevels

    set cmd "SafeSet gWadFileList [list $gWadFileList]"
    if {$wadType == "doom1"} {
	set cmd "$cmd ; \
    	    Doom1Wad_Update [list $gWadFile] [list $gSubdir] \
    	    [list $menuLevels] [list $menuSublevels]"
    } else {
	set cmd "$cmd ; \
    	    Doom2Wad_Update [list $gWadFile] [list $gSubdir] \
    	    [list $menuLevels]"
    }
    return $cmd
}

proc CreateWadList {dir isdoom isdoom2} {
    set pwd [pwd]
    cd $dir

    if [catch {lsort [glob *.info]} infoFiles] {
	cd $pwd
	return {}
    }
    set menuList {}

    foreach infoFile $infoFiles {
	source $infoFile
	set name [lindex [split $infoFile .] 0]
	set levels {}
	set sublevels {}

	if {$doom == "doom1"} {
	    if {$isdoom} {
		foreach elem $info {
		    set level [string index $elem 1]
		    if {[lsearch -exact $levels $level] == -1} {
		    	lappend levels $level
		    }
		    lappend sublevels [string index $elem 3]
		}
		set levels [lsort -integer $levels]
		set sublevels [lsort -integer $sublevels]

	    	lappend menuList \
		    "[list $name] $doom [list $levels] [list $sublevels]"
	    }
	} else {
	    if {$isdoom2} {
		foreach elem $info {
		    lappend levels \
		    	[string trimleft [string range $elem 3 end] 0]
		}
	    	lappend menuList "[list $name] $doom [list $levels]"
	    }
	}

	unset doom
	unset info
    }
    cd $pwd

    return $menuList
}

proc InitWadList {dir} {
    global env gWadFileList

    set isdoom [file exists $env(DAHOME)/doom.wad]
    set isdoom2 [file exists $env(DAHOME)/doom2.wad]

    set pwd [pwd]
    cd $dir/wads
    set dirs [lsort [glob */]]
    regsub -all / $dirs "" dirs

    set wadList {}
    foreach dir $dirs {
	set list [CreateWadList $dir $isdoom $isdoom2]
	if {$list != ""} {
	    lappend wadList \
	    	[format {%s SUBMENU {%s}} $dir $list]
	}
    }
    set wadList "$wadList [CreateWadList . $isdoom $isdoom2]"

    cd $pwd
    set gWadFileList $wadList
    if [DEBUG] {puts "gWadFileList: $gWadFileList"}
}

proc DoomCommand {playerID current4} {
    global skillStrings gWadFile gSubdir gSkill gLevel gSublevel gTurbo

    set playerHostName [lindex [split $playerID @] 1]

    if {$gSublevel == ""} {
	set doom doom2
	set warp "-warp $gLevel"
    } else {
	set doom doom
	set warp "-warp $gLevel $gSublevel"
    }

    set file {}
    if {$gWadFile != "doom1" && $gWadFile != "doom2"} {
	if {$gSubdir != ""} {
	    set file "-file $gSubdir/$gWadFile.wad"
	} else {
	    set file "-file $gWadFile.wad"
	}
    }

    set bool {}
    foreach opt "altdeath deathmatch nomonsters respawn" {
	global $opt
	if [set $opt] {
	    set bool "$bool -$opt"
	}
    }

    set skill [expr [lsearch -exact $skillStrings $gSkill] + 1]

    set turbo {}
    if {$gTurbo != "100"} {
	set turbo "-turbo $gTurbo"
    }

    if [DEBUG] {puts "PlayerID: $playerID  Current4: $current4"}
    set index [expr [lsearch -exact $current4 $playerID] + 1]

    if {[llength $current4] > 1 || $altdeath || $deathmatch} {
	set net "-net $index"
    } else {
	set net ""
    }
    foreach i $current4 {
	set hostname [lindex [split [lindex [split $i @] 1] #] 0]
	if {$hostname != $playerHostName} {
	    lappend net $hostname
	}
    }

    set cmd "bin/$doom $file $bool -skill $skill $warp $turbo $net"
    if [DEBUG] {puts "DOOMCOMMAND: $cmd"}
    return $cmd
}

proc CheckDoomCommand {cmd} {
    if {[regexp {[;|[`<>]} $cmd]} {return 0}
    if {![info complete $cmd]} {return 0}

    set first [lindex $cmd 0]
    if {$first != "bin/doom" &&
	$first != "bin/doom1" &&
	$first != "bin/doom2"} {

	return 0
    }

    return 1
}

proc ArenaGetCommands {socket} {
    upvar #0 arenaBuffer_$socket v

    if {![info exists v]} {set v ""}

    set data [read $socket]
    if {$data == ""} { error "EOF: $socket" }
    set v "$v$data"
    set commands [split $v "\n"]
    set n_commands [llength $commands]
    if {$n_commands <= 1} { return "" }

    set v [lindex $commands end]
    set commands [lrange $commands 0 [expr $n_commands-2]]
    return $commands
}


### Waiting room commands ###


proc WRUpdate {} {}

proc FindIndex {list value} {
    upvar $list v
    set size [array size v]
    for {set i 0} {$i < $size} {incr i} {
	if {$v($i) == $value} {
	    return $i
	}
    }
    puts "Index not found!"
    return ""
}

set Top4 {}
proc RecalcTop4 {} {
    global readylist Top4

    set NewTop4 {}
    set size [array size readylist]
    if {$size > 4} {set size 4}
    for {set i 0} {$i < $size} {incr i} {
        lappend NewTop4 $readylist($i)
    }
    set Top4 $NewTop4
}

proc WRDelete {id} {
    global readylist playlist suspendlist
    upvar #0 $id v

    if {![info exists v]} {
	if [DEBUG] {puts "WRDelete: Tried to delete non-existant id!"}
	return 0
    }
    set state $v(state)

    if {$state == ""} {
	RecalcTop4
    } elseif {$state == "Ready"} {
	set index [FindIndex readylist $id]
	areplace readylist $index $index
	RecalcTop4
    } elseif {$state == "Playing"} {
	set index [FindIndex playlist $id]
	areplace playlist $index $index
    } elseif {$state == "Suspended"} {
	set index [FindIndex suspendlist $id]
	areplace suspendlist $index $index
    }
    set v(game) {}
    set v(player) {}
    set v(state) {}
    set v(wadfile) {}

    WRUpdate
    return 1
}

proc WRSuspend {id} {
    if {$id == ""} { return }
    CancelSuspendTimeout

    global suspendlist
    upvar #0 $id v

    if {![WRDelete $id]} {
	return
    }
    set insert(0) $id

    set v(state) Suspended

    # Find the corrent alphabetical index to insert after
    set size [array size suspendlist]
    for {set i 0} {$i < $size} {incr i} {
	if {"$suspendlist($i)" > "$id"} {
	    break
	}
    }
    ainsert suspendlist $i insert

    playsound leave
    WRUpdate
}


set gUserID {}
set suspendTimeoutId {}

proc CancelSuspendTimeout {} {
    global suspendTimeoutId
    if {$suspendTimeoutId != ""} {
	after cancel $suspendTimeoutId
	set suspendTimeoutId ""
    }
}

proc StartSuspendTimeout {id} {
    global gUserID suspendTimeoutId suspendTimeout
    if {$id == $gUserID} {
	CancelSuspendTimeout
	set suspendTimeoutId [after $suspendTimeout SetSuspend]
    }
}

proc WRReady {id} {
    global gUserID

    if {$id == ""} { return }
    StartSuspendTimeout $id

    global readylist
    upvar #0 $id v

    if {![WRDelete $id]} {
	return
    }
    set insert(0) $id

    set v(state) Ready
    ainsert readylist [array size readylist] insert
    if {[array size readylist] <= 4} {
	RecalcTop4
    }

    playsound join
    WRUpdate
}

proc WRPlay {id gameNumber playerNumber wadFile} {
    if {$id == ""} { return }
    CancelSuspendTimeout

    global playlist
    upvar #0 $id v

    if {![WRDelete $id]} {
	return
    }
    set insert(0) $id

    set v(game) $gameNumber
    set v(player) $playerNumber
    set v(state) Playing
    set v(wadfile) $wadFile

    # Find the corrent insert index
    set size [array size playlist]
    set index -1
    set lastGame -1
    set lastPlayer -1

    for {set i 0} {$i < $size} {incr i} {
	set thisId $playlist($i)
	upvar #0 $thisId thisV

	if {$thisV(game) != $v(game)} {
	    if {$thisV(game) > $v(game) &&
		$lastGame < $v(game)
	    } {
		set index $i
		break
	    }
	    set lastGame $thisV(game)
	} else {
	    if {$thisV(player) > $v(player) &&
		$lastPlayer < $v(player)
	    } {
		set index $i
		break
	    }
	    set lastPlayer $thisV(player)
	}
    }
    if {$index == -1} {
	set index $size
    }
    ainsert playlist $index insert

    WRUpdate
}

proc WRJoin {id name machine {first 1}} {
    upvar #0 $id v

    playsound join

    set v(fullname) $name
    set v(machine) $machine
    set v(game) {}
    set v(player) {}
    set v(state) {}
    set v(wadfile) {}

    if {$first} {
	WRReady $id
    } else {
	WRSuspend $id
    }
}

proc WRLeave {id} {
    playsound leave

    if {![WRDelete $id]} {
	return
    }
    global $id
    catch {unset $id}
    WRUpdate
}
