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

# This is a wish metaserver client for the xpilot metaserver.
# It requires the Tcl and Tk packages and Perl or Telnet.
# By Peter Brandstrom, d91-pbr@nada.kth.se, 1994-95

# These are overridden by any X resources with the same names.
set xpilotProg xpilot
set hostWeights "10 se,20 no,30 dk fi,40 nl uk fr ir,50 be at de, 
	100 edu com net gov mil us org ca"
set sortByPlayers 1
set sortDetailOrder 0
set metaServerList {{meta.xpilot.org 4401} {meta2.xpilot.org 4401}}
set metaTimeout 8

# Default All Players order. 0:by nick  1:by name  2:by server  3:by map
set allPlayerOrder 0

################################################################
# The (ugly) internal list structures
#
# serverlist:
# 0:version, 1:server, 2:port, 3:#players, 4:map name, 5:map size,
# 6:map creator, 7:status, 8:max players, 9:fps, 10:player names,
# 11:sound, 12:uptime, 13:teams, 14:race

# detailPlayers    
# 0:team, 1:nick, 2:score, 3:life, 4:name, 5:status
    
# playerlist
# 0:nick, 1:name, 2:server, 3:map, 4:port, 5:team, 6:metaData index
################################################################    

set version "v2.8"

#
#  Check if integer
#
proc Integer {x} {
    return [expr 1-[catch "expr 1-$x"]]
}


#
#  Return 's' if count isn't 1
#
proc Plural {count} {
    return [expr [expr $count==1]?"":"s"]
}


#
#  Converts weight resource string to list of lists
#
proc ParseWeightRez {rez} {
    foreach line [split $rez ,] {
	lappend weightList "[lindex $line 0] {[lrange $line 1 999]}"
    }
    return $weightList
}


#
#  Find weight of server address, default 1000
#
proc Weigh {server weights} {
    set server [string tolower [string trimright $server .]]
    foreach weight $weights {
	foreach country [lindex $weight 1] {
	    if {[string match *$country $server]} {return [lindex $weight 0]}
	}
    }
    return 1000
}


#
#  Ordering functions for sorting purposes
#
proc OrderByMaxInt {list n} {
    set pl [lindex $list $n]
    if {![Integer $pl]}  { set pl 0 }
    return "[expr 999-$pl]"
}

proc OrderByServer {list n} {
    global weightList
    return "[Weigh [lindex $list $n] $weightList]"
}

proc OrderByField {list orderField} {
    foreach f $orderField {
	append result [lindex $list $f] " "
    }
    return $result
}


#
#  Sort a list of tuples
#
proc SortData {data cmpfunc} {
    set n 0
    foreach i $data {
	eval "set weight \"$cmpfunc\""
	lappend list "$weight:$n"
	incr n
    }
    lappend list ""
    set list [join $list \n]
    catch "exec sort -n << \$list" output

    set result ""
    foreach line [split $output \n]  {
	lappend result [lindex $data [lindex [split $line :] 1]]
    }
    return $result
}


#
#  Search the serverlist for a specific server
#
proc FindServer {name} {
    global serverlist
    foreach s $serverlist {
	if {[string compare [lindex $s 1] $name] == 0}  { return $s }
    }
    error ""
}


#
#  Change mouse pointer for all windows
#
proc SetCursor {cursor} {
    foreach w [winfo children .]  { $w config -cursor $cursor }
    update
}


#
#  Change the mouse cursor to reflect busy state
#
proc Busy {} { SetCursor watch }
proc NotBusy {} { SetCursor arrow }


#
#  Read X resources, keeping default values if not set
#
proc GetResource {varName class} {
    eval "global $varName"
    set r [option get . $varName $class]
    if {$r != ""}   { set $varName "$r" }
}


#
#  Convert click at y in listbox to a list of args
#
proc Click {listbox y list} {
    return [lindex $list [$listbox nearest $y]]
}
proc ClickPick {listbox y list items} {
    set tuple [Click $listbox $y $list]
    foreach item $items  { lappend result [lindex $tuple $item] }
    return $result
}


