#
# 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.
#

#
# DOOM Arena Client
#
# dstein@eng.sun.com
#

load libdoomarena.so
load libtkutil.so

### Load tcl scripts ###

source bin/doomarena_util.tcl
source bin/icon.tcl
source audio/audio.tcl

set wmprop(_OL_DECOR_DEL) _OL_DECOR_ICON_NAME

### Set up the untrusted interpretor

interp create untrusted -safe
foreach cmd $SafeCmd {
    untrusted alias $cmd $cmd
}

### Commands to disable in solo mode

set soloCmd {
    Doom1Wad_Update
    Doom2Wad_Update
    LogGame
    PlayerAwake
    PlayerExit
    PlayerSleeping
    SafeSet
    StartDoomSelected
}

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

#
# The doomarena GUI has the following global variables:
#
# gUserID
# gUserName
# gFullName
# gHostName
#
# gWadFile
# gSubdir
# gWadFileList
# gSkill
# gLevel
# gSublevel
# gTurbo
#
# gBackground
# gDoomBackground
# gColors
# gDoomColors
#
# readylist
# playlist
# suspendlist
#
#
# altdeath
# deathmatch
# nomonsters
# respawn
#
# suspended
# doomcolors
#
#
# Each id is a global array with the following elements:
#
# name
# state
# game
# player
# wadfile
#
#
# Statistics for the current game are controlled with these:
#
# player_names(0)
# player_names(1)
# player_names(2)
# player_names(3)
#
# player0_frags(0)
# player0_frags(1)
# player0_frags(2)
# player0_frags(3)
#
# player1_frags(0)
# player1_frags(1)
# player1_frags(2)
# player1_frags(3)
#
# player2_frags(0)
# player2_frags(1)
# player2_frags(2)
# player2_frags(3)
#
# player3_frags(0)
# player3_frags(1)
# player3_frags(2)
# player3_frags(3)


### Title ###

wm title . "DOOM Arena"
random seed [expr [getclock] + [pid]]

### Snooze bitmap ###

blt_bitmap define snooze {
    {48 16}
    {
   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xe0, 0x7d,
   0x00, 0x00, 0x00, 0x00, 0x8e, 0x20, 0x00, 0x00, 0x00, 0xe0, 0x44, 0x10,
   0x00, 0x00, 0x00, 0x40, 0xee, 0x09, 0x00, 0x00, 0x00, 0xe0, 0x00, 0x7c,
   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x7f, 0x0c, 0x02, 0x00,
   0x60, 0x80, 0x80, 0x12, 0x03, 0x00, 0xe0, 0x7f, 0x00, 0x13, 0x03, 0x00,
   0xe0, 0xff, 0xff, 0x0f, 0x03, 0x00, 0x56, 0x55, 0x55, 0x55, 0x03, 0x00,
   0xaa, 0xaa, 0xaa, 0xaa, 0x02, 0x00, 0x56, 0x55, 0x55, 0x55, 0x03, 0x00,
   0xaa, 0xaa, 0xaa, 0xaa, 0x02, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00
    }
}

### Options ###

