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