#
#  Create some lists side by side
#
proc CreateList {name columns} {
    # Synchronize scrolling of the three lists
    proc ScrollSync {name args} {
	foreach w [winfo children $name]  {
	    if {[winfo exists $w.list]} {
		eval "$w.list yview $args"
	    }
	}
    }

    # Synchronize scanning of the three lists
    proc ScanSync {name args} {
	global tk_version
	
        eval "$name.colscroll.scroll set $args"
	if {$tk_version >= 4.0} {
	    set pos [expr double([lindex $args 0])]
	    ScrollSync $name moveto $pos
	} else {
	    ScrollSync $name [lindex $args 2]
	}
    }

    # Create lists
    proc CreateColumn {basename w title width height} {
	global tk_version
	
	set name $basename.$w
	frame $name
	label $name.label -text $title -relief raised
	if {$tk_version >= 4.0} {
	    listbox $name.list -yscroll "ScanSync $basename" \
		-relief raised -width $width -height $height
	} else {
	    listbox $name.list -yscroll "ScanSync $basename" \
		-relief raised -geometry ${width}x${height}
	}
	pack append $name $name.label "top fill " \
		$name.list "bottom fill expand"
    }

    frame $name -borderwidth 6
    frame $name.colscroll
    label $name.colscroll.filler -text ""
    scrollbar $name.colscroll.scroll -command "ScrollSync $name"
    pack append $name.colscroll \
	    $name.colscroll.filler "top fillx" \
	    $name.colscroll.scroll "bottom expand fill"

    pack append $name $name.colscroll "right filly"

    set n 1
    foreach column $columns {
	CreateColumn $name column$n [lindex $column 0] [lindex $column 1] [lindex $column 2]
	pack append $name $name.column$n "left expand fill"
	incr n
    }
}


#
#  Add radio buttons to a menu
#
proc AddRadios {w var cmd list} {
    foreach btn $list {
	$w add radio -label [lindex $btn 0] -command $cmd \
		-variable $var -value [lindex $btn 1]
    }
}


#
#  Parse the list of players, return list of {nick name team}
#
proc GetPlayerList {list} {
    set list [join [concat $list ","]]
    set result ""
    while {[regexp {([^=]*)=([^,]*),(.*)} $list match nick name list]} {
	set team {{}}
	regexp {(.*){(.*)}} $name match name team
	lappend result \
		"$team {[string trim $nick]} {} {} {[string trim $name]} {}"
    }
    return $result
}


#
#  Connect to metaserver using telnet
#
proc TelnetMetaServer {} {
    global metaServer metaPort 

    catch "exec telnet $metaServer $metaPort" result
    set result [split $result \n]
    # Skip first three lines
    return [lreplace $result 0 2]
}


#
#  Connect to metaserver using perl sockets
#
proc PerlConnectToServer {server port timeout} {
    global errorCode

    set perlCode "
      sub Timeout { close(S); exit 99; }

      use Socket;
      socket(S, &PF_INET, &SOCK_STREAM, (getprotobyname('tcp'))\[3\]);
      \$SIG{'ALRM'} = 'Timeout';
      alarm($timeout+1);
      connect (S, pack('S n a4 x8', &AF_INET, $port,
  		 (gethostbyname('$server'))\[4\]));
      alarm(0);

      while (<S>) {print;}
      close (S);"

    if {[catch "exec perl << \$perlCode" result]} {
	if {[string compare [lindex $errorCode 0] CHILDSTATUS] == 0 && \
	    [lindex $errorCode 2] == 99} {
	    error "Connection timed out"
	} else {
	    error "Error: $result"
	}	
    } else {
	set result [split $result \n]
    }
    return $result
}


#
#  Create window for server configuration info
#
proc CreateServerConfigWin {} {
    if {[winfo exists .sconfig]} {
	wm deiconify .sconfig
    } else {
	toplevel .sconfig
	wm title .sconfig "XPilotmon"
	wm iconname .sconfig "XPilotmon"
	wm minsize .sconfig 300 150
	
	frame .sconfig.f
	label .sconfig.f.label -pady 3
	CreateList .sconfig.f.data {{"Item" 26 20} {"Setting" 18 20}}
	button .sconfig.f.done -text "Done" -command "wm withdraw .sconfig"
	pack append .sconfig .sconfig.f "expand fill" 
	pack append .sconfig.f .sconfig.f.label "fillx" \
		.sconfig.f.data "expand fill" .sconfig.f.done "fillx"
    }
}


