1#!/depot/path/expectk
2
3# This script acts as a front-end for xpilot.  Run it in the background,
4# and it will pop up a window for each server it finds running.  After
5# you run it, press the "?" button for more info.
6
7# Store the filename of your xpilot client in the following variable.
8set xpilot /usr/local/bin/xpilot
9
10# Author: Don Libes, NIST, 12/29/92
11
12# I never have figured out how to get the alias out of xrdb.  For now, just
13# read it ourselves out of .Xdefaults - ugh.
14
15log_user 0
16
17set timeout 60
18
19proc probe {} {
20	global max db hosts world
21
22	set timeout -1
23
24	expect_before eof {wait;return 0}
25
26	expect -re "Server on (.*). Enter command> " {
27			exp_send "S\r"
28			set host $expect_out(1,string)
29			# replace dots in hostnames by underscores
30			regsub -all . $host _ host
31			# force lowercase to avoid Tk widget name problems
32			set host [string tolower $host]
33			lappend hosts $host
34	}
35	expect -re "WORLD\[^:]*: (\[^\r]*)\r" {
36		set worldtmp $expect_out(1,string)
37	}
38	expect -re "AUTHOR\[^:]*: (\[^\r]*)\r" {
39		set author $expect_out(1,string)
40	}
41	set world($host) "$worldtmp by $author"
42
43	# skip over junk to get players
44	expect {
45		-re -+ {}
46		-re "Enter command> " {
47			set max($host) 0
48			display $host
49			return 1
50		}
51	}
52	set i 0
53	expect {
54		-re "\\.\\.\\. .  (................)   (...) *(\[^ ]*) *(\[^\r]*)\r" {
55			# strip trailing blanks
56			set alias [string trimright $expect_out(1,string)]
57			set db($host,$i,alias) $alias
58			
59			# strip leading zeros
60			scan $expect_out(2,string) %d db($host,$i,life)
61
62			set db($host,$i,score) $expect_out(3,string)
63
64			set db($host,name,$alias) $expect_out(4,string)
65
66			incr i
67			exp_continue
68		}
69		-re "Enter command>"
70
71	}
72	set max($host) $i
73	display $host
74
75	return 1
76}
77
78proc resize {w a b} {
79	# 27 is a guess at a fixed-width sufficiently comfortable for
80	# the variable-width font.  I don't know how to do better.
81	$w configure -width 27
82}
83
84proc play {host} {
85	global xpilot alias
86
87	exec xhost $host
88	catch {exec $xpilot -name $alias($host) -join $host} status
89}
90
91proc show-help {x y msg} {
92	catch {destroy .help}
93	toplevel .help
94	wm geometry .help +$x+$y
95
96	message .help.text -text $msg
97
98	button .help.ok -text "ok" -command {destroy .help}
99	pack .help.text 
100	pack .help.ok -fill x
101}
102
103# pop up window with alias
104proc show-alias {host seln x y} {
105	global db
106
107	catch {destroy .alias}
108	toplevel .alias
109	wm geometry .alias +$x+$y
110	wm transient .alias .
111
112	regexp "(.*\[^ ]) +\[-0-9]+ +\[0-9]+$" $seln discard alias
113
114	button .alias.b -text "$db($host,name,$alias)" -command {
115		destroy .alias
116	}
117	.alias.b config -padx 1 -pady 1 -highlightthickness 0
118	pack .alias.b
119}
120
121proc help {x y} {
122	show-help $x $y "xpstat - written by Don Libes, NIST, December 29, 1992
123
124This script acts as a front-end for xpilot.  Run it in the background, and it will pop up a window for each server it finds running.  Press the \"?\" button for this info.
125
126This program polls each xpilot server once a minute.  To make it poll immediately, press \"update\".  Press \"play as\" to enter the current game with the alias to the right.  Edit to taste.  (Your alias is initialized from the value of xpilot.name in ~/.Xdefaults.)
127
128Double-click the left button on an alias to see the real user name.  To remove the user name window, click on it with the left button.
129
130Pan the world/author text, player list, or your own alias by holding the middle mouse button down and moving the mouse."
131}
132
133# if user presses "update" try to update screen immediately
134proc prod {x y} {
135	global cat_spawn_id updateflag
136
137	if {$updateflag} {
138		show-help $x $y "I heard you, gimme a break.  I'm waiting for the xpilot server to respond..."
139	}
140	set updateflag 1
141
142	exp_send -i $cat_spawn_id "\r"
143}
144
145proc display {host} {
146	global world db alias max env
147
148	set w .$host
149	if {![winfo exists $w]} {	
150
151		# window does not exist, create it
152
153		toplevel $w -class xpstat
154		wm minsize $w 1 1
155		wm title $w "xpilot@$host"
156		wm iconname $w "$host xpilot stats"
157		entry $w.world -state disabled -textvar world($host)
158
159		listbox $w.players -yscroll "resize $w.players" -font 7x13bold
160		$w.players config -highlightthickness 0 -border 0
161		$w.world config -highlightthickness 0
162
163		bind $w.players <Double-Button-1> {
164			scan %W ".%%\[^.]" host
165			show-alias $host [selection get] %X %Y
166		}
167
168		message $w.msg -text "no players" -aspect 1000 -justify center
169
170		button $w.help -text ? -command {
171			help 10 20
172		}
173
174		button $w.update -text "update"
175		bind $w.update <1> {
176			after 1 prod %X %Y
177		}
178
179		button $w.play -text "play as"
180		bind $w.play <1> {
181			scan %W ".%%\[^.]" host
182			after 1 play $host
183		}
184
185		entry $w.alias -textvar alias($host) -width 10
186		set alias($host) $env(USER)
187
188		bind $w.alias <Return> {
189			scan %W ".%%\[^.]" host
190			play $host
191		}
192
193		$w.play config -padx 1 -pady 1 -highlightthickness 0
194		$w.update config -padx 1 -pady 1 -highlightthickness 0
195		$w.help config -padx 1 -pady 1 -highlightthickness 0
196		$w.alias config -highlightthickness 0
197
198		pack $w.world -expand 1 -fill x
199		pack $w.msg
200		pack $w.help $w.update $w.play -side left
201		pack $w.alias -side left -expand 1 -fill x
202		set max($host,was) 0
203	}
204
205	if {$max($host)==0} {
206		# put up "no players" message?
207		if {$max($host,was)>0} {
208			pack $w.msg -after $w.world -fill x -side top
209			pack forget $w.world
210		}
211	} else {
212		# remove "no players" message?
213		if {$max($host,was)==0} {
214			pack $w.players -after $w.world -side top
215			pack forget $w.msg
216		}
217	}		
218
219	$w.players delete 0 end
220
221	for {set i 0} {$i<$max($host)} {incr i} {
222		$w.players insert end [format "%-17s %4d %d" \
223			$db($host,$i,alias) \
224			$db($host,$i,score) \
225			$db($host,$i,life) \
226					]
227	}
228
229	set max($host,was) $max($host)
230}
231
232wm withdraw .
233set oldhosts {}
234
235set updateflag 0		;# 1 if user pressed "update" button
236
237# look for desired alias in the .Xdefaults file
238set status [catch {exec egrep "xpilot.name:" [glob ~/.Xdefaults]} output]
239if {$status==0} {
240	regexp "xpilot.name:\[ \t]*(\[^\r]*)" $output dummy env(USER)
241}
242
243spawn cat -u; set cat_spawn_id $spawn_id
244
245while {1} {
246	global xpilot hosts
247
248	set hosts {}
249
250	eval spawn $xpilot $argv
251	while {[probe]} {exp_send "N\r"}
252	catch {expect_before}	;# disable expect_before from inside probe
253
254	# clean up hosts that no longer are running xpilots
255
256	foreach host $oldhosts {
257		# if host not in hosts
258		if {-1==[lsearch $hosts $host]} {
259			destroy .$host
260		}
261	}
262	set oldhosts $hosts
263
264	set updateflag 0
265
266	# sleep for a little while, subject to click from "update" button
267	expect -i $cat_spawn_id -re "...."	;# two crlfs
268}
269