# Colors
set gBackground [format #%x%x%x 144 144 205]
set activeBackground #848bc2

set gColors(0) [format #%x%x%x 122 196 122]
set gColors(1) gray
set gColors(2) [format #%x%x%x 206 176 138]
set gColors(3) [format #%x%x%x 209 130 130]

set doomBackgroundIndex [expr 12*16 + 5]
set doomColorIndex(0) [expr 7*16 + 11]
set doomColorIndex(1) [expr 14*16 + 12]
set doomColorIndex(2) [expr 10*16 + 5]
set doomColorIndex(3) [expr 11*16 + 6]

option add *background $gBackground
option add *highlightBackground $gBackground
option add *foreground #000000
option add *activeBackground $activeBackground
option add *activeForeground #000000
option add *troughColor $gBackground

. configure -background $gBackground

# Fonts

set messageHistory 400
set messageMaxLength 4000

set mediumFont -Adobe-Helvetica-Medium-R-Normal--*-120-*
set boldFont -Adobe-Helvetica-Bold-R-Normal--*-120-*
set normalFont $boldFont
set helpFont {-adobe-new century schoolbook-medium-r-normal--14-*-*-*-*-*-*}

set italicFont -Adobe-Helvetica-Bold-O-*--*-120-*
set disableFont -Adobe-Helvetica-Medium-O-*--*-120-*
set bigFont -Adobe-Helvetica-Medium-O-*--*-180-*

option add *Label.font $boldFont
option add *Menubutton.font $boldFont
option add *Checkbutton.font $boldFont
option add *Button.font $boldFont
option add *Menu.font $boldFont
option add *Listbox.font $boldFont
option add *Message.font $boldFont
option add *Scale.font $boldFont
option add *Entry.font $mediumFont
option add *Text.font $mediumFont

### Default volumes ###

set gSounds {{Start Game} Join Leave Option Message Wakeup}
foreach sound $gSounds {
    set w [string tolower [lindex $sound 0]]
    set $w-volume 50
}

### Player information ###

proc hostaddr {name} {
    if {[catch {gethostbyname $name} info] != 0} {
	return unknown
    }
    foreach elem $info {
	set a([lindex $elem 0]) [lindex $elem 1]
    }
    return [lindex $a(addr) 0]
}

proc hostname {addr} {
    if {[catch {gethostbyaddr $addr} info] != 0} {
	return unknown
    }
    foreach elem $info {
	set a([lindex $elem 0]) [lindex $elem 1]
    }
    return [string tolower $a(name)]
}

set gUserName [id user]
set gHostName [sysinfo -hostname]
set gHostAddr [hostaddr $gHostName]
set gUserID $gUserName@$gHostAddr
set gDomain [split [string tolower [sysinfo -domainname]] .]

proc domaintrim {string} {
    global gDomain
    set list [split $string .]

    set dinit [expr [llength $gDomain]-1]
    set sinit [expr [llength $list]-1]

    for {set d $dinit ; set s $sinit} \
    	{$d >= 0 && $s >= 0} \
    	{incr d -1 ; incr s -1} {

	if {[lindex $list $s] != [lindex $gDomain $d]} {
	    break
	}
	set list [lrange $list 0 [expr $s-1]]
    }

    return [join $list "."]
}

### OS release ###
set gRelease [split [sysinfo -release] "."]
set gBadRelease 0
if {[lindex $gRelease 0] != "5" || [lindex $gRelease 1] < 4} {
    set gBadRelease 1
}

if {$gBadRelease} {
    wm withdraw .
    QuestionBox "WARNING:  DOOM only works with Solaris 2.4 or better. \
 You are running Solaris [expr [lindex $gRelease 0]-3].[lindex $gRelease 1]. \
 Doomarena will run, but you will not be able to start a DOOM game." \
    {Rats Darn Crud} Rats warning
    wm deiconify .
}

### Doom Display tracing ###

trace variable gDoomDisplay w UpdateDoomDisplay
trace variable gDoomScreen w UpdateDoomScreen

proc UpdateDoomDisplay {name1 name2 op} {
    global env doomcolors gScreen gDoomDisplay gDoomScreen

    set env(DISPLAY) $gDoomDisplay
    set gDoomScreen [lindex [split $gDoomDisplay "."] 1]

    if {[winfo depth .] != 8} { return }

    if {$gScreen == $gDoomDisplay} {
	set doomcolors 1
    } else {
	set doomcolors 0
    }
}

proc UpdateDoomScreen {name1 name2 op} {
    global gHostName gDoomDisplay gDoomServer gDoomScreen
    set gDoomDisplay $gHostName:$gDoomServer.$gDoomScreen
}

if {[winfo depth .] != 8} {
    set doomcolors 0
} else {
    set doomcolors 1
}

proc SetupDoomDisplay {} {
    global env gScreen gHostName gDoomServer gDoomScreen gDisplayList

    set gScreen [winfo screen .]
    if {[string index $gScreen 0] == ":"} {
	set gScreen $gHostName$gScreen
    }

    if {![info exists env(DOOMDISPLAY)]} {
	set dd $gScreen
    } else {
	set dd $env(DOOMDISPLAY)
    }

    set dssList [split [lindex [split $dd ":"] 1] "."]
    set gDoomServer [lindex $dssList 0]
    set gDoomScreen [lindex $dssList 1]

    set gDisplayList {}
    set screencount [screencount]
    for {set i 0} {$i < $screencount} {incr i} {
    	lappend gDisplayList $gHostName:$gDoomServer.$i
    }
}
SetupDoomDisplay
rename SetupDoomDisplay {}

### Full name from password information ###

proc GetFullName {} {
    global gFullName gUserName

    set gFullName "Joe Bogon"
    if {[catch {getpwnam $gUserName} retval] == 0} {
	aload $retval passwd
	set gFullName $passwd(gecos)
	set subname "[string toupper [string index $gUserName 0]][string range $gUserName 1 end]"
	regsub -all & $gFullName $subname gFullName
    }
}
GetFullName
rename GetFullName {}

### Machine type ###

set prtconf [exec /usr/sbin/prtconf]

set machine "?"
catch {
    set machine [lindex [split $prtconf "\n"] 4]
    set machine [lindex [split $machine ","] 1]

    if {$machine == "UltraSPARC"} {
	set machine "Ultra"
    } elseif {$machine == "S240"} {
	set machine "Voyager"
    } elseif {$machine == "Sun 4_75"} {
	set machine "SS2"
    } elseif {$machine == "Sun 4_65"} {
	set machine "SS1+"
    } elseif {$machine == "Sun 4_60"} {
	set machine "SS1"
    } elseif {$machine == "Sun 4_50"} {
	set machine "IPX"
    } elseif {$machine == "Sun 4_40"} {
	set machine "IPC"
    } elseif {$machine == "Sun 4_25"} {
	set machine "ELC"
    } elseif {$machine == "Sun 4_20"} {
	set machine "SLC"
    } else {
	regsub {SPARC.*-} $machine {SS} machine
    }
}
set gMachine $machine
unset machine

### Sound utilities ###

proc playsound {args} {
    set length [llength $args]
    set type [lindex $args end]
    if {$length > 1} {
	set args [lrange $args 0 [expr $length - 2]]
    } else {
	set args {}
    }

    set audio audio
    set index [lsearch -exact $args "-force"]
    if {$index != -1} {
	set args [lreplace $args $index $index]
	set audio audio_real
    }

    if {[string range $type 0 5] == "audio/"} {
	set soundfile $type
    } elseif {$type == "message"} {
	set soundfile audio/message.au
    } elseif {$type == "wakeup"} {
	set soundfile audio/wakeup.au
    } elseif {$type == "option"} {
	set soundfile audio/drip.au
    } else {
	upvar #0 ${type}Sounds sounds
	upvar #0 ${type}Size size
	set soundfile audio/$type/[lindex $sounds [random $size]]
    }

    global $type-volume
    if {[info exists $type-volume]} {
	set volume [expr [set $type-volume] * 2]
    } else {
	set volume 100
    }

    if {[lindex $args 0] == "-fork"} {
	global doomMute
	if {!$doomMute} {
	    exec /bin/audioplay -i $soundfile >& /dev/null &
	}
    } else {
	eval $audio play -volume $volume $args $soundfile
    }
}

### Icon stuff ###

# There are three possible icon states:  ready, suspend, and playing

wm iconbitmap . normal
wm iconmask . normal_mask

set iconState {}
set iconTurnID {}

set icon_ready "smile left_mad2 right_mad2"
set icon_suspend "normal left right"
set icon_playing "god god god"

set icon_wakeup "mad left_mad right_mad left_mad2 right_mad2"
set icon_wakeup_length [llength $icon_wakeup]

proc UpdateIconState {state} {
    global iconState iconTurnID

    if {$iconState != $state} {
	set iconState $state
	if {$iconTurnID != ""} {
	    after cancel $iconTurnID
	    set iconTurnID ""
	}
	IconTurnHead 0
    }
}

proc IconTurnHead {{turn 1}} {
    global iconState iconTurnID
    upvar #0 icon_$iconState v

    if {$turn} {
	set index [expr [random 2] + 1]
	set name [lindex $v $index]
	set iconTurnID [after [expr [random 1000] + 1000] \
	    "IconTurnHead 0"]
    } else {
	set name [lindex $v 0]
	if {$iconState == "ready"} {
	    set time 4000
	} elseif {$iconState == "playing"} {
	    set time 1000000000
	} {
	    set time 9000
	}
	set iconTurnID [after [expr [random $time] + 1000] IconTurnHead]
    }

    wm iconbitmap . $name
    if [blt_bitmap exists ${name}_mask] {
	wm iconmask . ${name}_mask
    } else {
	wm iconmask . normal_mask
    }
}

proc Wakeup {} {
    global iconTurnID
    if {$iconTurnID != ""} {
	after cancel $iconTurnID
	set iconTurnID ""
    }
    IconWakeupLoop 0
    if {[wm state .] == "normal"} {
	playsound -force wakeup
    } else {
	playsound wakeup
    }
}

proc IconWakeupLoop {count} {
    global icon_wakeup icon_wakeup_length
    set index [random $icon_wakeup_length]
    set name [lindex $icon_wakeup $index]

    wm iconbitmap . $name
    if [blt_bitmap exists ${name}_mask] {
	wm iconmask . ${name}_mask
    } else {
	wm iconmask . normal_mask
    }

    if {$count < 15} {
	incr count
	after 200 "IconWakeupLoop $count"
    } else {
	global iconState iconTurnID
	if {$iconTurnID != ""} {
	    after cancel $iconTurnID
	    set iconTurnID ""
	}
	IconTurnHead 0
    }
}

UpdateIconState suspend


#######################################################################
### Waiting room functions
#######################################################################

proc checkid {id} {
    upvar #0 $id v
    if {![info exists v(idname)]} {
	set l [split $id "@"]
	set v(idname) "[lindex $l 0]@[domaintrim [hostname [lindex $l 1]]]"
    }
}

proc WRRealUpdate {} {
    global solo doomColorsEnabled waitrooms readylist playlist suspendlist

    if {$doomColorsEnabled} {
	upvar #0 gDoomColors colors
    } else {
	upvar #0 gColors colors
    }

    foreach w $waitrooms {
	set top-$w [$w index @0,0]
	$w configure -state normal
	$w delete 1.0 end
    }

    set readySize [array size readylist]

    global iconState game
    if {!$solo && $game(playing)} {
	UpdateIconState playing
    } else {
	if {$readySize > 0} {
	    UpdateIconState ready
	} else {
	    UpdateIconState suspend
	}
    }

    for {set i 0} {$i < $readySize} {incr i} {
	set id $readylist($i)
	upvar #0 $id v

	checkid $id
	.waitroom.game insert end \n
	.waitroom.id insert end $v(idname)\n
	.waitroom.name insert end "   $v(fullname)\n"
	.waitroom.machine insert end "   $v(machine)\n"
	.waitroom.state insert end " Let's play!\n"

	if {$i < 4} {
	    foreach w $waitrooms {
		$w tag add Color$id \
		    [expr $i+1].0 [expr $i+2].0
		$w tag configure Color$id \
		    -background $colors($i)
	    }
	}
    }
    if {$readySize > 0} {
	foreach w $waitrooms {
	    $w insert end \n
	}
	incr readySize
    }

    set playSize [array size playlist]
    for {set i 0} {$i < $playSize} {incr i} {
	set id $playlist($i)
	upvar #0 $id v

	checkid $id
	.waitroom.game insert end " $v(game)\n"
	.waitroom.id insert end $v(idname)\n
	.waitroom.name insert end "   $v(fullname)\n"
	.waitroom.machine insert end "   $v(machine)\n"
	.waitroom.state insert end " $v(wadfile)\n"

	foreach w $waitrooms {
	    $w tag add Color$id \
	    	[expr $i+$readySize+1].0 [expr $i+$readySize+2].0
	    $w tag configure Color$id \
	    	-background $colors($v(player))
	}
    }
    if {$playSize > 0} {
	foreach w $waitrooms {
	    $w insert end \n
	}
	incr playSize
    }

    set size [array size suspendlist]
    for {set i 0} {$i < $size} {incr i} {
	set id $suspendlist($i)
	upvar #0 $id v

	checkid $id
	.waitroom.game insert end \n
	.waitroom.id insert end $v(idname)\n
	.waitroom.name insert end "   $v(fullname)\n"
	.waitroom.machine insert end "   $v(machine)\n"
	.waitroom.state insert end " $v(state)\n"
    }

    foreach w $waitrooms {
	$w configure -state disabled
	$w yview scroll [expr [lindex [split [set top-$w] "."] 0] - 1] units
    }

    global UpdatePending
    set UpdatePending 0
}

proc ignore {args} {}

set UpdatePending 0
proc WRUpdate {} {
    global UpdatePending

    if {!$UpdatePending} {
	after 1 WRRealUpdate
	set UpdatePending 1
    }
}


#######################################################################
### Code for arbitrary layout option menus
#######################################################################

# Copy binding for disabled text widgets

bind all <F16> {
    if {[selection own -displayof %W] != ""} {
	clipboard clear -displayof %W
	clipboard append -displayof %W [selection get -displayof %W]
    }
}


# Menu posting for rectangular layout menus

catch {tkMbPost} message
rename tkMbPost tkMbPost.orig

proc tkMbPost {w {x {}} {y {}}} {
    set menu [$w cget -menu]
    set textvariable [$w cget -textvariable]

    if {([$w cget -indicatoron] == 1) && \
	($textvariable != "") && \
	([$menu index last] == "0" && [$menu entrycget 0 -label] == "")} {

	global $textvariable
	set text [set $textvariable]
	if {$y == ""} {
	    set x [expr [winfo rootx $w] + [winfo width $w]/2]
	    set y [expr [winfo rooty $w] + [winfo height $w]/2]
	}

        foreach child [winfo children $menu] {
	    if {[catch {$child cget -text} ctext] == 0} {
		if {$ctext == $text} {
		    incr x -[expr [winfo x $child] + [winfo width $child]/2]
		    incr y -[expr [winfo y $child] + [winfo height $child]/2]
		    break
		}
	    }
	}
    }

    tkMbPost.orig $w $x $y
}

proc MenuLabelAdd {name menu var gridargs {command {}}} {
    global activeBackground gBackground

    if {![winfo exists $menu.frame]} {
	frame $menu.frame -bd 2 -relief raised
	grid $menu.frame
    }

    set wname [string tolower $name]
    set w $menu.$wname
    label $w -text $name
    $w configure -relief flat
    bind $w <Enter> "%W configure -bg $activeBackground -relief raised"
    bind $w <Leave> "%W configure -bg $gBackground -relief flat"
    bind $w <ButtonRelease> "tkMenuUnpost $menu ; set $var $name ; $command"
    eval grid $w -in $menu.frame -fill both $gridargs
}

proc MenuLabelState {state w} {
    if {$state == "normal"} {
	$w configure -foreground black
	bindtags $w "Label $w . all"
    } elseif {$state == "disable"} {
	$w configure -foreground gray
	bindtags $w {Label . all}
    }
}

#######################################################################
### Widgets
#######################################################################

### File menu ###

frame .menubar -bd 2 -relief raised
grid .menubar -fill x -gw 0

menubutton .file -menu .file.m -text File -takefocus 0
menu .file.m

.file.m add command -label About... -command About
.file.m add command -label Properties... -command Props
.file.m add command -label "Doom Setup..." -command DoomSetup
if {$isdoom || $isdoom2} {
    .file.m add command -label "Contribute Wad..." -command Contrib
}
.file.m add separator
.file.m add command -label "Bugs/Comments..." -command Bug
.file.m add separator
.file.m add command -label Quit -command exit

grid .file -in .menubar -anchor w

### Help menu ###

menubutton .helpmb -menu .helpmb.m -text Help -takefocus 0
menu .helpmb.m
.helpmb.m add command -label "Doom Arena..." \
    -command "Help {Doom Arena Help} doomarena"
.helpmb.m add command -label "Doom Mouse..." \
    -command "Help {DOOM Mouse Help} doommouse"
.helpmb.m add command -label Doom... \
    -command "Help {DOOM Readme} doom"
grid .helpmb -in .menubar -anchor w


### Props ####

set screenSize Normal
set screenSizeList {Tiny Small Normal Huge}
set doomspeaker 1
set doomheadphone 0
set doomlineout 0
set propVars { \
    screenSize gDoomScreen \
    doomaudio doomspeaker \
    doomheadphone doomlineout \
}

set audioVars {gain balance mute speaker headphone lineout}
set audioEnableLevel 0
set audioTraceLevel 0
set audioTraceAfter {}

proc AudioEnable {} {
    global audioEnableLevel
    incr audioEnableLevel
    if {$audioEnableLevel > 1} {return}

    global audioVars
    foreach var $audioVars {
	global $var
	trace variable $var w AudioVar
    }
    catch {audio_real control trace AudioTrace}
}

proc AudioDisable {} {
    global audioEnableLevel
    incr audioEnableLevel -1
    if {$audioEnableLevel > 0} {return}

    catch {audio_real control trace {}}
    global audioVars
    foreach var $audioVars {
	global $var
	trace vdelete $var w AudioVar
    }
}

proc AudioTrace {info} {
    global audioVars audioTraceLevel
    if {$audioTraceLevel} {
	incr audioTraceLevel -1
	return
    }
    eval global $audioVars
    foreach elem $info {
	set key [lindex $elem 0]
	set value [lindex $elem 1]
	trace vdelete $key w AudioVar
	if {$key == "gain"} {
	    if {$value == 255} {
		set value 100
	    } else {
		set value [expr $value * 100 / 256]
	    }
	}
	set $key $value
	trace variable $key w AudioVar
    }
}

proc AudioVar {var var2 access} {
    global $var audioTraceLevel audioTraceAfter
    incr audioTraceLevel

    if {$audioTraceAfter != ""} {
	after cancel $audioTraceAfter
    }
    set audioTraceAfter \
    	[after 1000 {set audioTraceLevel 0; set audioTraceAfter ""}]

    set value [set $var]
    if {$var == "gain"} {
	global mute
	if {$mute} {
	    set mute 0
	}
	if {$value == 100} {
	    set value 255
	} else {
	    set value [expr $value * 256 / 100]
	}
    }
    catch {audio_real control set $var $value}
}

proc DoomAudio {} {
    global speaker headphone lineout
    global speaker_orig headphone_orig lineout_orig
    global doomaudio doomspeaker doomheadphone doomlineout

    if {!$doomaudio} {
	set speaker_orig -1
	return
    }
    AudioEnable
    set speaker_orig $speaker
    set speaker $doomspeaker
    set headphone_orig $headphone
    set headphone $doomheadphone
    set lineout_orig $lineout
    set lineout $doomlineout
}

proc RestoreAudio {} {
    global speaker headphone lineout
    global speaker_orig headphone_orig lineout_orig

    if {$speaker_orig == -1} {return}
    set speaker $speaker_orig
    set headphone $headphone_orig
    set lineout $lineout_orig
    AudioDisable
}

set doomaudio 0
trace variable doomaudio w DoomAudioTrace

proc DoomAudioTrace {var var2 access} {
    global doomaudio

    set c .props.config
    if {[info commands $c] == ""} {return}

    if {$doomaudio} {
	$c.doom.doomspeaker configure -state normal
	$c.doom.doomheadphone configure -state normal
	$c.doom.doomlineout configure -state normal
    } else {
	$c.doom.doomspeaker configure -state disabled
	$c.doom.doomheadphone configure -state disabled
	$c.doom.doomlineout configure -state disabled
    }
}

proc Props {} {
    global propVars gSounds gDisplayList screenSizeList
    eval global $propVars

    if {[winfo exists .props]} {
	blt_win raise .props
	return
    }

    toplevel .props
    wm title .props Properties
    wm transient .props .

    set c .props.config
    frame $c -bd 1 -relief raised

    AudioEnable
    bind .props.config <Destroy> AudioDisable

    frame $c.pad -height 4
    grid $c.pad -gw 0

    label $c.sizeLabel -text "DOOM Screen Size"
    set sizeMenu [eval tk_optionMenu $c.size screenSize $screenSizeList]
    grid $c.sizeLabel -padx 4
    grid $c.size -gw 0 -fill x -padx 4

    label $c.ddLabel -text "DOOM Display"
    set ddMenu [eval tk_optionMenu $c.dd gDoomDisplay $gDisplayList]
    grid $c.ddLabel -padx 4
    grid $c.dd -gw 0 -fill x -padx 4

    frame $c.sep1 -height 2 -bd 1 -relief sunken
    grid $c.sep1 -pady 2 -fill x -gw 0

    checkbutton $c.mute -text "Speaker Mute"
    grid $c.mute -gw 0

    frame $c.sep2 -height 2 -bd 1 -relief sunken
    grid $c.sep2 -fill x -gw 0

    scale $c.gainScale -label "Speaker Volume" \
    	-variable gain -orient horizontal
    grid $c.gainScale -fill x -gw 0

    frame $c.sep3 -height 2 -bd 1 -relief sunken
    grid $c.sep3 -pady 2 -fill x -gw 0

    scale $c.balanceScale -label "Speaker Balance" -showvalue 0 \
    	-variable balance -orient horizontal -from 0 -to 64
    grid $c.balanceScale -fill x -gw 0
    frame $c.blabels
    label $c.blabels.left -text Left -width 6
    frame $c.blabels.center1 -width 2
    frame $c.blabels.center2 -width 2 -height 16 -bd 1 -relief raised
    label $c.blabels.right -text Right -width 6
    grid $c.blabels -fill x -gw 0
    grid $c.blabels.left -wx 1 -anchor w
    grid $c.blabels.center1 $c.blabels.center2 -anchor n
    grid $c.blabels.right -wx 1 -anchor e

    frame $c.sep4 -height 2 -bd 1 -relief sunken
    grid $c.sep4 -pady 2 -fill x -gw 0

    label $c.audioLabel -text "Current Audio Configuration"
    frame $c.audio
    checkbutton $c.audio.speaker -text Speaker
    checkbutton $c.audio.headphone -text Headphone
    checkbutton $c.audio.lineout -text "Line Out"
    grid $c.audioLabel -anchor w -gw 0
    grid $c.audio -gw 0
    grid $c.audio.speaker $c.audio.headphone $c.audio.lineout

    frame $c.sep5 -height 2 -bd 1 -relief sunken
    grid $c.sep5 -pady 2 -fill x -gw 0

    frame $c.doom
    checkbutton $c.doom.doomspeaker -text Speaker
    checkbutton $c.doom.doomheadphone -text Headphone
    checkbutton $c.doom.doomlineout -text "Line Out"
    checkbutton $c.doomaudio -text "DOOM Audio Configuration"
    DoomAudioTrace doomaudio {} w
    grid $c.doomaudio -anchor w -gw 0
    grid $c.doom -gw 0
    grid $c.doom.doomspeaker $c.doom.doomheadphone $c.doom.doomlineout

    set a .props.audio
    frame $a -bd 1 -relief raised
    label $a.volume -text "Sound Volume"
    grid $a.volume -wy 1 -gw 0 -anchor n -pady 4

    foreach sound $gSounds {
	set w [string tolower [lindex $sound 0]]
	button $a.$w-label -text $sound -command "playsound -force $w"
	scale $a.$w-scale -variable $w-volume -orient horizontal
	frame $a.$w-sep -height 2 -bd 1 -relief sunken
	grid $a.$w-sep -fill x -gw 0
	grid $a.$w-label -fill x -padx 4
	grid $a.$w-scale -wx 1 -fill x -gw 0 -padx 4
    }

    frame $c.bottom
    grid $c.bottom -wy 1

    frame $a.bottom
    grid $a.bottom -wy 1

    grid $c -padx 10 -pady 10 -wx 1 -wy 1 -fill both
    grid $a -padx 10 -pady 10 -wx 1 -wy 1 -fill both -gw 0

    button .props.ok -text Dismiss -command "configWrite ; destroy .props"
    grid .props.ok -pady 4 -gw 0
}

### Doom Setup ###

set doomKeys {
    key_left
    key_right
    key_up
    key_down
    key_fire
    key_strafeleft
    key_straferight
    key_strafe
    key_use
    key_speed
}

set doomVars {
    mouse_sensitivity
    sfx_volume
    music_volume
    show_messages
    key_right
    key_left
    key_up
    key_down
    key_strafeleft
    key_straferight
    key_fire
    key_use
    key_strafe
    key_speed
    sndserver
    mb_used
    use_mouse
    mouseb_fire
    mouseb_strafe
    mouseb_forward
    use_joystick
    joyb_fire
    joyb_strafe
    joyb_use
    joyb_speed
    screenblocks
    detaillevel
    snd_channels
    usegamma
    chatmacro0
    chatmacro1
    chatmacro2
    chatmacro3
    chatmacro4
    chatmacro5
    chatmacro6
    chatmacro7
    chatmacro8
    chatmacro9
}

trace variable use_mouse w UseMouse

proc UseMouse {args} {
    global use_mouse

    if {![info exists use_mouse]} {return}
    if {[info commands .doomsetup.mouse] == ""} {return}

    set m .doomsetup.mouse
    if {$use_mouse} {
	$m.mouseb_fire configure -state normal
	$m.mouseb_strafe configure -state normal
	$m.mouseb_forward configure -state normal
    } else {
	$m.mouseb_fire configure -state disabled
	$m.mouseb_strafe configure -state disabled
	$m.mouseb_forward configure -state disabled
    }
}

proc DoomSave {} {
    global env doomKeys doomVars

    if [catch {open $env(HOME)/.doomrc w} doomrc] {
	error "Could not open $env(HOME)/.doomrc"
    }
    foreach var $doomVars {
	global $var
	set value [set $var]
	if {[string match mouseb_* $var]} {
	    if {$value == "Left"} {set value 0}
	    if {$value == "Middle"} {set value 1}
	    if {$value == "Right"} {set value 2}
	}
	if [catch {expr int($value)}] {
	    puts $doomrc "$var		\"$value\""
	} else {
	    puts $doomrc "$var		$value"
	}
    }
    close $doomrc
    destroy .doomsetup
}

set StoK(Shift) 182
set StoK(Meta) 184
set StoK(Control) 157
set StoK(Left) 172
set StoK(Right) 174
set StoK(Up) 173
set StoK(Down) 175

foreach elem [array names StoK] {
    set value $StoK($elem)
    set KtoS($value) $elem
}

proc DoomKeysymToString {keysym} {
    global KtoS
    if [info exists KtoS($keysym)] {
	return $KtoS($keysym)
    } else {
	return [KeysymToString $keysym]
    }
}

proc DoomKey {key name value} {
    global $key StoK
    regsub {_L$|_R$} $name {} name
    if {$value > 256} {
	if {![info exists StoK($name)]} {return}
	set value $StoK($name)
    }
    set $key $value
    .doomsetup.key.$key-value configure -text $name
}

proc DoomRevert {{file {}} {limited 0}} {
    global env doomKeys doomVars

    if {$file == ""} {
	set file $env(HOME)/.doomrc
    }

    if {$limited} {
	foreach var $doomKeys {
	    global $var
	}
	global use_mouse mouseb_fire mouseb_strafe mouseb_forward
    } else {
	foreach var $doomVars {
	    global $var
	}
    }

    if [catch {open $file} doomrc] {
	set doomrc [open $env(DAPARENT)/doomrc.mouse]
    }
    set lines [split [read $doomrc] "\n"]
    close $doomrc
    foreach line $lines {
	if {$line != ""} {
	    eval set $line
	}
    }

    foreach var [info vars mouseb_*] {
	set value [set $var]
	if {$value == 0} {set $var Left}
	if {$value == 1} {set $var Middle}
	if {$value == 2} {set $var Right}
    }

    set k .doomsetup.key
    if {[info commands $k.key_left-value] == ""} {return}
    foreach key $doomKeys {
	set keysym [set $key]
	$k.$key-value configure -text [DoomKeysymToString $keysym]
    }
}

proc DoomSetup {} {
    global env doomKeys doomVars

    if {[winfo exists .doomsetup]} {
	blt_win raise .doomsetup
	return
    }

    toplevel .doomsetup
    wm title .doomsetup "Doom Setup"
    wm transient .doomsetup .

    DoomRevert
    foreach var $doomVars { global $var }

    frame .doomsetup.recommend
    button .doomsetup.recommend.mouse \
    	-text "Recommended Mouse Setup" \
    	-command "DoomRevert $env(DAHOME)/doomrc.mouse 1"
    button .doomsetup.recommend.keyboard \
    	-text "Reasonable Keyboard Setup" \
    	-command "DoomRevert $env(DAHOME)/doomrc.keyboard 1"
    grid .doomsetup.recommend -gw 0
    grid .doomsetup.recommend.mouse
    grid .doomsetup.recommend.keyboard

    set k .doomsetup.key
    set m .doomsetup.mouse
    set c .doomsetup.chat

    frame $k -bd 1 -relief raised
    frame $m -bd 1 -relief raised
    frame $c -bd 1 -relief raised

    grid $k -fill both -ipadx 4 -ipady 4
    grid $m -fill both -ipadx 4 -ipady 4 -gw 0
    grid $c -fill both -ipadx 4 -ipady 4 -gw 0

    # Keys
    label $k.label -text "Keyboard Controls"
    grid $k.label -anchor w -gw 0

    frame $k.gap
    grid $k.gap -gx 2 -padx 5

    set i 0
    foreach key $doomKeys {
	set name [lindex [split $key "_"] 1]
	label $k.$key-name -text $name

	set value [DoomKeysymToString [set $key]]
	label $k.$key-value -text $value -bd 1 -relief sunken -width 15 \
    	    -highlightthickness 2 -takefocus 1

	bind $k.$key-name <Key> "DoomKey $key %K %N"
	bind $k.$key-value <Key> "DoomKey $key %K %N"
	bind $k.$key-name <Button-1> "focus $k.$key-name"
	bind $k.$key-value <Button-1> "focus $k.$key-value"

	if {$i < 5} {
	    set opt1 "-gx 0"
	    set opt2 "-gx 1"
	} else {
	    set opt1 "-gx 3"
	    set opt2 "-gx 4"
	}
	eval grid $k.$key-name -ipadx 4 -ipady 4 -anchor e $opt1
	eval grid $k.$key-value -ipadx 4 -ipady 4 -fill x $opt2

	incr i
    }

    # Mouse
    label $m.label -text "Mouse Controls"
    frame $m.pad1
    frame $m.pad2
    checkbutton $m.use_mouse -text "Use Mouse"

    if {$use_mouse} {
	set state normal
    } else {
	set state disabled
    }

    label $m.fire_label -text Fire
    tk_optionMenu $m.mouseb_fire mouseb_fire Left Middle Right
    $m.mouseb_fire configure -width 6 -state $state

    label $m.strafe_label -text Strafe
    tk_optionMenu $m.mouseb_strafe mouseb_strafe Left Middle Right
    $m.mouseb_strafe configure -width 6 -state $state

    label $m.forward_label -text Forward
    tk_optionMenu $m.mouseb_forward mouseb_forward Left Middle Right
    $m.mouseb_forward configure -width 6 -state $state

    grid $m.label -anchor w -gw 0
    grid $m.pad1 -wy 1 -gw 0
    grid $m.use_mouse -fill x -gw 0
    grid $m.fire_label
    grid $m.mouseb_fire -fill x -gw 0
    grid $m.strafe_label
    grid $m.mouseb_strafe -fill x -gw 0
    grid $m.forward_label
    grid $m.mouseb_forward -fill x -gw 0
    grid $m.pad2 -wy 1 -gw 0

    # Chat macros
    label $c.label -text "Chat Macros"
    grid $c.label -anchor w -gw 0
    for {set i 0} {$i < 10} {incr i} {
	label $c.l$i -text $i
	entry $c.$i -textvariable chatmacro$i
	grid $c.l$i
	grid $c.$i -fill x -wx 1 -gw 0
    }

    # Buttons
    frame .doomsetup.b
    button .doomsetup.b.save -text Save -command DoomSave
    button .doomsetup.b.revert -text Revert -command DoomRevert
    button .doomsetup.b.cancel -text Cancel -command {destroy .doomsetup}
    grid .doomsetup.b -gw 0
    grid .doomsetup.b.save .doomsetup.b.revert .doomsetup.b.cancel \
    	-padx 4 -pady 4
}


### About popup ###

set aboutInited 0

set slopImages {
    {bal2c0.ppm bfe2a0.ppm}
    {bal2d0.ppm bfe2b0.ppm}
    playq0.ppm
    playr0.ppm
    plays0.ppm
    playt0.ppm
    playu0.ppm
    playv0.ppm
    playw0.ppm
}

set teleportImages {
    tfoga0.ppm
    tfogb0.ppm
    tfogc0.ppm
    tfogd0.ppm
}

set slopInited 0
set slopLength [llength $slopImages]
set teleportLength [llength $teleportImages]

proc About {} {
    global aboutInited bigFont

    if {!$aboutInited} {
	set aboutInited 1
	image create photo doug -file ppm/doug.ppm
	image create photo doug-yikes -file ppm/doug-yikes.ppm
	image create photo booga -file ppm/booga.ppm
	image create photo booga-yikes -file ppm/booga-yikes.ppm
    }

    if {![winfo exists .about]} {
	toplevel .about
	wm title .about About
	wm transient .about .

	text .about.text -font $bigFont -width 36 -height 20 -bg white \
	    -tabs "5c center"
	button .about.dismiss -text Dismiss -command "destroy .about"

	set opts "-bd 1 -relief raised -width 65 -height 65 \
    	    -bg cyan -anchor center -cursor pirate"
	eval label .about.text.doug $opts -image doug
	bind .about.text.doug <1> {Slop %W 0 doug}
	eval label .about.text.booga $opts -image booga
	bind .about.text.booga <1> {Slop %W 0 booga}

	global .about.text.doug-state .about.text.booga-state
	set .about.text.doug-state "alive"
	set .about.text.booga-state "alive"

	.about.text insert end \
	    "\n\tDOOMARENA v1.0\n\n\twritten by\n\n"
	.about.text window create end -window .about.text.doug -padx 30
	.about.text insert end \
	    "\tDouglas Stein\n\tand\n"
	.about.text window create end -window .about.text.booga -padx 30
	.about.text insert end \
	    "\tSteve Jankowski"
	.about.text insert end \
	    "\n\n\twith contributions from\n\n"
	.about.text insert end \
	    "\tBart Smaalders\n\tEric van Bezooijen\n"
	.about.text insert end \
	    "\tBharat Mediratta\n\tEric Arnold"

	.about.text configure -state disabled

	grid .about.text -gw 0
	grid .about.dismiss
    } else {
	blt_win raise .about
    }
}

proc Slop {w index {type ""}} {
    global $w-state slopInited slopImages slopLength teleportImages

    if {[info commands $w] == ""} {return}

    if {!$slopInited} {
	set slopInited 1
	foreach file $slopImages {
	    foreach subfile $file {
		image create photo $subfile -file ppm/$subfile
	    }
	}
	set tpi 0
	foreach file $teleportImages {
	    image create photo tport$tpi -file ppm/$file
	    incr tpi
	}
    }

    if {![info exists $w-state]} {
	set $w-state alive
    }

    if {[set $w-state] == "alive"} {
	if {$type == "doug"} {
	    $w configure -image doug-yikes
	    update
	    playsound -force -sync audio/doom/rocket-launch.au
	    playsound -force audio/doom/rocket-slop.au
	} else {
	    $w configure -image booga-yikes
	    update
	    playsound -force -sync audio/doom/bfg-launch.au
	    playsound -force audio/doom/bfg-slop.au
	}
    } elseif {$index == 0 && [set $w-state] == "dead"} {
	return
    }

    set $w-state dead
    set image [lindex $slopImages $index]

    if {[llength $image] == 2} {
	$w configure -anchor center
	if {$type == "doug"} {
	    set image [lindex $image 0]
	} else {
	    set image [lindex $image 1]
	}
    } else {
	$w configure -anchor s
    }

    $w configure -image $image
    incr index
    if {$index < $slopLength} {
	after 100 "Slop $w $index $type"
    } {
	after 2000 "Revive $w 0 $type"
    }
}

proc Revive {w index type} {
    global lastTPort

    if {[info commands $w] == ""} {return}

    if {$index == 0} {
	playsound -force audio/doom/teleport.au
	set image tport0
	set lastTPort 0
    } elseif {$index == 8} {
	set image tport0
    } else {
	set tpi $lastTPort
	while {$tpi == $lastTPort} {set tpi [expr [random 3] + 1]}
	set image tport$tpi
	set lastTPort $tpi
    }
    $w configure -image $image -anchor center
    incr index
    if {$index < 10} {
	after 100 "Revive $w $index $type"
    } else {
	global $w-state
	$w configure -image $type
	set $w-state "alive"
    }
}

### Contribute Wad ###

proc Contrib {} {
    if [winfo exists .submit] {
	blt_win map .submit
	return
    }

    toplevel .submit
    wm minsize .submit 64 64
    wm transient .submit .
    wm title .submit "Contribute Wad File"

    TreeFileBrowser .submit.browser \
    	-activate_label Contribute \
    	-isActive_callback IsWadFile \
    	-activate_callback SubmitWad \
    	-cancel_callback SubmitCancel

    grid .submit.browser -fill both -wx 1 -wy 1
    .submit.browser init -1

    global env submitCWD
    set code 1

    if {[info exists submitCWD]} {
	set code [catch {.submit.browser setpath $submitCWD}]
    }
    if {$code != 0 && [info exists env(HOME)]} {
	.submit.browser setpath $env(HOME)
	set submitCWD $env(HOME)
    }
}

proc IsWadFile {file} {
    set length [string length $file]
    if {[string range $file [expr $length-4] end] == ".wad"} {
	return 1
    } else {
	return 0
    }
}

proc SubmitCancel {} {
    global submitCWD
    set path [.submit.browser path]
    set submitCWD $path
    blt_win unmap .submit
}

proc SubmitWad {file} {
    global env

    set wad [open $file r]
    set info [read $wad 4]
    close $wad

    if {$info != "PWAD"} {
	error "$file is not a valid wad file."
    }

    busy {exec /bin/cp $file $env(DAPARENT)/incoming}
    SendCommand [list ContributeWad [basename $file]]
    SubmitCancel
}

proc ContributeWad {file} {}

### Bugs/Comments ###

proc Bug {} {
    if {![winfo exists .bug]} {
	toplevel .bug
	wm title .bug "Bugs or Comments"
	wm transient .bug .

	label .bug.label -text \
 "Email is sent to doomarena-bugs@bds.eng.sun.com when you press \"Send\""

	frame .bug.subject
	label .bug.subject.label -text Subject:
	entry .bug.subject.entry
	bind .bug.subject.entry <Return> {focus .bug.text}

	text .bug.text -font courier -width 80 -bg white
	frame .bug.bttn
	button .bug.bttn.send -text Send \
    	    -command {SendBug ; destroy .bug}
	button .bug.bttn.cancel -text Cancel -command {destroy .bug}

	grid .bug.label -gw 0
	grid .bug.subject -wx 1 -fill x -gw 0
	grid .bug.subject.label
	grid .bug.subject.entry -wx 1 -fill x
	grid .bug.text -wx 1 -wy 1 -fill both -gw 0
	grid .bug.bttn -gw 0
	grid .bug.bttn.send .bug.bttn.cancel
    } else {
	blt_win raise .bug
    }
}

proc SendBug {} {
    global gFullName gMachine gRelease prtconf

    set subject [.bug.subject.entry get]
    if {[string length $subject] == 0} {
	error "Empty subject line"
    }

    set msg [.bug.text get 1.0 end]
    if {[string length $msg] == 0} {
	error "Empty message"
    }

    set doomout {}
    if {[catch {open /tmp/doom.out r} dout] == 0} {
	set doomout [read $dout]
	close $dout

	set lines [llength [split $doomout "\n"]]
	set doomout "
----------
X-Sun-Data-Type: Text
X-Sun-Data-Description: Text
X-Sun-Data-Name: doom.out
X-Sun-Charset: us-ascii
X-Sun-Content-Lines: $lines

$doomout
"
    }

    set lines [llength [split $prtconf "\n"]]
    set conf "
----------
X-Sun-Data-Type: Text
X-Sun-Data-Description: Text
X-Sun-Data-Name: prtconf
X-Sun-Charset: us-ascii
X-Sun-Content-Lines: $lines

$prtconf
"

    set lines [llength [split $msg "\n"]]

    set mail [open {|/bin/mail doomarena-bugs@bds.eng.sun.com} w]
    puts $mail "To: doomarena-bugs@bds.eng.sun.com
Subject: $subject
Content-Type: X-sun-attachment

----------
X-Sun-Data-Type: text
X-Sun-Data-Description: text
X-Sun-Data-Name: text
X-Sun-Charset: us-ascii
X-Sun-Content-Lines: [expr $lines+4]

Name     $gFullName
Machine  $gMachine
Release  [join $gRelease .]

$msg
$doomout
$conf
"
    close $mail
}

### Help ###

proc Help {title which} {
    global env helpFont

    set help .help-$which

    if {![winfo exists $help]} {
	toplevel $help
	wm title $help $title
	wm transient $help .

	text $help.text -yscroll "$help.sbar set" -wrap word \
	    -font $helpFont -tabs 3.8c -height 40 -bg white
	$help.text tag add Tag 0.0 end
	scrollbar $help.sbar -command "$help.text yview"
	button $help.dismiss -text Dismiss -command "destroy $help"
	grid $help.text -wx 1 -wy 1 -fill both
	grid $help.sbar -fill y -gw 0
	grid $help.dismiss

	if {[catch {open $env(DAHOME)/doc/$which} helpFile] == 0} {
	    set lines [read $helpFile]
	    close $helpFile
	    $help.text insert end $lines
	} else {
	    $help.text insert end {Couldn't find help file.}
	}
	$help.text tag add MarginTag 1.0 end
	$help.text tag configure MarginTag \
	    -lmargin1 10 -lmargin2 10 -rmargin 10
	$help.text configure -state disabled
    } else {
	blt_win raise $help
    }
}


### Menubar label ###

label .menubar.label -textvariable headerMessage \
    -font -Adobe-Helvetica-Medium-R-Normal--*-120-*
grid .menubar.label -gw 0 -anchor e -wx 1


### Control Panel ###

frame .controls
grid .controls -gh 2


# Wad file

set oldSublevel {}
proc Doom1Wad {name newSubdir newLevel newSublevel} {
    SendCommand [list Doom1Wad_Update $name $newSubdir $newLevel $newSublevel]
}
proc Doom2Wad {name newSubdir newLevel} {
    SendCommand [list Doom2Wad_Update $name $newSubdir $newLevel]
}

proc Doom1Wad_Update {name newSubdir newLevel newSublevel} {
    global isdoom normalFont gWadFile gSubdir gLevel gSublevel oldSublevel

    .wad configure -font $normalFont
    .level configure -menu .level.d1
    .sublevel configure -state normal
    .sublevelLabel configure -foreground black
    set gWadFile $name
    set gSubdir $newSubdir

    if {$newLevel != ""} {
	set gLevel [lindex $newLevel 0]
	for {set i 0} {$i <= 2} {incr i} {
	    .level.d1 entryconfigure $i -state disabled
	}
	foreach i $newLevel {
	    .level.d1 entryconfigure [expr $i-1] -state normal
	}
    } elseif {$isdoom} {
	set gLevel 1
	for {set i 0} {$i <= 2} {incr i} {
	    .level.d1 entryconfigure $i -state normal
	}
    } else {
	set gLevel 1
	.level.d1 entryconfigure 0 -state normal
	.level.d1 entryconfigure 1 -state disabled
	.level.d1 entryconfigure 2 -state disabled
    }

    if {$newSublevel != ""} {
	set gSublevel [lindex $newSublevel 0]
	set oldSublevel $gSublevel
	for {set i 1} {$i <= 9} {incr i} {
	    MenuLabelState disable .sublevel.d1.$i
	}
	foreach i $newSublevel {
	    MenuLabelState normal .sublevel.d1.$i
	}
    } else {
	if {$oldSublevel != ""} {
	    set gSublevel $oldSublevel
	} else {
	    set gSublevel 1
	}
	for {set i 1} {$i <= 9} {incr i} {
	    MenuLabelState normal .sublevel.d1.$i
	}
    }

    playsound option
}

proc Doom2Wad_Update {name newSubdir newLevel} {
    global italicFont gWadFile gSubdir gLevel gSublevel oldSublevel

    .wad configure -font $italicFont
    .level configure -menu .level.d2
    .sublevel configure -state disabled
    .sublevelLabel configure -foreground gray
    set gWadFile $name
    set gSubdir $newSubdir

    if {$gSublevel != ""} {
	set oldSublevel $gSublevel
    }
    set gSublevel {}
    if {$newLevel != ""} {
	set gLevel [lindex $newLevel 0]
	for {set i 1} {$i <= 32} {incr i} {
	    MenuLabelState disable .level.d2.$i
	}
	foreach i $newLevel {
	    MenuLabelState normal .level.d2.$i
	}
    } else {
	for {set i 1} {$i <= 32} {incr i} {
	    MenuLabelState normal .level.d2.$i
	}
    }

    playsound option
}

trace variable gWadFileList w UpdateWadFiles

proc UpdateWadFiles {name1 name2 op} {
    global isdoom2
    global $name1 wadMenu italicFont
    set wadfiles [set $name1]

    set size [$wadMenu index last]
    for {set i 0} {$i < $size} {incr i} {
	if {[$wadMenu type $i] == "cascade"} {
	    destroy [$wadMenu entrycget $i -menu]
	}
    }

    $wadMenu delete 0 last
    $wadMenu add command -label doom1 -command "Doom1Wad doom1 {} {} {}"
    $wadMenu add command -label doom2 -command "Doom2Wad doom2 {} {}" \
    	-font $italicFont

    if {!$isdoom2} {
	$wadMenu entryconfigure doom2 -state disabled
    }

    foreach elem $wadfiles {
	set name [lindex $elem 0]
	set type [lindex $elem 1]

	if {$type == "SUBMENU"} {
	    set m $wadMenu.[string tolower $name]
	    menu $m
	    $wadMenu add cascade -label $name -menu $m

	    foreach subelem [lindex $elem 2] {
		set subname [lindex $subelem 0]
		set subtype [lindex $subelem 1]

		if {$subtype == "doom1"} {
		    set level [lindex $subelem 2]
		    set sublevel [lindex $subelem 3]
		    $m add command -label $subname \
    	-command "Doom1Wad $subname $name [list $level] [list $sublevel]"
		} elseif {$subtype == "doom2"} {
		    set level [lindex $subelem 2]
		    $m add command -label $subname -font $italicFont \
		    	-command "Doom2Wad $subname $name [list $level]"
		}
	    }
	} elseif {$type == "doom1"} {
	    set level [lindex $elem 2]
	    set sublevel [lindex $elem 3]
	    $wadMenu add command -label $name \
	    	-command "Doom1Wad $name {} [list $level] [list $sublevel]"
	} elseif {$type == "doom2"} {
	    set level [lindex $elem 2]
	    $wadMenu add command -label $name -font $italicFont \
	    	-command "Doom2Wad $name {} [list $level]"
	}
    }
}

label .wadLabel -text Wad
set wadMenu [tk_optionMenu .wad gWadFile doom1]

grid .wadLabel -in .controls
grid .wad -in .controls -gw 0 -fill x


# Skill level

label .skillLabel -text Skill
set skillMenu [eval tk_optionMenu .skill gSkill $skillStrings]
.skill configure -width [string length [lindex $skillStrings 0]]

grid .skillLabel -in .controls
grid .skill -in .controls -gw 0 -fill x


# Wad level

label .levelLabel -text Level
destroy [tk_optionMenu .level gLevel {}]

menu .level.d1 -tearoff 0
if {$isdoom} {
    set d1state normal
} else {
    set d1state disabled
}
.level.d1 add command -label 1 -command "set gLevel 1"
.level.d1 add command -label 2 -command "set gLevel 2" -state $d1state
.level.d1 add command -label 3 -command "set gLevel 3" -state $d1state
unset d1state

menu .level.d2 -tearoff 0
.level.d2 add command

for {set i 1} {$i <= 32} {incr i} {
    set x [expr ($i-1) % 4]
    set y [expr ($i-1) / 4]
    MenuLabelAdd $i .level.d2 gLevel "-gx $x -gy $y"
}

.level configure -menu .level.d1
grid .levelLabel -in .controls
grid .level -in .controls -gw 0 -fill x


# Wad sublevel

label .sublevelLabel -text Sublevel
destroy [tk_optionMenu .sublevel gSublevel {}]

menu .sublevel.d1 -tearoff 0
.sublevel.d1 add command

for {set i 1} {$i <= 9} {incr i} {
    set x [expr ($i-1) % 3]
    set y [expr ($i-1) / 3]
    MenuLabelAdd $i .sublevel.d1 gSublevel "-gx $x -gy $y"
}

.sublevel configure -menu .sublevel.d1
grid .sublevelLabel -in .controls
grid .sublevel -in .controls -gw 0 -fill x


# Turbo

label .turboLabel -text Turbo
set turboMenu [tk_optionMenu .turbo gTurbo 100 125 150 175 200 225 250]

grid .turboLabel -in .controls
grid .turbo -in .controls -gw 0 -fill x


# Checkbuttons: altdeath deathmatch nomonsters respawn

proc cbut {name parent} {
    checkbutton $parent.$name -text $name -anchor w -variable $name
    grid $parent.$name -fill x -gw 0
}

frame .cbut
frame .cbut.death -bd 2 -relief ridge
frame .cbut.monster -bd 2 -relief ridge

grid .cbut -in .controls -gw 0 -pady 6
grid .cbut.death -padx 2
grid .cbut.monster -gw 0 -padx 2

set altdeath 0
cbut altdeath .cbut.death
cbut deathmatch .cbut.death
cbut nomonsters .cbut.monster
cbut respawn .cbut.monster

trace variable altdeath w DeathTrace
trace variable deathmatch w DeathTrace
trace variable nomonsters w MonsterTrace
trace variable respawn w MonsterTrace

proc DeathTrace {name1 name2 mode} {
    global $name1
    if {![set $name1]} {
	return
    }

    DisableServerTrace
    if {$name1 == "deathmatch"} {
	global altdeath
	if {$altdeath != 0} {
	    set altdeath 0
	}
    } else {
	global deathmatch
	if {$deathmatch != 0} {
	    set deathmatch 0
	}
    }
    EnableServerTrace
}

proc MonsterTrace {name1 name2 mode} {
    global $name1
    if {![set $name1]} {
	return
    }

    DisableServerTrace
    if {$name1 == "nomonsters"} {
	global respawn
	if {$respawn != 0} {
	    set respawn 0
	}
    } else {
	global nomonsters
	if {$nomonsters != 0} {
	    set nomonsters 0
	}
    }
    EnableServerTrace
}

# Start button

frame .buttons
grid .buttons -in .controls -gw 0 -pady 4

button .buttons.start -text "Start DOOM" -state disabled \
    -command StartButton
grid .buttons.start -padx 4

trace variable Top4 w Top4Trace

proc Top4Trace {name1 name2 op} {
    global gUserID Top4 solo

    if {$solo} {return}

    if {[lsearch -exact $Top4 $gUserID] != -1} {
	.buttons.start configure -state normal
	.buttons.wakeup configure -state normal
    } else {
	.buttons.start configure -state disabled
	.buttons.wakeup configure -state disabled
    }
}

proc StartButton {} {
    global solo gUserID gWadFile

    if {$solo} {
	set cmd [DoomCommand solo solo]
	StartDoom 0 $gUserID $gWadFile $cmd
    } else {
	SendCommand [list StartDoomSelected $gUserID]
    }
}

proc StartDoomSelected {args} {}

set doomPipe {}
set doomPid {}
set fragPipe {}

set game(starttime) 0
set game(times) {}
set game(sleepstart) {}
set game(sleeptime) {}
set game(playing) 0
set game(id) {}
set game(players) {}
set game(wad) {}
set game(numPlayers) 0
set game(numActivePlayers) 0

set playerEnv {
    DOOM_GREEN
    DOOM_INDIGO
    DOOM_BROWN
    DOOM_RED
}

proc StartDoom {gameNumber players wad doomCommand} {
    global screenSize screenSizeList suspendTimeoutId
    if {$suspendTimeoutId != ""} {
	after cancel $suspendTimeoutId
    }

    global env game playerEnv player_names
    global doomPipe doomPid fragPipe

    if {[CheckDoomCommand $doomCommand] != 1} {
	error "Illegal doom command: $doomCommand"
    }
    if {$doomPipe != ""} {
	if [DEBUG] {puts "DOOM is already running!"}
	return
    }
    if {[winfo exists .output]} {destroy .output}

    DoomColorsOn

    toplevel .output
    text .output.text -height 10 -state disabled -wrap word \
    	-yscroll ".output.sbar set"
    scrollbar .output.sbar -command ".output.text yview"
    grid .output.text -wx 1 -wy 1 -fill both
    grid .output.sbar -fill y
    bind .output.text <Destroy> KillDoom

    wm geometry .output +10-34
    wm title .output "DOOM Window"

    ResetFragMatrix

    global normalFont
    for {set i 0} {$i < 35} {incr i} {
	.fraglist.l$i configure -font $normalFont
    }

    set i 0
    foreach player $players {
	set pname [lindex [split $player @] 0]
	set player_names($i) $pname
	set env([lindex $playerEnv $i]) $pname
	incr i
    }

    pipe fragPipeREAD fragPipeWRITE
    dup $fragPipeWRITE file61
    close $fragPipeWRITE
    set fragPipeWRITE file61
    fcntl $fragPipeREAD NONBLOCK 1

    set fragPipe $fragPipeREAD
    fileevent $fragPipe readable DoomFrags

    pipe doomPipeREAD doomPipeWRITE
    fcntl $doomPipeREAD NONBLOCK 1
    set doomPipe $doomPipeREAD

    if [DEBUG] {puts "PIPES: $fragPipeREAD $fragPipeWRITE"}
    set env(FRAGPIPE) [string range $fragPipeWRITE 4 end]

    set game(starttime) [getclock]
    set game(sleepstart) {"" "" "" ""}
    set game(sleeptime) {0 0 0 0}

    set game(playing) 1
    set game(id) $gameNumber
    set game(players) $players
    set game(numPlayers) [llength $players]
    set game(times) ""
    for {set i 0} {$i < 4} {incr i} {
	if {$i < $game(numPlayers)} {
	    lappend game(times) 0
	} else {
	    lappend game(times) ""
	}
    }
    set game(numActivePlayers) $game(numPlayers)
    set game(wad) $wad

    .buttons.start configure -state disabled
    .buttons.wakeup configure -state disabled
    .suspended configure -state disabled
    .solo configure -state disabled

    DoomAudio

    set size [expr [lsearch -exact $screenSizeList $screenSize] + 1]

    unlink -nocomplain /tmp/doom.out

    global doomMute
    if {$doomMute} {
	set audioCmd ""
    } else {
	global startSounds startSize start-volume
	set soundfile audio/start/[lindex $startSounds [random $startSize]]
	if {[catch {audio_real control get gain} gain] != 0} {
	    set gain 128
	}
	if {$gain == 255} {
	    set gain 100
	} else {
	    set gain [expr $gain * 100 / 256]
	}
	set gain [expr $gain * ${start-volume} / 50]
	if {$gain > 100} {set gain 100}
	if {$gain > 0} {
	    set audioCmd [format {-audioplay {-i -v %s %s}} $gain $soundfile]
	} else {
	    set audioCmd ""
	}
    }

    set doomCommand "[lindex $doomCommand 0] $audioCmd -$size \
    	[lrange $doomCommand 1 end]"

    if [DEBUG] {puts "DOOM: $doomCommand"}
    if {[catch {eval exec /bin/echo { } | $doomCommand |& \
    	/bin/tee /tmp/doom.out >&@ $doomPipeWRITE &} \
	    doomPid] != 0} {
	set message $doomPid
	set doomPid ""
	close $fragPipeWRITE
	close $doomPipeWRITE
	ExitDoom
	error $message
    }

    fileevent $doomPipe readable DoomOutput
    fcntl $doomPipe NONBLOCK 1
    close $fragPipeWRITE
    close $doomPipeWRITE
    DoPing
}

set afterSleep ""
set sleeping 0

proc DoPing {} {
    global afterSleep sleeping gUserID game

    if {$afterSleep != ""} {
	after cancel $afterSleep
    }
    set afterSleep [after 15000 Sleeping]
    if {$sleeping} {
	SendCommand [list PlayerAwake $gUserID $game(id)]
	set sleeping 0
    }
}

proc Sleeping {} {
    global afterSleep sleeping gUserID game

    set afterSleep ""
    set sleeping 1
    SendCommand [list PlayerSleeping $gUserID $game(id)]
}

proc PlayerSleeping {player gameID} {
    global game

    if {$gameID != $game(id)} {return}
    set index [lsearch -exact $game(players) $player]
    if {$index == -1} {return}

    # Disable the row
    set num [expr ($index + 1) * 6]
    .fraglist.l$num configure -bitmap snooze

    # Set the sleep start time
    set game(sleepstart) [lreplace $game(sleepstart) $index $index [getclock]]
}

proc PlayerAwake {player gameID} {
    global game

    if {$gameID != $game(id)} {return}
    set index [lsearch -exact $game(players) $player]
    if {$index == -1} {return}

    # Enable the row
    set num [expr ($index + 1) * 6]
    .fraglist.l$num configure -bitmap {}

    # Increment the sleep time
    set st [lindex $game(sleepstart) $index]
    if {$st != ""} {
	set t [lindex $game(sleeptime) $index]
	incr t [expr [getclock] - $st]
	set game(sleeptime) [lreplace $game(sleeptime) $index $index $t]
	set game(sleepstart) [lreplace $game(sleepstart) $index $index ""]
    }
}

proc KillDoom {} {
    global doomPid

    if {$doomPid != ""} {
	foreach pid $doomPid {
	    kill $doomPid
	}
    }
}

proc setfrags {array data index {remote 0}} {
    global game total_frags
    upvar #0 $array v

    if {[lindex $data 0] == "" || (!$remote && $index >= $game(numPlayers))} {
	set data {"" "" "" ""}
	set updateTotal 0
    } else {
	set updateTotal 1
    }

    set i 0
    set total 0
    foreach frag $data {
	if {!$remote && $i >= $game(numPlayers)} {
	    set frag ""
	}
	set v($i) $frag
	if {$frag != ""} {
	    if {$i == $index} {
		incr total -$frag
	    } else {
		incr total $frag
	    }
	}
	incr i
    }

    if {$updateTotal} {
	set total_frags($index) $total
    } else {
	set total_frags($index) ""
    }
}

proc ResetFragMatrix {} {
    global player_names total_frags death_frags
    global player0_frags player1_frags player2_frags player3_frags

    array set player_names {0 "" 1 "" 2 "" 3 ""}
    array set player0_frags {0 "" 1 "" 2 "" 3 ""}
    array set player1_frags {0 "" 1 "" 2 "" 3 ""}
    array set player2_frags {0 "" 1 "" 2 "" 3 ""}
    array set player3_frags {0 "" 1 "" 2 "" 3 ""}
    array set total_frags {0 "" 1 "" 2 "" 3 ""}
    array set death_frags {0 "" 1 "" 2 "" 3 ""}
}

proc CalcDeath {} {
    global death_frags player0_frags player1_frags player2_frags player3_frags

    for {set i 0} {$i<4} {incr i} {
	if {$player0_frags($i) != ""} {
	    set death_frags($i) 0
	    foreach val "$player0_frags($i) $player1_frags($i) \
	    	    	 $player2_frags($i) $player3_frags($i)" {
    	    	incr death_frags($i) -$val
    	    }
	} else {
	    set death_frags($i) ""
	}
    }
}

proc DoomFrags {} {
    global fragPipe game

    if {[catch {ArenaGetCommands $fragPipe} fragInfo] == 0} {
	set info ""
	foreach elem $fragInfo {
	    if {$elem == "ping"} {
		DoPing
	    } else {
		set info $elem
	    }
	}
	if {$info != ""} {
	    SetPlayerNames $game(players)
	    UpdateFragInfo $info 0
	}
    } else {
	global errorCode
	if {[lindex $errorCode 1] == "EAGAIN"} {
	    if [DEBUG] {puts "EAGAIN: DoomFrags"}
	} else {
	    if [DEBUG] {puts "EOF: DoomFrags"}
	    catch {close $fragPipe}
	    set fragPipe ""
	}
    }
}

proc SetFragInfo {info} {
    ResetFragMatrix
    SetPlayerNames [lindex $info 0]
    set info [lrange $info 1 end]
    UpdateFragInfo $info 1
}

proc UpdateFragInfo {info remote} {
    setfrags player0_frags [lindex $info 0] 0 $remote
    setfrags player1_frags [lindex $info 1] 1 $remote
    setfrags player2_frags [lindex $info 2] 2 $remote
    setfrags player3_frags [lindex $info 3] 3 $remote
    CalcDeath
}

proc SetPlayerNames {names} {
    global player_names
    for {set i 0} {$i < 4} {incr i} {
	set name [lindex $names $i]
	regsub {@.*$} $name {} name
	set player_names($i) $name
    }
}

proc RequestFragInfo {} {
    global game player_names
    set info \
    	[list [list $player_names(0) $player_names(1) \
	      $player_names(2) $player_names(3)]]
    set frag_arrays "player0_frags player1_frags player2_frags player3_frags"

    foreach array $frag_arrays {
	upvar $array v
	lappend info [list $v(0) $v(1) $v(2) $v(3)]
    }

    SendCommand [list FragInfo $game(id) $info]
}

proc FragInfo {gameID info} {}

proc DoomOutput {} {
    global doomPipe

    set input [read $doomPipe]
    if {$input != ""} {
	regsub -all \x08 $input "" input
	if [winfo exists .output.text] {
	    .output.text configure -state normal
	    .output.text insert end $input
	    if {[lindex [.output.sbar get] 1] == 1.0} {
		.output.text yview -pickplace end
	    }
	    .output.text configure -state disabled
	}
    } else {
	if [DEBUG] {puts "DoomOutput eof"}
	ExitDoom
    }
}

proc GameInfo {} {
    global game player_names total_frags death_frags
    global player0_frags player1_frags player2_frags player3_frags

    set clock [getclock]
    set times ""
    foreach time $game(times) {
	if {$time != 0} {
	    lappend times $time
	} else {
	    lappend times [expr $clock - $game(starttime)]
	}
    }

    return [format \
{%s %s
%s %s
%s %s
%s %s
%s %s
%12s %12s %12s %12s %12s %12s
%12s %12s %12s %12s %12s %12s
%12s %12s %12s %12s %12s %12s
%12s %12s %12s %12s %12s %12s
%12s %12s %12s %12s %12s %12s
%12s %12s %12s %12s %12s %12s
}           $game(wad) [fmtclock [getclock] {%D %T}] \
	    [lindex $times 0] [lindex $game(players) 0] \
	    [lindex $times 1] [lindex $game(players) 1] \
	    [lindex $times 2] [lindex $game(players) 2] \
	    [lindex $times 3] [lindex $game(players) 3] \
 \
	    "FRAGS" \
	    $player_names(0) \
	    $player_names(1) \
	    $player_names(2) \
	    $player_names(3) \
	    "Kills" \
 \
	    $player_names(0) \
	    $player0_frags(0) \
	    $player0_frags(1) \
	    $player0_frags(2) \
	    $player0_frags(3) \
	    $total_frags(0) \
 \
	    $player_names(1) \
	    $player1_frags(0) \
	    $player1_frags(1) \
	    $player1_frags(2) \
	    $player1_frags(3) \
	    $total_frags(1) \
 \
	    $player_names(2) \
	    $player2_frags(0) \
	    $player2_frags(1) \
	    $player2_frags(2) \
	    $player2_frags(3) \
	    $total_frags(2) \
 \
	    $player_names(3) \
	    $player3_frags(0) \
	    $player3_frags(1) \
	    $player3_frags(2) \
	    $player3_frags(3) \
	    $total_frags(3) \
 \
	    "Deaths" \
	    $death_frags(0) \
	    $death_frags(1) \
	    $death_frags(2) \
	    $death_frags(3) \
	    "" \
    ]
}

proc LogGame {args} {}

proc ExitDoom {} {
    global solo game gUserID doomPipe fragPipe afterSleep

    if [DEBUG] {puts "Exit DOOM"}

    RestoreAudio

    if {$afterSleep != ""} {
	after cancel $afterSleep
	set afterSleep ""
    }

    if {$doomPipe != ""} {
	catch {close $doomPipe}
	set doomPipe ""
    }

    if {$fragPipe != ""} {
	catch {close $fragPipe}
	set fragPipe ""
    }

    if {!$solo} {
	global suspended
	set suspended 1
	.suspended configure -state normal
	SendCommand [list PlayerExit $gUserID $game(id)]
    } else {
	.buttons.start configure -state normal
	PlayerAwake [list $gUserID] [list $game(id)]
    }
    .solo configure -state normal

    if {$game(numPlayers) > 1} {
	set info [GameInfo]
	regsub -all "\n" $info "\r" info
	SendCommand [list LogGame $game(id) $info]
    }

    set game(starttime) 0
    set game(times) {}
    set game(sleepstart) {}
    set game(sleeptime) {}
    set game(playing) 0
    set game(id) {}
    set game(players) {}
    set game(numPlayers) 0
    set game(wad) {}
    set game(numActivePlayers) 0

    # Disable all the frag counts because they are no longer being updated
    FragMatrixDisable

    if {[winfo exists .output]} {destroy .output}
    DoomColorsOff
}

proc PlayerExit {player gameID} {
    global game

    if {$gameID != $game(id)} {return}
    PlayerAwake $player $gameID
    set index [lsearch -exact $game(players) $player]
    if {$index == -1} {return}

    set time [expr [getclock] - $game(starttime)]
    incr time -[lindex $game(sleeptime) $index]
    set game(times) [lreplace $game(times) $index $index $time]

    if {$game(numActivePlayers) > 0} {
	incr game(numActivePlayers) -1
    }

    # Disable the row
    set start [expr ($index + 1) * 6]
    FragDisable $start [expr $start + 6]

    # Disable the column
    set start [expr $index + 1]
    FragDisable $start [expr $start + 36] 6
}

proc FragMatrixDisable {} {
    FragDisable 1 5
    FragDisable 6 30
    FragDisable 31 35

    .fraglist.l6 configure -bitmap {}
    .fraglist.l12 configure -bitmap {}
    .fraglist.l18 configure -bitmap {}
    .fraglist.l24 configure -bitmap {}
}

proc FragDisable {start end {incr 1}} {
    global disableFont
    for {set i $start} {$i < $end} {incr i $incr} {
	.fraglist.l$i configure -font $disableFont
    }
}

proc FragEnable {start end {incr 1}} {
    global normalFont
    for {set i $start} {$i < $end} {incr i $incr} {
	.fraglist.l$i configure -font $normalFont
    }
}

# WAKEUP! button

button .buttons.wakeup -text WAKEUP! -state disabled \
    -command [format {SendCommand \
	{ Wakeup ; AppendMessage "%s	WAKEUP!" 0 1 }} $gUserName]
grid .buttons.wakeup -padx 4

# Suspend and DOOM colors checkbuttons

frame .cbut2
grid .cbut2 -in .controls -gw 0 -pady 8
checkbutton .suspended -text Suspend -anchor w -command ToggleSuspend
grid .suspended -in .cbut2 -padx 2 -fill x
set suspended 1

if {$gBadRelease} {
    .suspended configure -state disabled
}

bind . <Button-1> ResetSuspend
bind . <Key> ResetSuspend

proc ResetSuspend {} {
    global suspendTimeoutId suspendTimeout
    if {$suspendTimeoutId != ""} {
	after cancel $suspendTimeoutId
	set suspendTimeoutId [after $suspendTimeout SetSuspend]
    }
}

proc SetSuspend {} {
    global suspended suspendTimeoutId
    set suspended 1
    set suspendTimeoutId ""
    ToggleSuspend
}

proc ToggleSuspend {} {
    global gUserID suspended

    if {$suspended} {
	SendCommand [list WRSuspend $gUserID]
    } else {
	SendCommand [list WRReady $gUserID]
    }
}

checkbutton .solo -text "Solo Play" -anchor w -command SoloPlay
grid .solo -in .cbut2 -padx 2 -gw 0 -fill x

proc SoloPlay {} {
    global env solo suspended gWadFileList

    if {$solo} {
	if {!$suspended} {
	    set suspended 1
	    ToggleSuspend
	}
	.suspended configure -state disabled
	.buttons.start configure -state normal
	if {![info exists gWadFileList]} {
	    busy {InitWadList $env(DAPARENT)}
	}
    } else {
	.suspended configure -state normal
	.buttons.start configure -state disabled
	SendCommand ReInit
    }
}

proc ReInit {} {}

checkbutton .doomMute -text Mute -anchor w
grid .doomMute -in .cbut2 -padx 2 -fill x

rename audio audio_real

trace variable doomMute w ToggleMute
proc ToggleMute {args} {
    uplevel #0 {
	if {$doomMute} {
	    proc audio args { }
	} else {
	    proc audio args { uplevel "audio_real $args" }
	}
    }
}
ToggleMute


checkbutton .switch -text "Alternate layout" -anchor w
grid .switch -in .cbut2 -padx 2 -gw 0 -fill x
trace variable switch w Switch

proc Switch {args} {
    global switch msgheight

    update
    if {![info exists msgheight]} {
	set msgheight [.messages.text cget -height]
    }

    grid propagate . 0
    if {$switch} {
	.messages.text configure -height 0
	grid configure .waitroom -after .fraglist -wy 100
	grid configure .messages -after .controls -wy 1
    } else {
	.messages.text configure -height $msgheight
	grid configure .waitroom -after .controls -wy 1
	grid configure .messages -after .fraglist -wy 100
    }

    update
    .messages.text yview -pickplace end
}

proc WinDoomColorsOn {w} {
    global gBackground gColors gDoomBackground gDoomColors

    if {[catch {$w cget -background} bg] == 0} {
	if {$bg == $gBackground} {
	    $w configure -background $gDoomBackground
	} else {
	    for {set i 0} {$i < 4} {incr i} {
		if {$bg == $gColors($i)} {
		    $w configure -background $gDoomColors($i)
		    break
		}
	    }
	}
	catch {$w configure -highlightbackground $gDoomBackground}
	catch {$w configure -troughcolor $gDoomBackground}
	catch {$w configure -foreground white}
    }

    foreach child [winfo children $w] {
	WinDoomColorsOn $child
    }
}

proc WinDoomColorsOff {w} {
    global gBackground gColors gDoomBackground gDoomColors

    if {[catch {$w cget -background} bg] == 0} {
	if {$bg == $gDoomBackground} {
	    $w configure -background $gBackground
	} else {
	    for {set i 0} {$i < 4} {incr i} {
		if {$bg == $gDoomColors($i)} {
		    $w configure -background $gColors($i)
		    break
		}
	    }
	}

	catch {$w configure -highlightbackground $gBackground}
	catch {$w configure -troughcolor $gBackground}
	catch {$w configure -foreground black}
    }

    foreach child [winfo children $w] {
	WinDoomColorsOff $child
    }
}

set doomColorsEnabled 0

proc DoomColorsToggle {} {
    global game doomcolors doomColorsEnabled

    if {$game(playing) == 0} { return }
    if {$doomcolors && !$doomColorsEnabled} {
	DoomColorsOn
    } elseif {!$doomcolors && $doomColorsEnabled} {
	DoomColorsOff
    }
}

proc DoomColorsOn {} {
    global doomcolors waitrooms doomColorsEnabled
    if {!$doomcolors} { return }
    if {[winfo depth .] != 8} { return }

    global gBackground gDoomBackground doomBackgroundIndex 
    global gColors gDoomColors doomColorIndex

    cmaphack alloc [format {{%d %s} {%d %s} {%d %s} {%d %s} {%d %s}} \
	$doomBackgroundIndex $gBackground \
	$doomColorIndex(0) $gColors(0) \
	$doomColorIndex(1) $gColors(1) \
	$doomColorIndex(2) $gColors(2) \
	$doomColorIndex(3) $gColors(3) \
    ]
    set gDoomBackground [cmaphack color $doomBackgroundIndex]
    for {set i 0} {$i < 4} {incr i} {
	set gDoomColors($i) [cmaphack color $doomColorIndex($i)]
    }
    WinDoomColorsOn .

    # Adjust the option database
    option add *foreground white
    option add *background $gDoomBackground
    option add *highlightBackground $gDoomBackground
    option add *troughColor $gDoomBackground

    # Adjust the $waitrooms tags
    foreach w $waitrooms {
	set tags [$w tag names]
	foreach tag $tags {
	    set bg [$w tag cget $tag -background]
	    for {set i 0} {$i < 4} {incr i} {
		if {$bg == $gColors($i)} {
		    $w tag configure $tag -background $gDoomColors($i)
		    break
		}
	    }
	}
    }
    set doomColorsEnabled 1
    cmaphack free
}

proc DoomColorsOff {} {
    global doomcolors waitrooms doomColorsEnabled
    global gBackground gDoomBackground doomBackgroundIndex 
    global gColors gDoomColors doomColorIndex

    if {!$doomColorsEnabled} {return}
    WinDoomColorsOff .

    # Adjust the option database
    option add *foreground black
    option add *background $gBackground
    option add *highlightBackground $gBackground
    option add *troughColor $gBackground

    # Adjust the $waitrooms tags
    foreach w $waitrooms {
	set tags [$w tag names]
	foreach tag $tags {
	    set bg [$w tag cget $tag -background]
	    for {set i 0} {$i < 4} {incr i} {
		if {$bg == $gDoomColors($i)} {
		    $w tag configure $tag -background $gColors($i)
		    break
		}
	    }
	}
    }
    set doomColorsEnabled 0
}


### Waiting room list ###

proc WaitroomYView args {
    global waitrooms prevTop

    foreach w $waitrooms {
	eval $w yview $args
	set prevTop [lindex [split [$w index @0,0] "."] 0]
    }
}

set prevTop 1
proc WaitroomScroll {w first last} {
    global prevTop waitrooms

    set top [lindex [split [$w index @0,0] "."] 0]
    set diff [expr $top - $prevTop]
    set prevTop $top

    if {$diff != 0} {
	foreach room $waitrooms {
	    if {$room != $w} {
		$room yview scroll $diff units
	    }
	}
    }
    .waitroom.sbar set $first $last
}

frame .waitroom -bd 2 -relief groove
scrollbar .waitroom.sbar -command WaitroomYView
text .waitroom.game -width 3
text .waitroom.id -width 20
text .waitroom.name -width 18
text .waitroom.machine -width 8
text .waitroom.state -width 10

set waitrooms {.waitroom.game .waitroom.id .waitroom.name \
    .waitroom.machine .waitroom.state}

grid .waitroom -gw 0 -wx 1 -fill both -padx 2 -pady 2
eval grid $waitrooms -wx 0 -wy 1 -fill both
grid configure .waitroom.id -wx 5
grid configure .waitroom.name -wx 5
grid configure .waitroom.machine -wx 1
grid .waitroom.sbar -wy 1 -fill y -gw 0

foreach w $waitrooms {
    $w configure -state disabled -wrap none -cursor crosshair \
    	-bd 0 -height 15 -padx 0 -highlightthickness 0 \
        -yscroll "WaitroomScroll $w"
    bind $w <Button-1> "ClickFrags %y"
}

proc ClickFrags {y} {
    set game [.waitroom.game get @0,$y @100,$y]
    set game [string trim $game]
    if {[llength $game] > 0} {
	SendCommand [list GetFrags $game]
    }
}
proc GetFrags {gameID} { }


### Playing list ###

frame .fraglist
grid .fraglist -gw 0 -wx 1 -fill x

set fragLabelCounter 0

proc FragLabel {var args} {
    global fragLabelCounter

    if {$args != "" && [string index [lindex $args 0] 0] != "-"} {
	set args "-background $args"
    }

    set l .fraglist.l$fragLabelCounter
    eval label $l -textvariable $var -bd 1 -relief raised $args

    if {(($fragLabelCounter + 1) % 6) == 0} {
	grid $l -wx 1 -fill x -gw 0
    } else {
	grid $l -wx 1 -fill x
    }
    incr fragLabelCounter
}

ResetFragMatrix

label .fraglist.l0 -text FRAGS -bd 1
grid .fraglist.l0 -wx 1 -fill x
incr fragLabelCounter

# Row 0
FragLabel player_names(0) $gColors(0)
FragLabel player_names(1) $gColors(1)
FragLabel player_names(2) $gColors(2)
FragLabel player_names(3) $gColors(3)
set fragKills Kills
FragLabel fragKills

# Row 1
FragLabel player_names(0) $gColors(0)     
FragLabel player0_frags(0) $gColors(0)
FragLabel player0_frags(1)
FragLabel player0_frags(2)
FragLabel player0_frags(3)
FragLabel total_frags(0) $gColors(0)

# Row 2
FragLabel player_names(1) $gColors(1)
FragLabel player1_frags(0)
FragLabel player1_frags(1) $gColors(1)
FragLabel player1_frags(2)
FragLabel player1_frags(3)
FragLabel total_frags(1) $gColors(1)

# Row 3
FragLabel player_names(2) $gColors(2)
FragLabel player2_frags(0)
FragLabel player2_frags(1)
FragLabel player2_frags(2) $gColors(2)
FragLabel player2_frags(3)
FragLabel total_frags(2) $gColors(2)

# Row 4
FragLabel player_names(3) $gColors(3)
FragLabel player3_frags(0)
FragLabel player3_frags(1)
FragLabel player3_frags(2)
FragLabel player3_frags(3) $gColors(3)
FragLabel total_frags(3) $gColors(3)

# Row 5
set fragDeaths Deaths
FragLabel fragDeaths
FragLabel death_frags(0) $gColors(0)
FragLabel death_frags(1) $gColors(1)
FragLabel death_frags(2) $gColors(2)
FragLabel death_frags(3) $gColors(3)

FragMatrixDisable


### Messages window ###

frame .messages -bd 2 -relief groove
scrollbar .messages.sbar -command ".messages.text yview"
text .messages.text -height 14 -yscroll ".messages.sbar set" \
    -bd 0 -state disabled -wrap word -tabs {2.5c 0.5c 0.5c}

bind .messages.text <Destroy> {configWrite ; playsound -fork exit}

grid .messages -wx 1 -wy 1 -fill both -gw 0 -padx 2 -pady 2
grid .messages.text -wx 1 -wy 1 -fill both
grid .messages.sbar -wy 1 -fill y


### Send message entry ###

entry .sendMessage
bind .sendMessage <Return> {
    set msg [string range [%W get] 0 $messageMaxLength]
    if {$msg != ""} {
	regsub -all "\n" $msg "\r" msg
	SendCommand [list AppendMessage "$gUserName 	$msg"]
	%W delete 0 end
    }
}

proc AppendMessage {message {audio 1} {prefixtime 0}} {
    regsub -all "\r" $message "\n	" message
    .messages.text configure -state normal
    if {$audio || $prefixtime} {
	.messages.text insert end "[fmtclock [getclock] %R] "
    }
    .messages.text insert end "$message\n"
    if {[lindex [.messages.sbar get] 1] == 1.0} {
	.messages.text yview -pickplace end
    }

    global messageHistory
    set lines [lindex [split [.messages.text index end] "."] 0]
    if {$lines > $messageHistory} {
	set diff [expr $lines - $messageHistory + 1]
	.messages.text delete 1.0 $diff.0
    }

    .messages.text configure -state disabled
    if {$audio} {
	playsound -bell message
    }

}

grid .sendMessage -gw 0 -wx 1 -fill x
focus .sendMessage

#######################################################################
### Variable traces for DOOM server updates ###
#######################################################################

set server_socket ""

proc ConnectToServer {} {
    global serverHost serverPort server_socket headerMessage

    if {$server_socket != ""} {
	if [DEBUG] {puts "Already connected to server"}
	return
    }

    if {[catch {tcp_server_connect $serverHost $serverPort} \
	    server_socket] == 0} {
	fileevent $server_socket readable ReadFromServer
	fcntl $server_socket NONBLOCK 1
	set headerMessage "Server is OK"

	global gUserName gHostAddr gFullName gMachine
	DPSend "JoinServer [list $gUserName] [list $gHostAddr] \
    	    [list $gFullName] [list $gMachine]"

    } else {
	if [DEBUG] {puts "ERROR in connect to server: $server_socket"}
	set server_socket ""
    }
}

set index [lsearch -exact $argv "-rerun"]
if {$index != -1} {
    set gFirst 0
    set argv [lreplace $argv $index $index]
} else {
    set gFirst 0

# Uncomment this line if you want the client to start unsuspended
#    set gFirst 1

}

proc SetUserID {name} {
    global gUserID gFullName gMachine gFirst

    set gUserID $name
    SendCommand [list WRJoin $gUserID $gFullName $gMachine $gFirst]
    if {$gFirst == 0} {
	global suspended
	set suspended 1
    }
    set gFirst 0

    set id [split $gUserID "@"]
    set title "[lindex $id 0]@[hostname [lindex $id 1]]"
    wm title . "DOOM Arena:  $title"
}

proc ReadFromServer {} {
    global solo soloCmd server_socket

    if {[catch {ArenaGetCommands $server_socket} commands]} {
	global errorCode
	if {[lindex $errorCode 1] == "EAGAIN"} {
	    if [DEBUG] {puts "EAGAIN: ReadFromServer"}
	} else {
	    if [DEBUG] {puts "ERROR in read from server: $commands"}
	    DPLostConnection
	}
	return
    }

    set errorMessages {}
    global errorInfo errorCode

    DisableServerTrace
    foreach cmd $commands  {
	if [DEBUG] {puts "RECEIVE: $cmd"}

	if {$solo} {
	    set first [lindex $cmd 0]
	    if {[lsearch -exact $soloCmd $first] != -1} {continue}
	}

	if {[catch {uplevel #0 untrusted eval $cmd} message] != 0} {
	    if [DEBUG] {puts "Receive error"}
	    lappend errorMessages [list $message $errorInfo $errorCode]
	} elseif {[catch {
	    if {[lindex $cmd 0] == "SafeSet"} {
		playsound option
	    }
	} message] != 0} {
	    lappend errorMessages [list $message $errorInfo $errorCode]
	}
    }
    EnableServerTrace

    if {$errorMessages != ""} {
	foreach error $errorMessages {
	    after 1 "error $error"
	}
    }
}

proc DPRetryConnection {} {
    global server_socket

    if {$server_socket == ""} {
	ConnectToServer
    }
    if {$server_socket == ""} {
	after 30000 DPRetryConnection
    }
}

proc DPLostConnection {} {
    global server_socket headerMessage

    set headerMessage "Server is down, attempting to reconnect"
    catch {close $server_socket}
    set server_socket ""
    after 5000 DPRetryConnection
}

proc DPSend {message} {
    global solo server_socket soloCmd

    if {$solo} {
	set first [lindex $message 0]
	if {[lsearch -exact $soloCmd $first] != -1} {return}
    }

    if [DEBUG] {puts "Send: $message"}
    if {$server_socket == ""} {
	ConnectToServer
    }
    if {$server_socket != ""} {
	if {[catch {puts_retry $server_socket $message} errmsg] != 0} {
	    if [DEBUG] {puts "ERROR in DPSend: $errmsg"}
	    DPLostConnection
	}
    }
}

proc SendVariable {name1 name2 op} {
    global solo
    if {$solo} {return}
    upvar $name1 v
    set command "SafeSet $name1 [list $v]"
    playsound option
    DPSend $command
}

proc SendCommand {command} {
    uplevel #0 $command
    DPSend $command
}

### Server variable tracing ###

set EnableCount 0
proc EnableServerTrace {} {
    uplevel #0 {
	incr EnableCount
	if {$EnableCount == 1} {
	    foreach v $ServerVariables {
		trace variable $v w SendVariable
	    }
	}
    }
}

proc DisableServerTrace {} {
    uplevel #0 {
	incr EnableCount -1
	if {$EnableCount == 0} {
	    foreach v $ServerVariables {
		trace vdelete $v w SendVariable
	    }
	}
    }
}

### Load configuration file ###

# Do this after variable traces are set up

set configFile $env(HOME)/.doomarenarc

if {[catch {open $configFile r} configFD] == 0} {
    set cmd [read $configFD]
    catch {eval $cmd}
    close $configFD
}

proc configWrite {} {
    global propVars
    eval global $propVars
    global DAHOME submitCWD switch gSounds configFile doomMute

    set saveLines {}
    set splitLine "# PLEASE MAKE ALL YOUR CHANGES ABOVE THIS LINE"
    set foundSplit 0

    if {[catch {open $configFile r} configFD] == 0} {
	set lines [split [read $configFD] "\n"]
	close $configFD

	foreach line $lines {
	    if {$line == $splitLine} {
		set foundSplit 1
		break
	    }
	    set saveLines "${saveLines}${line}\n"
	}
	if {!$foundSplit} {set saveLines {}}
    }

    if {[catch {open $configFile w} configFD] == 0} {
	puts -nonewline $configFD $saveLines
	puts $configFD $splitLine

	if {[info exists DAHOME]} {
	    puts $configFD "set DAHOME [list $DAHOME]"
	}
	if {[info exists submitCWD]} {
	    puts $configFD "set submitCWD [list $submitCWD]"
	}

	if {!$switch} {
	    set msgHeight \
	    	[expr int(round(([winfo height .messages.text]-4)/14.0))]
	} else {
	    set msgHeight \
	    	[expr int(round([winfo height .waitroom.game]/14.0))]
	}
	puts $configFD ".messages.text configure -height $msgHeight"

	set geom [split [wm geometry .] x+]
	set x [lindex $geom 2]
	set y [lindex $geom 3]

	puts $configFD "wm geometry . +$x+$y"
	if {[wm state .] == "iconic"} {
	    puts $configFD "wm iconify ."
	}
	puts $configFD "set doomMute $doomMute"

	foreach var $propVars {
	    puts $configFD "set $var [set $var]"
	}

	foreach sound $gSounds {
	    set w [string tolower [lindex $sound 0]]
	    global $w-volume
	    puts $configFD "set $w-volume [set $w-volume]"
	}

	puts $configFD "set switch $switch"
	close $configFD
    }
}

proc RerunClients {} {
    global env server_socket argv

    catch {close $server_socket}
    if [DEBUG] {puts "exec $env(DAHOME)/bin/doomarena $argv &"}
    exec $env(DAHOME)/bin/doomarena \
    	-display [winfo screen .] -rerun $argv &
    destroy .
}

### Connect to DOOM server ###

set headerMessage "Connecting to server..."
update

playsound enter
EnableServerTrace
DPRetryConnection