#
#  View server configuration callback
#
proc ShowServerConfig {} {
    global serverlist detailServer sortField
    Busy
    if {! [catch "FindServer $detailServer" s]} {
	CreateServerConfigWin
	.sconfig.f.label configure -text "[lindex $s 1] configuration"

	set config [split [PerlServerInfo [lindex $s 1] [lindex $s 2] 1] \n]
	set list ""
	foreach l $config {
	    if {[llength $l]} {
		lappend list [split $l :]
	    }
	}
	set list [SortData $list {[OrderByField {$l} {0}]}]
	.sconfig.f.data.column1.list delete 0 end
	.sconfig.f.data.column2.list delete 0 end
	foreach d $list {
	    .sconfig.f.data.column1.list insert 9999 [lindex $d 0]
	    .sconfig.f.data.column2.list insert 9999 [lindex $d 1]
	}
    }
    NotBusy
}


#
#  Show players' scores
#
proc ShowServerScores {} {
    global serverlist detailServer detailPlayers sortField
    Busy
    if {! [catch "FindServer $detailServer" s]} {
	set info [PerlServerInfo [lindex $s 1] [lindex $s 2] 2]
	set playerdata [split $info \n]
	
	set list ""
	foreach pl $playerdata {
	    if {[regexp {(.....) (.)(.) (..................) (...) (.....) +(.*)} \
		    $pl match num stat team nick life score name] != 0} {
		if {[string compare "$stat" "*"]==0} {
		    set stat [expr \
			[string compare "$name" {robot@robots.org}]?{ }:"R"]
		}
		lappend list "{$team} {$nick} {$score} $life {$name} {$stat}"
	    }
	}
	if {[llength $list]} {
	    set detailPlayers $list
	    SortDetailWin
	}
    }
    NotBusy
}


#
#  Connect directly to server and get some info
#
proc PerlServerInfo {host port info} {
    set perlcode [concat "
        \$host = \"$host\";
        \$port = $port;
        \$info = $info;
    " {
	$CONTACT_pack       = "\x31";
	$REPORT_STATUS_pack = "\x21";
	$OPTION_LIST_pack   = "\x28";
	$timeout = 2;
	$MAGIC = 0x3261F4ED;
	
	sub request {
	    $_ = "";
	    $attempt = 0;
	    vec($mask, fileno(S), 1) = 1;
	    do {
		return () if $attempt == 3;
		send(S, "${MAGIC}${name}\0${port}@_", 0, $that);
		$attempt++;
	    } while select($mask, '', $mask, $timeout) == 0;
	    recv(S, $msg, 999999, 0);
	    ($MAGIC, $packet, $_) = unpack('a4 a a*', $msg);
	}
	$name = getpwuid($<);
	use Socket;
	$sockaddr = 'S n a4 x8';
	$proto = (getprotobyname('ip'))[3];
	($_, $_, $_, $_, $thataddr) = gethostbyname($host);
	$this = pack($sockaddr, &AF_INET, 0, "\0\0\0\0");
	$that = pack($sockaddr, &AF_INET, $port, $thataddr);
	socket(S, &PF_INET, &SOCK_DGRAM, $proto) || die "socket: $!\n";
	bind(S, $this) || die "bind: $!\n";
	
	$MAGIC = pack('N', $MAGIC);
	$port = pack('n', (unpack('S n a4 x8', getsockname(S)))[1]);
	&request($CONTACT_pack);
	die "Connection timed out\n" unless $_;
	&request($OPTION_LIST_pack) if $info == 1;
	&request($REPORT_STATUS_pack) if $info == 2;
	die "No response\n" unless $_;
	s/\0/\n/g;  print;
	close (S);  }]

    DispInfo "Connecting to $host..."
    if {[catch "exec perl << \$perlcode" f]!=0} {
	DispInfo $f
	return ""
    }
    DispInfo ""
    return $f
}


#
#  Update server list
#
proc UpdateList {reset} {
    global metaServerList metaTimeout metaServer metaPort
    global busy serverlist metaData sortOrder detailServer
 
    if $busy  return 
    set busy 1
    Busy

    if $reset {
	foreach item $metaServerList {
	    set metaServer [lindex $item 0]
	    set metaPort   [lindex $item 1]
	    DispInfo "Connecting to $metaServer..."
	    if 1 {
		set error [catch "PerlConnectToServer $metaServer \
			$metaPort $metaTimeout" result]
	    } else {
		set result [TelnetMetaServer]
		set error 0
	    }
	    if {!$error}  break
	    .time configure -text ""
	    DispInfo $result
	    lappend metaServerList [lindex $metaServerList 0]
	    set metaServerList [lreplace $metaServerList 0 0]
	}
	if $error {
	    NotBusy
	    set busy 0
	    return
	}
	set output $result
	set metaData ""
	foreach line $output  { lappend metaData [split $line :] }
	.time configure -text "Last update at: [exec date]"
    }

    DispInfo "Sorting..."	
    set serverlist [SortData $metaData $sortOrder]

    # Repack into widgets
    DispInfo "Thinking..."
    .servers.column1.list delete 0 end
    .servers.column2.list delete 0 end
    .servers.column3.list delete 0 end
    
    foreach line $serverlist {
	.servers.column1.list insert 9999 [string trimright [lindex $line 1] .]
	.servers.column2.list insert 9999 [lindex $line 4]
	.servers.column3.list insert 9999 [lindex $line 3]
    }

    set numberOfServers [llength $serverlist]
    DispInfo "Found $numberOfServers server[Plural $numberOfServers]"

    # Update details
    if [winfo exists .detail] {
	if {! [catch "FindServer $detailServer" s]}  { DetailedInfo $s }
    }
    if [winfo exists .players] ListAllPlayers
    
    NotBusy 
    set busy 0
}


#
#  Connect to remote xpilot server
#
proc StartXpilot {serv team} {
    global xpilotProg
    set server [lindex $serv 0]
    set port   [lindex $serv 1]
    DispInfo "Calling client: \"$xpilotProg -port $port $server -join$team\""
    catch "exec $xpilotProg -port $port $server -join $team &"
}


#
#  Message to user
#
proc DispInfo {info} {
    .status config -text $info
    update
}


#
#  Quit callback
#
proc Quit {} {
    destroy .
    exit
}


#
#  Sort main window callback
#
proc SortMainWin {} {
    global sortByPlayers sortOrder

    if {$sortByPlayers} {
	set sortOrder {[OrderByMaxInt $i 3] [OrderByServer $i 1]}
    } else {
	set sortOrder {[OrderByServer $i 1]}
    }
    UpdateList 0
}


#
#  Usage callback
#
proc Usage {} {
    if {! [winfo exists .usage]} {
	toplevel .usage
	wm title .usage "XPilotmon Usage"
	wm iconname .usage "XPilotmon Usage"
	frame .usage.msg -borderwidth 5
	message .usage.msg.m1 -width 400 -text "Welcome to XPilotmon!"
	message .usage.msg.m2 -width 400 -justify left \
		-text "XPilotmon displays all currently known xpilot\
 servers in the world by connecting to a metaserver in Norway.\
 This could take some time when many users use this service.\n\n\
Double click on a:		to:
  server name			  join the game
  player name, nick or team	  join that team
  map name			  get more information\n
Dragging with the middle mouse button lets you scroll a list conveniently."
	button .usage.done -text "Done" -command "wm withdraw .usage"
	pack append .usage.msg \
		.usage.msg.m1 "top fillx" \
		.usage.msg.m2 "top fillx" 
	pack append .usage \
		.usage.msg "top fillx" \
		.usage.done "bottom fillx"
    } else {
	wm deiconify .usage 
    }
}


#
#  Help|About callback
#
proc About {} {
    global version
    if {! [winfo exists .about]} {
	toplevel .about
	wm title .about About
	wm iconname .about About
	message .about.msg -width 300 -padx 50 -pady 20 -justify center \
		-text "XPilotmon $version\n\nXPilot meta server interface\n\nLast modified March 1, 1995\nBy Peter Brandstrm, d91-pbr@nada.kth.se"	    
	button .about.ok -text "OK" -command "destroy .about"
	pack append .about .about.msg "fill expand" .about.ok "bottom fillx"
    }
}


#
#  Sort all players window callback
#
proc SortPlayerWin {} {
    global playerlist allPlayerOrder

    set orders {{[OrderByField $i 0]} \
	    {[OrderByField $i 1]} \
	    {[OrderByServer $i 2] [OrderByField $i {2 0}]} \
	    {[OrderByField $i {3 2 0}]} \
	    {[OrderByServer $i 1] [OrderByField $i 0]}}
    set order [lindex $orders $allPlayerOrder]
    set playerlist [SortData $playerlist $order]

    foreach col {1 2 3 4}  { .players.players.column$col.list delete 0 end }
    foreach pl $playerlist {
	.players.players.column1.list insert 99999 [lindex $pl 0]
	.players.players.column2.list insert 99999 [lindex $pl 1]
	.players.players.column3.list insert 99999 \
		[string trimright [lindex $pl 2] .]
	.players.players.column4.list insert 99999 [lindex $pl 3]
    }
}


#
#  Create all players window
#
proc CreateAllPlayersWindow {} {
    toplevel .players
    wm title .players "XPilotmon"
    wm iconname .players "XPilotmon"
    wm minsize .players 500 360

    # Menu bar
    frame .players.menu -relief raised -borderwidth 1 
    pack append .players .players.menu {top fillx}
    # File menu
    menubutton .players.menu.file -text "File" -menu .players.menu.file.m
    menu .players.menu.file.m
    .players.menu.file.m add command -label "Update " -command "UpdateList 1"
    .players.menu.file.m add separator
    .players.menu.file.m add command -label "Close" -command "destroy .players"
    # Sort menu
    menubutton .players.menu.sort -text "Sort" -menu .players.menu.sort.m2 
    menu .players.menu.sort.m2
    AddRadios .players.menu.sort.m2 allPlayerOrder SortPlayerWin \
	    {{"By nick" 0} {"By name" 1} {"By server" 2} {"By map" 3} \
	    {"By players" 4}}

    pack append .players.menu .players.menu.file "left padx 10 pady 5" \
	    .players.menu.sort "left padx 10"
    
    CreateList .players.players {\
	    {"Nick" 16 8} \
	    {"Name (double click to join)" 28 8} \
	    {"Server (double click to play)"  25 25} \
	    {"Maps (double click to see info)" 30 25}}
    pack append .players .players.players "fill expand"
}


#
#  Show a list of all players
#
proc ListAllPlayers {} {
    global metaData playerlist allPlayerOrder
    if {! [winfo exists .players]}  CreateAllPlayersWindow

    set playerlist ""
    set n 0
    foreach serv $metaData {
	foreach player [GetPlayerList [lindex $serv 10]] {
	    set team [lindex $player 0]
	    set nick [lindex $player 1]
	    set name [lindex $player 4]
	    lappend playerlist "{$nick} {$name} [lindex $serv 1] \
		    {[lindex $serv 4]} [lindex $serv 2] {$team} $n"
	}
	incr n
    }

    SortPlayerWin
    foreach col {1 2} {
	bind .players.players.column$col.list <Double-1> \
		{StartXpilot [ClickPick %W %y $playerlist "2 4"] \
   	            "-team [ClickPick %W %y $playerlist 5]"}
    }
    bind .players.players.column3.list <Double-1> \
	    {StartXpilot [ClickPick %W %y $playerlist "2 4"] ""}
    bind .players.players.column4.list <Double-1> \
	    {DetailedInfo [lindex $metaData [ClickPick %W %y $playerlist 6]]}
}


#
#  Put player data into widgets
#
proc SortDetailWin {} {
    global sortDetailOrder detailPlayers
    
    # Sort players
    global detailServer detailTeamMode
    set teamOrder {[OrderByField $i {5 0 1}]}
    if {$detailTeamMode} {set teamOrder {[OrderByField $i {0 1}]}}
    set orders [list "$teamOrder" \
	    {[OrderByField $i 1]} \
	    {[OrderByMaxInt $i 2]} \
	    {[OrderByField $i {5 0 1}]} ]
    
    set players [SortData $detailPlayers [lindex $orders $sortDetailOrder]]
    foreach i {1 2 3 4 5 6} { .detail.players.column$i.list delete 0 end }
	
    # Insert players into list
    foreach pl $players {
	.detail.players.column1.list insert 999 [lindex $pl 5]
	.detail.players.column2.list insert 999 [lindex $pl 0]
	.detail.players.column3.list insert 999 [lindex $pl 1]
	.detail.players.column4.list insert 999 [lindex $pl 2]
	.detail.players.column5.list insert 999 [lindex $pl 3]
	.detail.players.column6.list insert 999 [lindex $pl 4]
    }
}


#
#  Create the detail window
#
proc CreateDetailWindow {} {
    proc CreateLabel {w1 w2 text} {
	label .detail.$w1.$w2 -anchor w -padx 5 -text $text
	pack append .detail.$w1 .detail.$w1.$w2 "top fill"
    }

    proc Label {w label} {
	CreateLabel info.label $w $label
	CreateLabel info.info  $w ""
    }

    toplevel .detail
    wm title .detail "XPilotmon"
    wm iconname .detail "XPilotmon"
    wm minsize .detail 500 360
    wm geometry .detail 550x490
    
    # Menu bar
    frame .detail.menu -relief raised -borderwidth 1 
    pack append .detail .detail.menu {top fillx}
    # File menu
    menubutton .detail.menu.file -text "File" -menu .detail.menu.file.m
    menu .detail.menu.file.m
    .detail.menu.file.m add command -label "Update" -command "UpdateList 1"
    .detail.menu.file.m add separator
    .detail.menu.file.m add command -label "Close" -command "destroy .detail" 
    # Sort menu
    menubutton .detail.menu.sort -text "Sort" -menu .detail.menu.sort.m 
    menu .detail.menu.sort.m
    AddRadios .detail.menu.sort.m sortDetailOrder SortDetailWin \
	    {{"By team" 0} {"By nick" 1} {"By score" 2} {"By status" 3}}

    pack append .detail.menu .detail.menu.file "left padx 10 pady 5" \
	    .detail.menu.sort "left padx 10"

    # View menu
    if {1} {
	menubutton .detail.menu.view -text "View" -menu .detail.menu.view.m
	menu .detail.menu.view.m
	.detail.menu.view.m add command -label "Scores" \
		-command "ShowServerScores"
	.detail.menu.view.m add command -label "Configuration" \
		-command "ShowServerConfig"
	pack append .detail.menu .detail.menu.view "left padx 10"
    }

    frame .detail.info -borderwidth 6
    frame .detail.info.label -relief raised
    frame .detail.info.info -relief sunken -borderwidth 2

    Label server  "Server"
    Label ver     "Version"
    Label map     "Map"  
    Label author  "Author"
    Label fps     "Frames/s"
    Label status  "Status"
    Label sound   "Sound"
    Label teams   "Teams"
    Label race    "Race mode"
    Label uptime  "Server uptime"
    Label players "Players"

    pack append .detail.info .detail.info.label "left" \
	    .detail.info.info  "left fillx expand"
    pack append .detail .detail.info  "fillx"

    CreateList .detail.players {
	{"S" 2 8} \
	{"Tm" 2 8} \
	{"Nick" 20 8} \
	{"Score" 5 8} \
	{"Life" 4 8} \
	{"Name (double click to join)" 40 8}}
    pack append .detail .detail.players "fill expand"
}


#
#  Show a windowfull of information about a server
#
proc DetailedInfo {list} {
    proc Info {w text} { .detail.info.info.$w configure -text $text }

    global serverlist detailServer detailPlayers detailTeamMode
    
    if {! [winfo exists .detail]}  CreateDetailWindow
    set detailServer [string trimright [lindex $list 1] .]

    Info server $detailServer
    Info ver    [lindex $list  0]
    Info map   "[lindex $list  4] ([lindex $list 5])"
    Info author [lindex $list  6]
    Info fps    [lindex $list  9]
    Info status [lindex $list  7]
    Info sound  [lindex $list 11]

    # Team mode?
    set detailTeamMode 0
    set teams [lindex $list 13]
    if {[Integer $teams] && $teams>0} {set detailTeamMode 1}
    Info teams [expr $detailTeamMode?"$teams":"no"]

    # Race mode?
    case [lindex $list 14] {
	0  {set racemode no}
	1  {set racemode yes}
	default  {set racemode ?}
    }
    Info race $racemode

    # Calculate server uptime
    set times "[expr 60*60*24*365] [expr 60*60*24] [expr 60*60] 60 1"
    set n 0
    set text ""
    set seconds 1
    set uptime [lindex $list 12]
    if {[Integer $uptime]} {
	foreach t $times {
	    if {$uptime > $t} {
		set count [expr $uptime/$t]
		set measure [lindex {year day hour minute second} $n]

		if {$seconds || $t>1} {
		    append text "$count $measure[Plural $count] "
		}
		set uptime [expr $uptime%$t]
		set seconds 0
	    }
	    incr n
	}
    }
    Info uptime $text
		
    Info players "[lindex $list 3] (max [lindex $list 8])"

    # Get players
    set detailPlayers [GetPlayerList [lindex $list 10]]
    SortDetailWin

    # Bind actions
    set port [lindex $list 2]
    if {[llength $detailPlayers]} {
	foreach n {1 2 3 4 5 6} {
	    if {$detailTeamMode} {
		bind .detail.players.column$n.list <Double-1> \
			"StartXpilot {$detailServer $port} \
			\" -team \[ClickPick %W %y \$detailPlayers 0\]\""
	    } else {
		bind .detail.players.column$n.list <Double-1> \
			"StartXpilot {$detailServer $port} {}"
	    }
	}
    }
}


proc CreateMainWindow {} {
    global sortByPlayers version

    wm minsize . 400 150
    wm title . "XPilotmon"

    # Menu bar
    frame .menu -relief raised -borderwidth 1 
    pack append . .menu {top fillx}
    # File menu
    menubutton .menu.file -text "File" -menu .menu.file.m
    menu .menu.file.m
    .menu.file.m add command -label "Update " -command "UpdateList 1"
    .menu.file.m add separator
    .menu.file.m add command -label "Exit " -command "Quit"
    # Sort menu
    menubutton .menu.sort -text "Sort" -menu .menu.sort.m 
    menu .menu.sort.m
    AddRadios .menu.sort.m sortByPlayers SortMainWin \
	    {{"By server" 0} {"By players" 1}}
    # View menu
    menubutton .menu.view -text "View" -menu .menu.view.m
    menu .menu.view.m
    .menu.view.m add command -label "All players..." -command "ListAllPlayers"
    # Help menu
    menubutton .menu.help -text "Help" -menu .menu.help.m -padx 10
    menu .menu.help.m
    .menu.help.m add command -label "Usage..." -command "Usage"
    .menu.help.m add separator
    .menu.help.m add command -label "About..." -command "About"

    pack append .menu .menu.file "left padx 10 pady 5" \
	    .menu.sort "left padx 10" \
	    .menu.view "left padx 10" \
	    .menu.help "right padx 20"
   
    # Last update info
    label .time -relief sunken -text "XPilotmon $version"
    pack append . .time "fill pady 2"

    # Main lists
    CreateList .servers \
	    {{"Servers (double click to play)"  30 25} \
	     {"Maps (double click to see info)" 35 25} \
  	     {"Players" 7 25}}

    bind .servers.column1.list <Double-1> \
	    {StartXpilot [ClickPick %W %y $serverlist "1 2"] ""}
	   
    bind .servers.column2.list <Double-1> \
	    {DetailedInfo [Click %W %y $serverlist]}

    pack append . .servers "fill expand"
    label .status -relief raised
    pack append . .status "fill pady 2"

    SortMainWin
#    .menu.sort.m invoke $sortByPlayers
}


#
#  Main 
#
proc Main {} {
    global busy metaData hostWeights weightList

    set metaData ""
    set busy 0

    catch "tk_listboxSingleSelect Listbox"

    GetResource allPlayerOrder  AllPlayerOrder
    GetResource metaServerList  MetaServerList
    GetResource metaTimeout     MetaTimeout
    GetResource sortByPlayers   SortByPlayers
    GetResource sortDetailOrder SortDetailOrder
    GetResource xpilotProg      XpilotProg
    GetResource hostWeights     HostWeigths
    set weightList [ParseWeightRez $hostWeights]

    CreateMainWindow
    UpdateList 1
}


if {0} {
    set color LightBlue3
    option add *borderWidth 1 widgetDefault
    option add *background $color widgetDefault
    option add *activeBackground $color widgetDefault
    option add *Scrollbar*foreground $color widgetDefault
    option add *Scrollbar*activeForeground $color widgetDefault
    option add *selector Red widgetDefault
}

Main
