#!/bin/sh
# the next line restarts using wish \
exec /usr/bin/wish "$0" ${1+"$@"}

set wishexec /usr/bin/wish

# don't fudge with the first 5 lines !!  Makefile depends on them!

# TclRobots
# Copyright 1994,1996 Tom Poindexter
# tpoindex@nyx.net
#
# version 1.0  August 1994
# version 2.0  February 1996
#

global rob1 rob2 rob3 rob4 c_tab s_tab parms nowin finish tourn_type
global running halted ticks maxticks execCmd numList tlimit bgColor

# set general tclrobots environment parameters
set parms(do_wait)	100 	;# number milliseconds robots wait on sys call
set parms(tick)		500	;# millisecond tick  
set parms(simtick)	500	;# simulation clock tick
set parms(errdist)	10	;# meters of possible error on scan resolution
set parms(sp)		10 	;# distance traveled at 100% per tick
set parms(accel)	10	;# accel/deaccel speed per tick as % speed 
set parms(mismax)	700	;# maximum range for a missle
set parms(msp)		100	;# distance missiles travel per tick
set parms(mreload)	[expr round(($parms(mismax)/$parms(msp))+0.5)] 
				;# missile reload time in ticks
set parms(lreload)	[expr $parms(mreload)*3]
				;# missile long reload time after clip
set parms(clip)		4	;# number of missiles per clip
set parms(turn,0)	100	;# max turn speed < 25 deg. delta
set parms(turn,1)	50	;#  "   "     "   " 50  "     "
set parms(turn,2)	30	;#  "   "     "   " 75  "     "
set parms(turn,3)	20	;#  "   "     "   > 75  "     "
set parms(rate,0) 	90	;# max rate of turn per tick at speed < 25
set parms(rate,1) 	60	;#  "   "   "   "    "   "   "    "   " 50
set parms(rate,2) 	40	;#  "   "   "   "    "   "   "    "   " 75
set parms(rate,3) 	30	;#  "   "   "   "    "   "   "    "   > 75
set parms(rate,4) 	20	;#  "   "   "   "    "   "   "    "   > 75
set parms(dia0)		 6	;# diameter of direct missle damage
set parms(dia1)		10	;#     "    "  maximum   "      "
set parms(dia2)		20	;#     "    "  medium    "      "
set parms(dia3)		40	;#     "    "  minimum   "      "   
set parms(hit0)		25	;# %damage within range 0
set parms(hit1)		12	;#    "       "     "   1
set parms(hit2)		7	;#    "       "     "   2
set parms(hit3)		3	;#    "       "     "   3
set parms(coll)		5	;#    "    from collision into wall 
set parms(heatsp)	35	;# %speed when heat builds
set parms(heatmax)	200	;# max heat index, sets speed to heatsp
set parms(hrate)  	10	;# inverse heating rate (greater hrate=slower)
set parms(cooling)	-25 	;# cooling rate per tick, after overheat
set parms(canheat)	20	;# cannon heating rate per shell
set parms(cancool)	-1	;# cannon cooling rate per tick
set parms(scanbad)	35	;# cannon heat index where scanner is inop

set parms(quads)  {{100 100} {600 100} {100 600} {600 600}}
set parms(shapes) {{3 12 7} {8 12 5} {11 11 3} {12 8 4}}
if {[winfo depth .] >= 4 } {
  set parms(cmodel) 1
} else {
  set parms(cmodel) 0
}
if {$parms(cmodel)} {
  set parms(colors) {SeaGreen3 IndianRed3 orchid3 SlateBlue1}
} else {
  set parms(colors) {black black black black}
}

set rob1(status) 0; set rob1(name) ""; set rob1(pid) -1
set rob2(status) 0; set rob2(name) ""; set rob2(pid) -1
set rob3(status) 0; set rob3(name) ""; set rob3(pid) -1
set rob4(status) 0; set rob4(name) ""; set rob4(pid) -1

set tlimit  10
set outfile ""

# init sin & cos tables
set pi  [expr 4*atan(1)]
set d2r [expr 180/$pi]

for {set i 0} {$i<360} {incr i} {
  set s_tab($i) [expr sin($i/$d2r)]
  set c_tab($i) [expr cos($i/$d2r)]
}


###############################################################################
#
# rand routine, scarffed from a comp.lang.tcl posting 
#    From: eichin@cygnus.com (Mark Eichin)
#

set _lastvalue [expr ([pid]*[file atime /dev/tty])%65536]

proc _rawrand {} {
    global _lastvalue
    # per Knuth 3.6:
    # 65277 mod 8 = 5 (since 65536 is a power of 2)
    # c/m = .5-(1/6)\sqrt{3}
    # c = 0.21132*m = 13849, and should be odd.
    set _lastvalue [expr (65277*$_lastvalue+13849)%65536]
    set _lastvalue [expr ($_lastvalue+65536)%65536]
    return $_lastvalue
}
proc rand {base} {
    set rr [_rawrand]
    return [expr abs(($rr*$base)/65536)]
}




###############################################################################
#
# these procs are the tclrobot's interface to the controller and other
# handy things
#

set interface {
  set _resume_  0
  set _step_    0
  set _lastvalue [expr ([pid]*[file atime /dev/tty])%65536]
  proc _rawrand {} {
      global _lastvalue
      # per Knuth 3.6:
      # 65277 mod 8 = 5 (since 65536 is a power of 2)
      # c/m = .5-(1/6)\sqrt{3}
      # c = 0.21132*m = 13849, and should be odd.
      set _lastvalue [expr (65277*$_lastvalue+13849)%65536]
      set _lastvalue [expr ($_lastvalue+65536)%65536]
      return $_lastvalue
  }
  proc rand {base} {
      set rr [_rawrand]
      return [expr abs(($rr*$base)/65536)]
  }
  set _ping_proc_ ""
  set _alert_on_  0
  proc _ping_check_ {} {
    global _ping_proc_ _alert_on_
    if {!$_alert_on_} {return}
    set val 0
    catch {SEND "TCLROBOTS" do_ping HAND} val
    if {$val!=0} {
      catch {eval $_ping_proc_ $val}
    }
  }
  proc alert {procname} {
    global _ping_proc_ _alert_on_
    set _ping_proc_ $procname
    if {[string length $procname] > 0} {
      set _alert_on_ 1
    } else {
      set _alert_on_ 0
    }
  }
  proc dputs {args} {
    global _resume_
    set _resume_ 0
    catch {.d.l insert end [join $args]; .d.l yview end; UPDATE}
    DEBUG
    UPDATE
    return
  }
  proc scanner {deg res} {
    AFTER DO_WAIT
    AFTER DO_WAIT
    UPDATE
    set val -1
    catch  {SEND "TCLROBOTS" do_scanner HAND $deg $res} val 
    DEBUG
    _ping_check_
    UPDATE
    return $val
  }
  proc dsp {} {
    AFTER DO_WAIT
    UPDATE
    set val -1
    catch {SEND "TCLROBOTS" do_dsp HAND} val 
    DEBUG
    _ping_check_
    UPDATE
    return $val
  }
  proc cannon {deg range} {
    AFTER DO_WAIT
    UPDATE
    set val -1
    catch {SEND "TCLROBOTS" do_cannon HAND $deg $range} val
    DEBUG
    _ping_check_
    UPDATE
    return $val
  }
  proc drive {deg speed} {
    AFTER DO_WAIT
    UPDATE
    set val -1
    catch {SEND "TCLROBOTS" do_drive HAND $deg $speed} val
    DEBUG
    _ping_check_
    UPDATE
    return $val
  }
  proc damage {} {
    AFTER DO_WAIT
    UPDATE
    set val -1
    catch {SEND "TCLROBOTS" do_damage HAND} val
    DEBUG
    _ping_check_
    UPDATE
    return $val
  }
  proc speed {} {
    AFTER DO_WAIT
    UPDATE
    set val -1
    catch {SEND "TCLROBOTS" do_speed HAND} val
    DEBUG
    _ping_check_
    UPDATE
    return $val
  }
  proc loc_x {} {
    AFTER DO_WAIT
    UPDATE
    set val -1
    catch {SEND "TCLROBOTS" do_loc_x HAND} val
    DEBUG
    _ping_check_
    UPDATE
    return $val
  }
  proc loc_y {} {
    AFTER DO_WAIT
    UPDATE
    set val -1
    catch {SEND "TCLROBOTS" do_loc_y HAND} val
    DEBUG
    _ping_check_
    UPDATE
    return $val
  }
  proc tick {} {
    AFTER DO_WAIT
    UPDATE
    set val -1
    catch {SEND "TCLROBOTS" do_tick HAND} val
    DEBUG
    _ping_check_
    UPDATE
    return $val
  }
  proc heat {} {
    AFTER DO_WAIT
    UPDATE
    set val -1
    catch {SEND "TCLROBOTS" do_heat HAND} val
    DEBUG
    _ping_check_
    UPDATE
    return $val
  }
  proc team_declare {tname} {
    # AFTER DO_WAIT
    UPDATE
    set val -1
    catch {SEND "TCLROBOTS" do_team_declare HAND $tname} val
    DEBUG
    _ping_check_
    UPDATE
    return $val
  }
  proc team_send {args} {
    # AFTER DO_WAIT
    UPDATE
    set val -1
    catch {SEND "TCLROBOTS" do_team_send HAND "$args"} val
    DEBUG
    _ping_check_
    UPDATE
    return $val
  }
  proc team_get {} {
    # AFTER DO_WAIT
    UPDATE
    set val -1
    catch {SEND "TCLROBOTS" do_team_get HAND} val
    DEBUG
    _ping_check_
    UPDATE
    return $val
  }

}

# execute these commands on tclrobot startup
set setup {

  # setup windows, .l for file name
  frame .f
  canvas .f.c -width 20 -height 16 
  label .f.l -relief sunken -width 30  -text "(loading robot code..)" 
  label .f.s -relief sunken -width 5   -text "0%"
  pack .f.c -side left
  pack .f.s -side right
  pack .f.l -side left -expand 1 -fill both
  # .d for debug listbox and scrollbar
  frame .d
  listbox .d.l -relief sunken -yscrollcommand ".d.s set" \
                              -xscrollcommand ".d.b set"
  scrollbar .d.s -command ".d.l yview"
  scrollbar .d.b -command ".d.l xview" -orient horizontal
  pack .d.s -side right  -fill y
  pack .d.b -side bottom -fill x
  pack .d.l -side left  -expand 1 -fill both
  pack .f  -side top -fill x -ipady 5
  pack .d  -side top -expand 1 -fill both 
  wm minsize . 100 70
  update

  # disable base tk commands
  foreach p {wm frame toplevel label button message listbox scrollbar scale \
	     entry text menu menubutton canvas selection grab raise lower tk \
	     pack place focus bind winfo checkbutton radiobutton option \
             bind bindtags bell clipboard fileevent image } {
    catch {rename $p {}}
  }

  # rename these commands to their random names
  rename send SEND
  rename tkwait TKWAIT
  rename destroy DESTROY
  rename exit EXIT

  # rename after to a rand generated name, make new proc
  rename after AFTER
  proc after {args} {
    uplevel AFTER $args
  }

  # rename update to a rand generated name, make new proc
  rename update UPDATE
  proc update {args} {
    uplevel UPDATE $args
  }


  # disable base tcl commands
  foreach p {open close read gets puts eof exec cd flush pwd seek \
	     glob tell info} {

    catch {rename $p {}}
  }

  # disable base tcl library procs
  foreach p {auto_execok auto_load auto_mkindex auto_reset} {
    catch {rename $p {}}
  }

  # disable base tk library startup procs
  proc tkScreenChanged {args} {}

  # our own unknown proc
  proc unknown {name args} {
    dputs "UNKNOWN: $name"
  }

  # our own tkerror proc
  proc tkerror {args} {
    global errorInfo
    dputs $errorInfo 
    dputs "TKERROR: $args"
  }
}


###############################################################################
#
# initialize robot array, start another wish, send init code
#
#

proc robot_init {robx fn x y winx winy color {sim 0}} {
  global setup interface parms wishexec nowin
  upvar #0 $robx r

  set name [file tail $fn]

  # generate a new signature
  set newsig     [rand 65535]
  set ourname    [winfo name .]

  # set robot parms
  set r(name)   ${name}_$newsig	;# window name = source.file_randnumber
  set r(num)    $newsig 	;# the rand number as digital signature
  set r(cmd)    $newsig 	;# random command names, also set below
  set r(pid)    -1		;# robot pid
  set r(status)	1 		;# robot status: 0=not used or dead, 1=running
  set r(color)	$color 		;# robot color
  set r(x) 	$x 		;# robot current x
  set r(y) 	$y		;# robot current y
  set r(orgx) 	$x 		;# robot origin  x since last heading
  set r(orgy) 	$y		;# robot origin  y   "    "     "
  set r(range)	0		;# robot current range on this heading
  set r(damage) 0		;# robot current damage
  set r(speed)	0		;# robot current speed
  set r(dspeed)	0		;# robot desired   "
  set r(hdg)	[rand 360]	;# robot current heading
  set r(dhdg)	$r(hdg)		;# robot desired   "
  set r(dir)	+		;# robot direction of turn (+/-)
  set r(sig) 	"0 0"		;# robot last scan dsp signature
  set r(mstate) 0		;# missle state: 0=avail, 1=flying
  set r(reload) 0		;# missle reload time: 0=ok, >0 = reloading
  set r(mused)  0		;# number of missles used per clip
  set r(mx)	0		;# missle current x
  set r(my)	0		;# missle current y
  set r(morgx)	0		;# missle origin  x
  set r(morgy)	0		;# missle origin  y
  set r(mhdg)	0		;# missle heading
  set r(mrange)	0		;# missle current range
  set r(mdist)	0		;# missle target distance
  set r(syscall) ""		;# last syscall & return val, for simulator
  set r(heat)	0		;# motor heat index
  set r(hflag)	0		;# overheated flag
  set r(ping)	0		;# signature of last robot to scan us
  set r(team)	""		;# declared team
  set r(data)	""		;# last team message sent
  set r(btemp)  0		;# barrel temp, affected by cannon fire

  # startup a new wish with specified name

  if {$nowin} {
    set stdinput "wm withdraw ."
  } else {
    set stdinput ""
  }
  
  catch { exec $wishexec -geom 200x115+$winx+$winy -name $r(name) \
                        << $stdinput >/dev/null 2>/dev/null & } r(pid)
  if {$r(pid) <= 0} {
    set r(pid) -1
    .l configure -text "Oops...can't find new wish, pid = $r(pid)"
    return 0
  }

  # generate new command names
  global _lastvalue
  set oldlast $_lastvalue
  if [catch {set fntime [file atime $fn]}] {set fntime [rand 255]} 
  if [catch {set fnsize [file size  $fn]}] {set fnsize [rand 255]} 
  set _lastvalue [expr ( $r(pid) * (($fntime * $fnsize)%65536) ) % 65536]
  set newcmd     [rand 65535]
  set _lastvalue $oldlast

  set r(cmd)     $newcmd

  set newdestroy _d_$newcmd
  set newafter   _a_$newcmd
  set newsend    _s_$newcmd
  set newtkwait  _t_$newcmd
  set newupdate  _u_$newcmd
  set newexit    _e_$newcmd

  if {$sim} {
    set newdebug "global _step_; if {\$_step_} {$newtkwait variable _resume_}"
  } else {
    set newdebug ""
  }

  # substitute values in generic setup and interface for this robot
  set rset $setup
  set rint $interface

  regsub -all TCLROBOTS $rint $ourname        rint
  regsub -all SEND      $rint $newsend        rint
  regsub -all AFTER     $rint $newafter       rint
  regsub -all UPDATE    $rint $newupdate      rint
  regsub -all TKWAIT    $rint $newtkwait      rint
  regsub -all DESTROY   $rint $newdestroy     rint
  regsub -all DEBUG     $rint $newdebug       rint
  regsub -all HAND      $rint $robx           rint
  regsub -all DO_WAIT   $rint $parms(do_wait) rint

  regsub -all SEND      $rset $newsend        rset
  regsub -all AFTER     $rset $newafter       rset
  regsub -all UPDATE    $rset $newupdate      rset
  regsub -all TKWAIT    $rset $newtkwait      rset
  regsub -all DESTROY   $rset $newdestroy     rset
  regsub -all EXIT      $rset $newexit        rset


  # might need to wait until new wish starts up
  set i 0
  while {[lsearch [winfo interps] $r(name)] == -1 && \
	 [incr i] < 10 && \
	 [catch {send $r(name) "expr 1+1"} result] == 1} {
    after 1000
    update
  }
  if {[catch {send $r(name) "expr 1+1"}] == 1} {
    .l configure -text "Oops...can't find new wish, pid = $r(pid)"
    return 0
  }

  # send the code
  send $r(name) $rset
  send $r(name) $rint

  if {$sim} {
    send $r(name) "set _debug 1"
  } else {
    send $r(name) "set _debug 0"
  }
  if {$parms(cmodel)} {
    send $r(name) ".f.l configure -bg $color -text $name"
  } else {
    send $r(name) ".f.l configure            -text $name"
  }
  set i [string index $robx 3]
  incr i -1
  set arrshape [lindex $parms(shapes) $i]
  send $r(name) ".f.c create line 10 12 10 7 -fill $color \
			     -arrow last -arrowshape \"$arrshape\""
  update
  send $r(name) \
    "$newafter 100 \{set _start_ 0; $newtkwait variable _start_; source $fn\}"
  return 1
}



###############################################################################
#
# start the robots!
#
#

proc start_robots {} {
  foreach robx {rob1 rob2 rob3 rob4} {
    upvar #0 $robx r
    if {$r(status)} {
      send $r(name) "_a_$r(cmd) 100 {set _start_ 1}"
    }
  }
}


###############################################################################
#
# update damage label of robot
#
#

proc up_damage {robx d} {
  global parms
  upvar #0 $robx r
  if {$d >= 100} {
    set d dead
    set c "-bg red"
  } elseif {$d >= 85} {
    set d ${d}%
    set c "-bg orange"
  } elseif {$d >= 50} {
    set d ${d}%
    set c "-bg yellow"
  } else {
    set d ${d}%
    set c ""
  }
  if {!$parms(cmodel)} {
    set c ""
  }

  catch {send -async $r(name) ".f.s configure -text $d $c; _u_$r(cmd)"}
}

###############################################################################
#
# disable robot
#
#

proc disable_robot {robx taunt} {
  upvar #0 $robx r
  # break the remote tcl interpreter by causing it to wait on .
  set insults {{junk\\ pile!} {cratered!} {scrap\\ heap!} {toast!} {face\\ plant!} {sleeps\\ with\\ PC\\ Jr.} {roasted!} {flat-liner!} {char-broiled!} {pushing\\ up\\ daisies!} {comatose!} {bits\\ busted!} {core\\ dump!} {GPF} {UAE}}
  if {$taunt} {
    set insult [lindex $insults [rand [llength $insults]]]
  } else {
    set insult ""
  }
  # break after, let the robot spin in an update cycle and wait on .
  catch {send -async $r(name) \
    "proc after {args} {}; \
     proc _ping_check_ \{\} \{while 1 \{_u_$r(cmd);_a_$r(cmd) 100\} \}" }
  catch {send -async $r(name) "_a_$r(cmd) 1 \
    \".d.l insert end $insult;.d.l yview end;_u_$r(cmd);_t_$r(cmd) window .\""}
}


###############################################################################
#
# kill robot
#
#

proc kill_robot {robx} {
  upvar #0 $robx r
  catch {send $r(name)  "rename _s_$r(cmd) send;proc _s_$r(cmd) {args} {}" }
  catch {send $r(name)  "_a_$r(cmd) 0 _e_$r(cmd)" }
  update
}


###############################################################################
#
# clean up all left overs
#
#

proc clean_up {} {
  global running
  .l configure -text "Standby, cleaning up any left overs...."
  update 
  set running 0
  foreach rr {rob1 rob2 rob3 rob4} {
    upvar #0 $rr r
    if {$r(status) || $r(pid) > 0} {
      kill_robot $rr
      after 500
      catch {exec kill $r(pid)}
      set r(pid) -1
    }
  }
}



###############################################################################
#
# update position of missiles and robots, assess damage
#
#

proc update_robots {} {
  global c_tab s_tab parms ticks running finish
  update 
  incr ticks
  set num_miss 0
  set num_rob  0
  foreach robx {rob1 rob2 rob3 rob4} {
    upvar #0 $robx r

    # check all flying missiles
    if {$r(mstate)} {
      incr num_miss 
      # update location of missle
      set r(mrange) [expr $r(mrange)+$parms(msp)]
      set r(mx)    [expr ($c_tab($r(mhdg))*$r(mrange))+$r(morgx)]
      set r(my)    [expr ($s_tab($r(mhdg))*$r(mrange))+$r(morgy)]
      # check if missle reached target
      if {$r(mrange) > $r(mdist)} {
	set r(mstate) 0
        set r(mx)    [expr ($c_tab($r(mhdg))*$r(mdist))+$r(morgx)]
        set r(my)    [expr ($s_tab($r(mhdg))*$r(mdist))+$r(morgy)]
	after 1 "show_explode $robx"

	# assign damage to all within explosion ranges
	foreach robrx {rob1 rob2 rob3 rob4} {
	  upvar #0 $robrx rr
	  if {!$rr(status)} {continue}
	  set d [expr hypot($r(mx)-$rr(x),$r(my)-$rr(y))]
	  if {$d<$parms(dia3)} {
	    if {$d<$parms(dia0)} {
	      incr rr(damage) $parms(hit0)
	    } elseif {$d<$parms(dia1)} {
	      incr rr(damage) $parms(hit1)
	    } elseif {$d<$parms(dia2)} {
	      incr rr(damage) $parms(hit2)
	    } else {
	      incr rr(damage) $parms(hit3)
	    }
           up_damage $robrx $rr(damage)
	  }
	}
      }
    }

    # skip rest if robot dead
    if {!$r(status)} {continue}

    # update missle reloader
    if {$r(reload)} {incr r(reload) -1}

    # check for excessive speed, increment heat 
    if {$r(speed) > $parms(heatsp)} {
      incr r(heat) [expr round(($r(speed)-$parms(heatsp))/$parms(hrate))+1]
      if {$r(heat) >= $parms(heatmax)} {
	set r(heat) $parms(heatmax)
	set r(hflag) 1
	if {$r(dspeed) > $parms(heatsp)} {
	  set r(dspeed) $parms(heatsp)
	}
      }
    } else {
      # if overheating, apply cooling rate
      if {$r(hflag) || $r(heat) > 0} {
	incr r(heat) $parms(cooling)
	if {$r(heat) <= 0} { set r(hflag) 0; set r(heat) 0 }
      }
    }

    # check for barrel overheat, apply cooling
    if {$r(btemp)} {
      incr r(btemp) $parms(cancool)
      if {$r(btemp) < 0} { set r(btemp) 0 }
    }

    # update robot speed, moderated by acceleration
    if {$r(speed) != $r(dspeed)} {
      if {$r(speed) > $r(dspeed)} {
	incr r(speed) -$parms(accel)
	if {$r(speed) < $r(dspeed)} {
	  set r(speed) $r(dspeed)
	}
      } else {
	incr r(speed) $parms(accel)
	if {$r(speed) > $r(dspeed)} {
	  set r(speed) $r(dspeed)
	}
      }
    }

    # update robot heading, moderated by turn rates
    if {$r(hdg) != $r(dhdg)} {
      set mrate $parms(rate,[expr int($r(speed)/25)])
      set d1 [expr ($r(dhdg)-$r(hdg)+360)%360]
      set d2 [expr ($r(hdg)-$r(dhdg)+360)%360]
      set d  [expr $d1<$d2?$d1:$d2]
      if {$d<=$mrate} {
	set r(hdg) $r(dhdg)
      } else {
	set r(hdg) [expr ($r(hdg)$r(dir)$mrate+360)%360]
      }
      set r(orgx)  $r(x)
      set r(orgy)  $r(y)
      set r(range) 0
    }

    # update distance traveled on this heading
    if {$r(speed) > 0} {
      set r(range) [expr $r(range)+($r(speed)*$parms(sp)/100)]
      set r(x)     [expr round(($c_tab($r(hdg))*$r(range))+$r(orgx))]
      set r(y)     [expr round(($s_tab($r(hdg))*$r(range))+$r(orgy))]
      # check for wall collision
      if {$r(x)<0 || $r(x)>999} {
	set r(x) [expr $r(x)<0? 0 : 999]
	set r(orgx)   $r(x)
	set r(orgy)   $r(y)
	set r(range)  0
	set r(speed)  0
	set r(dspeed) 0
	incr r(damage) $parms(coll)
        up_damage $robx $r(damage)
      }
      if {$r(y)<0 || $r(y)>999} {
	set r(y) [expr $r(y)<0? 0 : 999]
	set r(orgx)   $r(x)
	set r(orgy)   $r(y)
	set r(range)  0
	set r(speed)  0
	set r(dspeed) 0
	incr r(damage) $parms(coll)
        up_damage $robx $r(damage)
      }
    }
  }

  # check for robot health
  set diffteam ""
  set num_team 0
  foreach robx {rob1 rob2 rob3 rob4} {
    upvar #0 $robx r
    if {$r(status)} {
      if {$r(damage)>=100} {
	set r(status) 0
	set r(damage) 100
        up_damage $robx $r(damage)
	disable_robot $robx 1
        append finish "$r(name) team($r(team)) dead at tick: $ticks\n"
      } else {
	incr num_rob
        if {$r(team) != ""} {
          if {[lsearch -exact $diffteam $r(team)] == -1} {
            lappend diffteam $r(team)
            incr num_team
          }
        } else {
          lappend diffteam $r(name)
          incr num_team
        }
      }
    }
  }
  
  if {($num_rob<=1 || $num_team==1) && $num_miss==0} {
    set running 0
  }
  after 1 show_robots
}


###############################################################################
#
# update canvas with position of missiles and robots
#
#

proc show_robots {} {
  global c_tab s_tab parms
  set i 0
  foreach robx {rob1 rob2 rob3 rob4} {
    upvar #0 $robx r
    # check robots
    if {$r(status)} {
      .c delete r$r(num)
      set x [expr $r(x)/2]
      set y [expr (1000-$r(y))/2]
      set arrow [lindex $parms(shapes) $i]
      .c create line $x $y \
	  [expr $x+($c_tab($r(hdg))*5)] [expr $y-($s_tab($r(hdg))*5)] \
	  -fill $r(color) -arrow last -arrowshape $arrow -tags r$r(num)
    }
    # check missiles
    if {$r(mstate)} {
      .c delete m$r(num)
      set x [expr $r(mx)/2]
      set y [expr (1000-$r(my))/2]
      .c create oval [expr $x-2] [expr $y-2] [expr $x+2] [expr $y+2] \
	  -fill black -tags m$r(num)
    }
    incr i
  }
  #delete all previous scans
  .c delete scan
  update
}



###############################################################################
#
# show scanner from a robot
#
#

proc show_scan {hand deg res} {
  global s_tab c_tab
  upvar #0 $hand r
  if {[.c find withtag s$r(num)] != ""} {
    return
  }
  set x [expr $r(x)/2]
  set y [expr (1000-$r(y))/2]
  .c create arc [expr $x-350] [expr $y-350] [expr $x+350] [expr $y+350] \
     -start [expr $deg-$res] -extent [expr 2*$res + 1] \
     -fill "" -outline $r(color) -stipple gray50 -width 1 -tags "scan s$r(num) "

  update
}




###############################################################################
#
# show explosion of missile
#
#

proc show_explode {hand} {
  global parms
  upvar #0 $hand r
  .c delete m$r(num)
  set x [expr $r(mx)/2]
  set y [expr (1000-$r(my))/2]
  if {$parms(cmodel)} {
    .c create oval [expr $x-10] [expr $y-10] [expr $x+10] [expr $y+10] \
	-outline yellow -fill yellow  -width 1 \
	-tags e$r(num)
    .c create oval [expr $x-5] [expr $y-5] [expr $x+5] [expr $y+5] \
	-outline orange -fill orange  -width 1  \
	-tags e$r(num)
    .c create oval [expr $x-3] [expr $y-3] [expr $x+3] [expr $y+3] \
	-outline red    -fill red     -width 1  \
	-tags e$r(num)
  } else {
    .c create oval [expr $x-10] [expr $y-10] [expr $x+10] [expr $y+10] \
	-outline ""    -fill black -stipple gray25  -width 1 \
	-tags e$r(num)
    .c create oval [expr $x-5] [expr $y-5] [expr $x+5] [expr $y+5] \
	-outline ""    -fill black -stipple gray50  -width 1  \
	-tags e$r(num)
    .c create oval [expr $x-3] [expr $y-3] [expr $x+3] [expr $y+3] \
	-outline ""    -fill black    -width 1  \
	-tags e$r(num)
  }
  update
  after 750 ".c delete e$r(num)"
}



###############################################################################
#
# robot interface routines - server side
#
#

proc do_scanner {hand deg res} {
  update
  global parms
  upvar #0 $hand r
  set r(syscall) "scanner $deg $res"
  if [catch {set deg [expr round($deg)]}] {append r(syscall) " (-1)";return -1}
  if [catch {set res [expr round($res)]}] {append r(syscall) " (-1)";return -1}
  if {($deg<0 || $deg>359)} {append r(syscall) " (-1)"; return  -1}
  if {($res<0 || $res>10)}  {append r(syscall) " (-1)"; return  -1}

  after 1 "show_scan $hand $deg $res"
  set dsp   0
  set dmg   0
  set near  9999
  foreach robx {rob1 rob2 rob3 rob4} {
    upvar #0 $robx rob
    if {"$hand" == "$robx" || !$rob(status)} { continue }
    set x [expr $rob(x)-$r(x)]
    set y [expr $rob(y)-$r(y)]
    set d [expr round(57.2958*atan2($y,$x))]
    if {$d<0} {incr d 360}
    set d1  [expr ($d-$deg+360)%360]
    set d2  [expr ($deg-$d+360)%360]
    set f   [expr $d1<$d2?$d1:$d2]
    if {$f<=$res} {
      set rob(ping) $r(num)
      set dist [expr round(hypot($x,$y))]
      if {$dist<$near} {
	set derr [expr $parms(errdist)*$res]
	set terr [expr ($res>0 ? 5 : 0) + [rand $derr]]
	set fud1  [expr [rand 2] ? \"-\" : \"+\"]
	set fud2  [expr [rand 2] ? \"-\" : \"+\"]
	set near [expr $dist $fud1 $terr $fud2 $r(btemp)]
	if {$near<1} {set near 1} 
	set dsp  $rob(num)
	set dmg  $rob(damage)
      }
    }
  }
  # if cannon has overheated scanner, report 0
  if {$r(btemp) >= $parms(scanbad)} {
    set r(sig) "0 0"
    set val 0
  } else {
    set r(sig) "$dsp $dmg"
    set val [expr $near==9999?0:$near]
  }
  append r(syscall) " ($val)"
  return $val
}

proc do_dsp {hand} {
  update
  upvar #0 $hand r
  set r(syscall) "dsp ($r(sig))"
  return $r(sig)
}

proc do_ping {hand} {
  update
  upvar #0 $hand r
  set val $r(ping)
  set r(ping) 0
  return $val
}

proc do_cannon {hand deg rng} {
  update
  upvar #0 $hand r
  global parms
  set r(syscall) "cannon $deg $rng"
  if {$r(mstate)} {append r(syscall) " (0)";return 0}
  if {$r(reload)} {append r(syscall) " (0)";return 0}
  if [catch {set deg [expr round($deg)]}] {append r(syscall) " (-1)";return  -1}
  if [catch {set rng [expr round($rng)]}] {append r(syscall) " (-1)";return  -1}
  if {($deg<0 || $deg>359)} {append r(syscall) " (-1)"; return  -1}
  if {($rng<0 || $rng>$parms(mismax))} {append r(syscall) " (-1)"; return  -1}
  
  set r(mhdg)   $deg
  set r(mdist)  $rng
  set r(mrange) 0
  set r(mstate) 1
  set r(morgx)  $r(x)
  set r(morgy)  $r(y)
  set r(mx)     $r(x)
  set r(my)     $r(y)
  incr r(btemp) $parms(canheat)
  incr r(mused)
  # set longer reload time if used all missiles in clip
  if {$r(mused) == $parms(clip)} {
    set r(reload) $parms(lreload)
    set r(mused) 0
  } else {
    set r(reload) $parms(mreload)
  }
  append r(syscall) " (1)"
  return 1
}

proc do_drive {hand deg spd} {
  update
  global parms
  upvar #0 $hand r
  set r(syscall) "drive $deg $spd"
  if [catch {set deg [expr round($deg)]}] {append r(syscall) " (-1)";return  -1}
  if [catch {set spd [expr round($spd)]}] {append r(syscall) " (-1)";return  -1}
  if {($deg<0 || $deg>359)} {append r(syscall) " (-1)";return  -1}
  if {($spd<0 || $spd>100)} {append r(syscall) " (-1)";return  -1}

  set d1  [expr ($r(hdg)-$deg+360)%360]
  set d2  [expr ($deg-$r(hdg)+360)%360]
  set d   [expr $d1<$d2?$d1:$d2]

  set r(dhdg)   $deg
  set r(dspeed) [expr $r(hflag) && $spd>$parms(heatsp) ? $parms(heatsp) : $spd]

  # shutdown drive if turning too fast at current speed
  set idx [expr int($d/25)] 
  if {$idx>3} {set idx 3}
  if {$r(speed)>$parms(turn,$idx)} {
    set r(dspeed) 0 
    set r(dhdg) $r(hdg)
  } else {
    set r(orgx)  $r(x)
    set r(orgy)  $r(y)
    set r(range) 0
  }
  # find direction of turn
  if {($r(hdg)+$d+360)%360==$deg} {
    set r(dir) +
  } else {
    set r(dir) -
  }
  append r(syscall) " ($r(dspeed))"
  return $r(dspeed) 
}

proc do_damage {hand} {
  update
  upvar #0 $hand r
  set r(syscall) "damage ($r(damage))"
  return $r(damage)
}

proc do_speed {hand} {
  update
  upvar #0 $hand r
  set r(syscall) "speed ($r(speed))"
  return $r(speed)
}

proc do_loc_x {hand} {
  update
  upvar #0 $hand r
  set r(syscall) "loc_x ($r(x))"
  return $r(x)
}

proc do_loc_y {hand} {
  update
  upvar #0 $hand r
  set r(syscall) "loc_y ($r(y))"
  return $r(y)
}

proc do_tick {hand} {
  update
  upvar #0 $hand r
  global ticks
  set r(syscall) "tick ($ticks)"
  return $ticks
}

proc do_heat {hand} {
  update
  upvar #0 $hand r
  set r(syscall) "heat ($r(hflag) $r(heat))"
  return "$r(hflag) $r(heat)"
}

proc do_team_declare {hand tname} {
  update
  upvar #0 $hand r
  if {$r(team) == ""} {
    set r(team) $tname
  }
  set r(syscall) "team_declare $tname ($r(team))"
  return "$r(team)"
}

proc do_team_send {hand data} {
  update
  upvar #0 $hand r
  if {$r(team) != ""} {
    set r(data) $data
  }
  set r(syscall) "team_send $data ()"
  return ""
}

proc do_team_get {hand} {
  update
  upvar #0 $hand r
  set val ""
  if {$r(team) == ""} {
    set r(syscall) "team_get ($val)"
    return ""
  }
  foreach robx {rob1 rob2 rob3 rob4} {
    upvar #0 $robx rob
    if {"$hand" == "$robx" || !$rob(status)} { continue }
    if {"$r(team)" == "$rob(team)"} {
      lappend val [list $rob(num) $rob(data)] 
    }
  }
  set r(syscall) "team_get ($val)"
  return $val
}


##############################################################################
#
# every scheduler - scarffed from a comp.lang.tcl posing
#  From: burdick@ars.rtp.nc.us (Bill Burdick)
#
#######


proc every {period cmd args} {
    if {$args == {}} {
	set test 1
    } {
      set test [lindex $args 0]
    }
    if {[uplevel #0 "expr {$test}"]} {
	uplevel #0 $cmd
	after [uplevel #0 "expr {$period}"] "every $period {$cmd} {$test}"
    }
}


###############################################################################
#
# oops - can't start or send to wish
#
#

proc oops {robx} {
 global nowin
 upvar #0 $robx r
 global wishexec
 if {$nowin} {
    puts "tclrobots: couldn't start or send to spawned wish interpreter"
    puts "'$wishexec'"
    puts "exiting tclrobots.  possible wish left running...."
    exit
 }
 if {$r(pid) > 0} {
   # bad send text
   tk_dialog2 .oops "oops!" "Couldn't find or send to a new wish,\
    bailing out!\n\nIs your X server configured for xauth style \
    security?\n\nTclRobots uses the Tk 'send' command, which \
    requires that xhost security not be used.  Use xauth \
    if possible.\n\nAlternatively,  re-compile the wish \
    executable\n'$wishexec'\nwith the \
    '-DTK_NO_SECURITY' flag." warning 0 dismiss
  } else {
    # bad wish exec
   tk_dialog2 .oops "oops!" "Couldn't start a new wish interpreter,\
    bailing out!\n\nTclRobots is expecting \n'$wishexec'\nas the \
    name of the wish executable.\nIs it in your PATH?" warning 0 dismiss
  
  }
}

###############################################################################
#
# halt a running match
#
#

proc halt {} {
  global execCmd halted running
  set running 0
  .l configure -text "Stopping battle, standby"
  update
  foreach robx {rob1 rob2 rob3 rob4} {
    upvar #0 $robx r
    if {$r(status)} {
      disable_robot $robx 0
    }
  }
  set halted 1
  set execCmd reset
  .f1.b1 configure -state normal -text "Reset"
  .f1.b2 configure -state disabled
  .f1.b3 configure -state disabled
  .f1.b4 configure -state disabled
  .f1.b5 configure -state disabled
}


###############################################################################
#
# reset to file select state
#
#

proc reset {} {
  global execCmd
  .c delete all
  set execCmd start
  .f1.b1 configure -text "Run Battle" 
  pack forget .c
  pack .f2 -side top -expand 1 -fill both
  .l configure -text "Select robot files for battle" -fg black
  .f1.b1 configure -state normal
  .f1.b2 configure -state normal
  .f1.b3 configure -state normal
  .f1.b4 configure -state normal
  .f1.b5 configure -state normal
}


###############################################################################
#
# shutdown spawned wishes and reset
#
#

proc kill_wishes {robots} {
  # shutdown all spawned wishes
  set i 1
  foreach f $robots {
    upvar #0 rob$i r
    if {$r(status)} {
      disable_robot rob$i 0
    }
    kill_robot rob$i
    incr i
  }
  reset
}


###############################################################################
#
# draw arena boundry
#
#

proc draw_arena {} {
  .c create line 0   0   0 500
  .c create line 0   0 500   0
  .c create line 500 0 500 500
  .c create line 0 500 500 500
}



###############################################################################
#
# start a match
#
#

proc start {} {
  global rob1 rob2 rob3 rob4 parms running halted ticks execCmd numList
  global finish outfile tourn_type nowin

  set finish ""
  set players "battle: "
  set running 0
  set halted  0
  set ticks   0
  set quads $parms(quads)
  set colors $parms(colors)
  set numbots 4
  .l configure -text "Initializing..."

  # clean up robots
  foreach robx {rob1 rob2 rob3 rob4} {
    upvar #0 $robx r
    set r(status) 0
    set r(mstate) 0
    set r(name)   ""
    set r(pid)    -1
  }

  # get robot filenames from window
  set robots ""
  set lst .f2.fr.l1
  for {set i 0} {$i < $numList && $i<4} {incr i} {
    lappend robots [$lst get $i]
  }

  if {[llength $robots] < 2} {
    .l configure -text "Must have at least two robots to run a battle"
    return
  }

  set dot_geom [winfo geom .]
  set dot_geom [split $dot_geom +]
  set dot_x [lindex $dot_geom 1]
  set dot_y [lindex $dot_geom 2]

  # pick random starting quadrant, colors and init robots
  set i 1
  foreach f $robots {
    set n [rand $numbots]
    set color [lindex $colors $n]
    set colors [lreplace $colors $n $n]
    set n [rand $numbots]
    set quad [lindex $quads $n]
    set quads [lreplace $quads $n $n]

    set x [expr [lindex $quad 0]+[rand 300]]
    set y [expr [lindex $quad 1]+[rand 300]]
    
    set winx [expr $dot_x+540]
    set winy [expr $dot_y+(($i-1)*145)]
    set winy [expr (($i-1)*145)]

    set rc [robot_init rob$i $f $x $y $winx $winy $color]

    if {$rc == 0} {
      oops rob$i
      clean_up
      return
    }

    upvar #0 rob$i r
    append players "$r(name) " 

    incr i
    incr numbots -1
  }

  pack forget .f2
  pack .c -side top -expand 1 -fill both
  draw_arena

  # start robots
  .l configure -text "Running"
  set execCmd halt
  .f1.b1 configure -state normal    -text "Halt"
  .f1.b2 configure -state disabled
  .f1.b3 configure -state disabled
  .f1.b4 configure -state disabled
  .f1.b5 configure -state disabled
  start_robots

  # start physics package
  show_robots
  set running 1
  every $parms(tick) update_robots {$running}

  tkwait variable running

  # find winnner
  if {$halted} {
    .l configure -text "Battle halted"
  } else {
    set alive 0
    set winner ""
    set num_team 0
    set diffteam ""
    set win_color black
    foreach robx {rob1 rob2 rob3 rob4} {
      upvar #0 $robx r
      if {$r(status)} {
        disable_robot $robx 0
	incr alive
	lappend winner $r(name)
	set win_color $r(color)
        if {$r(team) != ""} {
          if {[lsearch -exact $diffteam $r(team)] == -1} {
            lappend diffteam $r(team)
            incr num_team
          }
        } else {
          incr num_team
        }
      }
    }
    
    switch $alive {
      0 { 
        set msg "No robots left alive"
	.l configure -text $msg
      }
      1 {
        if {[string length $diffteam] > 0} {
          set diffteam "Team $diffteam"
        }
	set msg "Winner!\n\n$diffteam\n$winner"
	.l configure -text "$winner wins!" -fg $win_color
      }
      default {
        # check for teams
        if {$num_team == 1} {
	  set msg "Winner!\n\nTeam $diffteam\n$winner"
	  .l configure -text "Team: $diffteam : $winner wins!"
        } else {
	  set msg "Tie:\n\n$winner"
	  .l configure -text "Tie: $winner" 
        }
      }
    }
    if {$nowin} {
      set msg2 [join [split $msg \n] " "]
      set score "score: "
      set points 1
      foreach l [split $finish \n] {
        set n [lindex $l 0]
        if {[string length $n] == 0} {continue}
        set l [string last _ $n]
        if {$l > 0} {incr l -1; set n [string range $n 0 $l]}
        append score "$n = $points  "
        incr points
      }
      foreach n $winner {
        set l [string last _ $n]
        if {$l > 0} {incr l -1; set n [string range $n 0 $l]}
        append score "$n = $points  "
      }
      catch {write_file $outfile "$players\n$finish\n$msg2\n\n$score\n\n\n"}
    } else {
      tk_dialog2 .winner "Results" $msg "-image iconfn" 0 dismiss
    }
  }

  set execCmd "kill_wishes \"$robots\""
  .f1.b1 configure -state normal -text "Reset"

}


###############################################################################
#
# about box
#
#

proc about {} {
  tk_dialog2 .about "About TclRobots" "TclRobots\n\nCopyright 1994,1996\nTom Poindexter\ntpoindex@nyx.net\n\nVersion 2.0\nFebruary, 1996\n" "-image iconfn" 0 dismiss

}

###############################################################################
#
# set up main window
#
#

proc main_win {} {

  global execCmd numList parms

  # define our icon 

  set tr_icon {
#define tr_width 48
#define tr_height 48
static char tr_bits[] = {
   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
   0x00, 0x00, 0x0f, 0x00, 0x00, 0x00, 0x00, 0x00, 0x1e, 0x00, 0x00, 0x00,
   0x00, 0x00, 0x38, 0x00, 0x00, 0x00, 0x00, 0x00, 0x70, 0x00, 0x00, 0x00,
   0x00, 0x00, 0x60, 0x00, 0x00, 0x00, 0x00, 0x00, 0xe1, 0x00, 0x00, 0x00,
   0x00, 0x00, 0xff, 0x07, 0x00, 0x00, 0x00, 0x00, 0xe1, 0x07, 0x00, 0x00,
   0x00, 0x00, 0xe0, 0x06, 0x00, 0x00, 0x00, 0x00, 0x70, 0x06, 0x00, 0x00,
   0x00, 0x00, 0x38, 0x06, 0x00, 0x00, 0x00, 0x00, 0x1e, 0x06, 0x00, 0x00,
   0x00, 0x00, 0x0f, 0x06, 0x00, 0x00, 0x00, 0x00, 0x00, 0x06, 0x00, 0x00,
   0x00, 0x00, 0x00, 0x06, 0x00, 0x00, 0x00, 0x00, 0x00, 0x06, 0x00, 0x00,
   0x00, 0x00, 0xfe, 0xff, 0x01, 0x00, 0x00, 0x00, 0xff, 0xff, 0x03, 0x00,
   0x80, 0x87, 0x03, 0x00, 0x07, 0x00, 0x80, 0xbf, 0x01, 0x50, 0x06, 0x00,
   0x00, 0xfc, 0x0f, 0x00, 0x06, 0x00, 0x00, 0xe0, 0x3f, 0x28, 0x06, 0x00,
   0x00, 0x80, 0x39, 0x00, 0x06, 0x00, 0x00, 0x80, 0x01, 0x14, 0x06, 0x00,
   0x00, 0x80, 0x0f, 0xc0, 0x07, 0x00, 0x00, 0x00, 0xff, 0xff, 0x03, 0x00,
   0x00, 0x00, 0xfc, 0xff, 0x00, 0x00, 0x00, 0xfc, 0xff, 0xff, 0x7f, 0x00,
   0x00, 0xfe, 0xff, 0xff, 0xff, 0x00, 0x00, 0x07, 0x00, 0x00, 0xc0, 0x01,
   0x00, 0x07, 0x00, 0x00, 0xc0, 0x01, 0x80, 0xff, 0xff, 0xff, 0xff, 0x03,
   0xc0, 0xff, 0xff, 0xff, 0xff, 0x07, 0xf0, 0x7f, 0x30, 0x0c, 0xfc, 0x1f,
   0xf0, 0x7d, 0x30, 0x0c, 0x7c, 0x1f, 0x38, 0xe0, 0x00, 0x00, 0x0e, 0x38,
   0x38, 0xe0, 0x00, 0x00, 0x0e, 0x38, 0x3c, 0xe2, 0x01, 0x00, 0x8f, 0x78,
   0x1c, 0xc7, 0x01, 0x00, 0xc7, 0x71, 0x3c, 0xe2, 0x01, 0x00, 0x8f, 0x78,
   0x38, 0xe0, 0x00, 0x00, 0x0e, 0x38, 0x38, 0xe0, 0x00, 0x00, 0x0e, 0x38,
   0xf0, 0x7d, 0x30, 0x0c, 0x7c, 0x1f, 0xf0, 0x7f, 0x30, 0x0c, 0xfc, 0x1f,
   0xc0, 0xff, 0xff, 0xff, 0xff, 0x07, 0x00, 0xff, 0xff, 0xff, 0xff, 0x01};
}

  image create bitmap iconfn -data $tr_icon -background ""

  set numList 0
  set execCmd start
  set me [winfo name .]
  if {$parms(cmodel)} {
    #option add *background        gray80
    #option add *activeBackground  gray90
    #option add *Scrollbar*background  gray80
    #option add *Scrollbar*activeBackground  gray90
  }
  option add *highlightThickness 0

  # make a toplevel icon window, iconwindow doesn't have transparent bg :-(
  catch {destroy .iconm}
  toplevel .iconm
  pack [label .iconm.i -image iconfn]

  wm title . "TclRobots"
  wm iconwindow . .iconm
  wm iconname . TclRobots
  wm protocol . WM_DELETE_WINDOW "catch {.f1.b5 invoke}"

  frame .f1
  button .f1.b1 -text "Run Battle" -width 12     -command {eval $execCmd}
  button .f1.b2 -text "Simulator.."    -command sim
  button .f1.b3 -text "Tournament.."   -command tournament
  button .f1.b4 -text "About.."        -command about 
  button .f1.b5 -text "Quit"           -command "clean_up; destroy ." 
  pack .f1.b1 .f1.b2 .f1.b3 .f1.b4 .f1.b5 -side left -expand 1 -fill both

  label .l -relief raised -text {Select robot files for battle}

  frame .f2 -width 520 -height 520 

  frame .f2.fl -relief sunken -borderwidth 3
  frame .f2.fr -relief sunken -borderwidth 3

  fileBox .f2.fl "Select" * "" [pwd] choose_file
  
  label .f2.fr.lab  -text "Robot files selected"
  listbox .f2.fr.l1 -relief sunken  -yscrollcommand ".f2.fr.s set" \
		-selectmode single
  scrollbar .f2.fr.s -command ".f2.fr.l1 yview"
  frame  .f2.fr.fb
  button .f2.fr.fb.b1 -text " Remove "     -command remove_file
  button .f2.fr.fb.b2 -text " Remove All " -command remove_all
  pack .f2.fr.fb.b1 .f2.fr.fb.b2 -side left -padx 5 -pady 5
  pack .f2.fr.lab -side top  -fill x
  pack .f2.fr.fb  -side bottom -fill x
  pack .f2.fr.s   -side right -fill y
  pack .f2.fr.l1  -side left  -expand 1 -fill both

  pack .f2.fl .f2.fr -side left -expand 1 -fill both -padx 10 -pady 10
  canvas .c -width 520 -height 520  -scrollregion "-10 -10 510 510"

  pack .f1 .l  -side top -fill both
  pack .f2 -side top -expand 1 -fill both

  wm geom . 524x574
  update
}


###############################################################################
#
# choose_file
#
proc choose_file {win filename} {
  global numList
  set listsize $numList
  .f2.fr.l1 insert end $filename
  incr numList
  set dir $filename
  for {set i 0} {$i <= $listsize} {incr i} {
    set d [.f2.fr.l1 get $i] 
    if {[string length $d] > [string length $dir]} {
      set dir  $d
    }
  }
  set idx [expr [string length [file dirname [file dirname $dir]] ]+1]
  .f2.fr.l1 xview $idx
}


###############################################################################
#
# choose_all
#
proc choose_all {} {
  global numList
  set win .f2.fl
  set lsize [$win.l.lst size]
  for {set i 0} {$i < $lsize} {incr i} {
    set f [string trim [$win.l.lst get $i]]
    if ![string match */ $f] {
      choose_file $win $f
    }
  }
  
}

###############################################################################
#
# remove_file
#
proc remove_file {} {
  global numList
  set idx -1
  catch {set idx [.f2.fr.l1 curselection]}
  if {$idx >= 0} {
    .f2.fr.l1 delete $idx
    incr  numList -1
  }
}


###############################################################################
#
# remove_all
#
proc remove_all {} {
  global numList
  set idx $numList
  if {$idx > 0} {
    .f2.fr.l1 delete 0 end
    set numList 0
  }
}


#######################################################################
# file selection box,  from my "wosql" in Oratcl
# modified not to use a toplevel
#######################################################################
# procs to support a file selection dialog box

########################
#
# fillLst
#
#    fill the fillBox listbox with selection entries
#

proc fillLst {win filt dir} {
  
  $win.l.lst delete 0 end

  cd $dir

  set dir [pwd]
  
  if {[string length $filt] == 0} {
    set filt *
  }
  set all_list [lsort [glob -nocomplain $dir/$filt]]

  set dlist  "$dir/../"
  set flist ""

  foreach f $all_list {
    if [file isfile $f] {
      lappend flist $f
    }
    if [file isdirectory $f] {
      lappend dlist ${f}/
    }
  }

  foreach d $dlist {
    $win.l.lst insert end $d
  }
  foreach f $flist {
    $win.l.lst insert end $f
  }

  $win.l.lst yview 0

  set idx [expr [string length [file dirname [file dirname $dir]] ]+1]

  $win.l.lst xview $idx
}


########################
#
# selInsert
#
#   insert into a selection entry, scroll to root name
#
proc selInsert {win pathname} {

  $win.sel delete 0 end
  $win.sel insert 0 $pathname
  set idx [expr [string length [file dirname [file dirname $pathname]] ]+1]
  $win.sel xview $idx
  $win.sel select from 0
}


########################
#
# fileOK
#
#   do the OK processing for fileBox
#

proc fileOK {win execproc} {
  
  # might not have a valid selection, so catch the selection
  # catch {  selInsert $win [lindex [selection get] 0] }
  catch {  selInsert $win [$win.l.lst get [$win.l.lst curselection]] }

  set f [lindex [$win.sel get] 0]
  if [file isdirectory $f] {
    #set f [file dirname $f]
    #set f [file dirname $f]
    cd $f
    set f [pwd]
    fillLst $win [$win.fil get] $f
  } else {
    # we don't know if a file is really there or not, let the execproc
    # figure it out.  also, window is passed if execproc wants to kill it.
    $execproc $win $f 
  }
}

########################
#
# fileBox
#
#   put up a file selection box
#    win - name of toplevel to use
#    filt - initial file selection filter 
#    initfile - initial file selection 
#    startdir - initial starting dir
#    execproc - proc to exec with selected file name
#
proc fileBox {win txt filt initfile startdir execproc} {

  if {[string length $startdir] == 0} {
    set startdir [pwd]
  }

  label $win.l1   -text "File Filter" -anchor w
  entry $win.fil  -relief sunken
  $win.fil insert 0 $filt
  label $win.l2   -text "Files" -anchor w
  frame $win.l  
  scrollbar $win.l.hor -orient horizontal -command "$win.l.lst xview" \
	    -relief sunken
  scrollbar $win.l.ver -orient vertical   -command "$win.l.lst yview" \
	    -relief sunken
  listbox $win.l.lst -yscroll "$win.l.ver set" -xscroll "$win.l.hor set" \
	    -selectmode single -relief sunken
  
  label $win.l3   -text "Selection" -anchor w
  scrollbar $win.scrl -orient horizontal -relief sunken \
                      -command "$win.sel xview"
  entry $win.sel  -relief sunken -xscroll "$win.scrl set"
  selInsert $win $initfile
  pack $win.l.ver -side right -fill y
  pack $win.l.hor -side bottom -fill x
  pack $win.l.lst -side left   -fill both  -expand 1 -ipadx 3

  frame $win.o  -relief sunken -border 1
  button $win.o.ok -text " $txt " -command "fileOK $win $execproc"
  button $win.all -text " Select All " -command "choose_all"
  button $win.filter -text " Filter " \
	  -command "fillLst $win \[$win.fil get\] \[pwd\]"

  pack $win.l1 -side top -fill x
  pack $win.fil -side top -pady 2 -fill x -ipadx 5
  pack $win.l2 -side top -fill x
  pack $win.l  -side top -fill both -expand 1
  pack $win.l3 -side top -fill x
  pack $win.sel -side top -pady 5 -fill x -ipadx 5
  pack $win.scrl -side top -fill x
  pack $win.o.ok -side left  -padx 5 -pady 5
  pack $win.o $win.all $win.filter  -side left -padx 5 -pady 10

  bind $win.fil <KeyPress-Return> "$win.filter invoke"
  bind $win.sel <KeyPress-Return> "$win.o.ok   invoke"
  bind $win.l.lst <ButtonRelease-1> \
   "+selInsert $win \[%W get \[ %W nearest %y \] \] "
  bind $win.l.lst <Double-1> \
   "selInsert $win \[%W get \[%W curselection\]\];  $win.o.ok invoke"
  bind $win <1> "$win.o.ok config -relief sunken"


  fillLst $win $filt $startdir
  selection own $win
  focus $win.sel

}

#
# end of the file selection box stuff
###########################################################################




###############################################################################
#
# step toggle
#
#

proc do_step {} {
  global rob1 parms running step
  if {$step} {
    send $rob1(name) "set _step_ 1; set _resume_ 1"
    .debug.f2.x configure -relief sunken -state normal
    .debug.f2.y configure -relief sunken -state normal
    .debug.f2.h configure -relief sunken -state normal
    .debug.fb.s configure -relief sunken -state normal
    .debug.fb.h configure -relief sunken -state normal
    .debug.fb.d configure -relief sunken -state normal
  } else {
    .debug.f2.x configure -relief flat   -state disabled
    .debug.f2.y configure -relief flat   -state disabled
    .debug.f2.h configure -relief flat   -state disabled
    .debug.fb.s configure -relief flat   -state disabled
    .debug.fb.h configure -relief flat   -state disabled
    .debug.fb.d configure -relief flat   -state disabled
    send $rob1(name) "set _step_ 0; set _resume_ 1"
    every $parms(tick) update_robots {$running && !$step }
  }
}

###############################################################################
#
# single step
#
#

proc do_single {} {
  global rob1 parms running step
  set step 1
  send $rob1(name) "set _step_ 1; set _resume_ 1"
  .debug.f2.x configure -relief sunken -state normal
  .debug.f2.y configure -relief sunken -state normal
  .debug.f2.h configure -relief sunken -state normal
  .debug.fb.s configure -relief sunken -state normal
  .debug.fb.h configure -relief sunken -state normal
  .debug.fb.d configure -relief sunken -state normal
  update_robots
}

###############################################################################
#
# examine a variable
#
#

proc examine {} {
  global rob1
  .debug.f4.val delete 0 end
  if {[catch {send $rob1(name) format \$[.debug.f4.var get]} val] == 0} {
    .debug.f4.val insert 0 $val
  } else {
    .debug.f4.val insert 0 "(not found)"
  }
}

###############################################################################
#
# set a variable
#
#

proc setval {} {
  global rob1
  catch {send $rob1(name) set [.debug.f4.var get] [list [.debug.f4.val get]]}
}


###############################################################################
#
# set heat background to indicate over heat
#
#

proc set_h_bg {args} {
  global rob1 parms bgColor
  if {$rob1(hflag)} {
    if {$parms(cmodel)} {
      .debug.f2.h configure -bg red
    } else {
      .debug.f2.h configure -bg black -fg white
    }
  } else {
    if {$parms(cmodel)} {
      .debug.f2.h configure -bg $bgColor
    } else {
      .debug.f2.h configure -bg white -fg black
    }
  }
}


###############################################################################
#
# bind proc to only allow number entries
#
#

proc num_only {win char} {
    if {[regexp {[0123456789]} "$char"]} {
        catch {tkEntryInsert $win $char}
    }
    return -code break
}


###############################################################################
#
# verify range of an rob1 entry for simulator
#
#

proc ver_range {var low high} {
  global rob1
  set val [set $var]
  if {$val < $low}  { set $var $low } 
  if {$val > $high} { set $var $high } 
}


###############################################################################
#
# start the simulator
#
#

proc sim {} {
  global rob1 rob2 rob3 rob4 parms running halted ticks execCmd 
  global step numList bgColor

  set running 0
  set halted  0
  set ticks   0
  set color red
  .l configure -text "Simulator"

  # clean up robots
  foreach robx {rob1 rob2 rob3 rob4} {
    upvar #0 $robx r
    set r(status) 0
    set r(mstate) 0
    set r(name)   ""
    set r(pid)    -1
  }

  # get robot filenames from window
  set robots ""
  set lst .f2.fr.l1

  if {$numList < 1} {
    .l configure -text "Must have one robot file selected to run simulator"
    return
  }
  lappend robots [$lst get 0]

  set dot_geom [winfo geom .]
  set dot_geom [split $dot_geom +]
  set dot_x [lindex $dot_geom 1]
  set dot_y [lindex $dot_geom 2]

  # pick random starting quadrant, colors and init robots
  set i 1
  set f $robots 

  set x [expr 100+[rand 800]]
  set y [expr 100+[rand 800]]
  
  set winx [expr $dot_x+540]
  set winy [expr $dot_y+(($i-1)*145)]

  set rc [robot_init rob$i $f $x $y $winx $winy $color 1]

  if {$rc == 0} {
    oops rob$i
    clean_up
    return
  }


  pack forget .f2
  pack .c -side top -expand 1 -fill both
  draw_arena

  # start robots
  .l configure -text "Running Simulator"
  set execCmd reset
  .f1.b1 configure -state disabled
  .f1.b2 configure -state disabled
  .f1.b3 configure -state disabled
  .f1.b4 configure -state disabled
  .f1.b5 configure -state disabled
  start_robots

  # setup target
  set rob2(name)    target_0
  set rob2(status)  1
  set rob2(num)     1
  set rob2(pid)     -1
  set rob2(color)   black
  set rob2(x)       500
  set rob2(y)       500
  set rob2(damage)  0
  set rob2(speed)   0
  set rob2(dspeed)  0
  set rob2(hdg)     0
  set rob2(dhdg)    0
  set rob2(mstate)  0
  set rob2(reload)  0
  set rob2(hflag)   0
  set rob2(heat)    0
  set rob2(team)    "target"
  set rob2(btemp)   0

  # start physics package
  show_robots
  set running 1

  # make a toplevel icon window, iconwindow doesn't have transparent bg :-(
  catch {destroy .icons}
  toplevel .icons
  pack [label .icons.i -image iconfn]

  # create toplevel simulator debug window
  set step 1
  catch {destroy .debug}
  toplevel .debug
  wm title .debug "Simulator Probe"
  wm iconwindow .debug .icons
  wm iconname .debug "TclRobots Sim"
  wm group .debug .
  wm group . .debug 
  wm protocol .debug WM_DELETE_WINDOW "catch {.debug.f1.end invoke}"
  incr i
  set winx [expr $dot_x+540]
  set winy [expr $dot_y+(($i-1)*145)]
  wm geom .debug +${winx}+$winy
  frame .debug.f1 -relief raised -borderwidth 2
  checkbutton .debug.f1.cb -text "Step syscalls" -variable step -anchor w \
	      -command do_step -relief raised
  button .debug.f1.step -text "Single Step" -command do_single
  button .debug.f1.damage -text "5% Hit"    -command "incr rob1(damage) 5"
  button .debug.f1.ping   -text "Scan"      -command "set rob1(ping) 1"
  button .debug.f1.end -text "Close" \
             -command "trace vdelete rob1(hflag) w set_h_bg
	               set rob2(status) 0; clean_up; reset; destroy .debug"
  pack .debug.f1.cb .debug.f1.step .debug.f1.damage .debug.f1.ping \
       .debug.f1.end  -side left -pady 5 -padx 3

  frame .debug.f2 -relief raised -borderwidth 2
  label .debug.f2.l1 -text "X:" -anchor e -width 8
  entry .debug.f2.x -width 7 -textvariable rob1(x)  -relief sunken
  label .debug.f2.l2 -text "Y:"  -anchor e -width 8
  entry .debug.f2.y -width 7 -textvariable rob1(y)  -relief sunken
  label .debug.f2.l3 -text "Heat:"  -anchor e -width 8
  entry .debug.f2.h -width 7 -textvariable rob1(heat)  -relief sunken
  pack .debug.f2.l1 .debug.f2.x  .debug.f2.l2 .debug.f2.y \
       .debug.f2.l3 .debug.f2.h -side left -pady 5 -padx 1

  set bgColor [.debug.f2.h cget -bg]
  bind  .debug.f2.x <Return> {ver_range rob1(x) 0 999; \
			      set rob1(orgx) $rob1(x) ;set rob1(range) 0}
  bind  .debug.f2.x <Leave>  {ver_range rob1(x) 0 999; \
			      set rob1(orgx) $rob1(x) ;set rob1(range) 0}
  bind  .debug.f2.y <Return> {ver_range rob1(y) 0 999; \
			      set rob1(orgy) $rob1(y) ;set rob1(range) 0}
  bind  .debug.f2.y <Leave>  {ver_range rob1(y) 0 999; \
			      set rob1(orgy) $rob1(y) ;set rob1(range) 0}
  bind  .debug.f2.h <Return> {ver_range rob1(heat) 0 200}
  bind  .debug.f2.h <Leave>  {ver_range rob1(heat) 0 200}
  trace variable rob1(hflag) w set_h_bg
  
  frame .debug.fb -relief raised -borderwidth 2
  label .debug.fb.l4 -text "Speed:" -anchor e -width 8
  entry .debug.fb.s -width 7 -textvariable rob1(speed) -relief sunken
  label .debug.fb.l5 -text "Heading:" -anchor e -width 8
  entry .debug.fb.h -width 7 -textvariable rob1(hdg) -relief sunken
  label .debug.fb.l6 -text "Damage:" -anchor e -width 8
  entry .debug.fb.d -width 7 -textvariable rob1(damage) -relief sunken
  pack .debug.fb.l4 .debug.fb.s  .debug.fb.l5 .debug.fb.h \
       .debug.fb.l6 .debug.fb.d  -side left -pady 5 -padx 1
  bind  .debug.fb.s <Return> {ver_range rob1(speed) 0 100; \
			      set rob1(dspeed) $rob1(speed)}
  bind  .debug.fb.s <Leave>  {ver_range rob1(speed) 0 100; \
			      set rob1(dspeed) $rob1(speed)}
  bind  .debug.fb.h <Return> {ver_range rob1(hdg) 0 359; \
    		 set rob1(dhdg) $rob1(hdg) ;set rob1(range) 0; \
  		 set rob1(orgx) $rob1(x); set rob1(orgy) $rob1(y)}
  bind  .debug.fb.h <Leave> {ver_range rob1(hdg) 0 359; \
    		 set rob1(dhdg) $rob1(hdg) ;set rob1(range) 0; \
  		 set rob1(orgx) $rob1(x); set rob1(orgy) $rob1(y)}
  bind  .debug.fb.d <Return> {ver_range rob1(damage) 0 100}
  bind  .debug.fb.d <Leave>  {ver_range rob1(damage) 0 100}

  frame .debug.f3 -relief raised -borderwidth 2
  label .debug.f3.l1 -text "Last syscall: " -anchor e
  label .debug.f3.s -width 20 -textvariable rob1(syscall) -anchor w
  label .debug.f3.l3 -text "Tick:" -anchor e -width 6
  label .debug.f3.t -width 5 -textvariable ticks -anchor w -width 5
  label .debug.f3.l4 -text "Barrel:" -anchor e -width 6
  label .debug.f3.b -width 5 -textvariable rob1(btemp) -anchor w -width 5
  pack .debug.f3.l1 .debug.f3.s .debug.f3.l3 .debug.f3.t  \
       .debug.f3.l4 .debug.f3.b  -side left -pady 5 -padx 2

  frame .debug.f4 -relief raised -borderwidth 2
  label .debug.f4.l1 -text "Variable: " -anchor e
  entry .debug.f4.var -width 10 -relief sunken
  label .debug.f4.l2 -text "Value: " -anchor e
  entry .debug.f4.val -width 10 -relief sunken
  button .debug.f4.examine -text " Examine " -command examine
  button .debug.f4.set     -text " Set "     -command setval
  pack .debug.f4.l1 .debug.f4.var .debug.f4.l2 .debug.f4.val \
       .debug.f4.examine .debug.f4.set -side left -pady 5 -padx 2
  bind .debug.f4.var <Key-Return> ".debug.f4.examine invoke"
  bind .debug.f4.val <Key-Return> ".debug.f4.set     invoke"
  
  pack .debug.f1 .debug.f2 .debug.fb .debug.f3 .debug.f4 -side top -fill x

  # override binding for Any-Keypress, but save others
  foreach e {.debug.f2.x .debug.f2.y .debug.f2.h .debug.fb.s \
	     .debug.fb.h .debug.fb.d} {
    set cur_bind [bind Entry]
    foreach c $cur_bind {
      bind $e $c "[bind Entry $c] ; return -code break"
    }
    bind $e <KeyPress> {num_only %W %A}
  }

  # set initial step state
  do_step

}

###############################################################################
#
# reset2 to tournament controller
#
#

proc reset2 {} {
  global execCmd
  .c delete all
  set execCmd start
  .f1.b1 configure -text "Run Battle" 
  pack forget .c
  pack .f2 -side top -expand 1 -fill both
  .l configure -text "Select robot files for battle" -fg black
  .f1.b1 configure -state disabled
  .f1.b2 configure -state disabled
  .f1.b3 configure -state disabled
  .f1.b4 configure -state disabled
  .f1.b5 configure -state disabled
  .tourn.f1.start configure -state normal 
  .tourn.f1.end   configure -state normal 
  .tourn.f2.t     configure -state normal 
  .tourn.f3.f     configure -state normal 
}



###############################################################################
#
# list compare function for "int string"
#
#

proc lcomp {l1 l2} {
  set i1 [lindex $l1 0]
  set i2 [lindex $l2 0]
  if {$i1 < $i2} {
    return -1
  } elseif {$i1 > $i2} {
    return  1
  } else {
    return  0
  }
}  


###############################################################################
#
# append a string to a file
#
#

proc write_file {file str} {
  set fd [open $file a]
  puts $fd $str
  close $fd
}


###############################################################################
#
# check time limit of match
#
#

proc check_time {} {
  global ticks maxticks running nowin
  if {$ticks > $maxticks} {set running 0; return} 
  if {$nowin} return
  # update every 30 seconds
  if {$ticks % 60 == 0} {
    # assumes 500 ms tick rate!
    set left [expr ($maxticks-$ticks)/2]
    set mins [expr $left/60]
    set secs [expr $left%60]
    .tourn.f4.l configure -text "Time remaining: [format {%d:%02d} $mins $secs]"
  }
}


###############################################################################
#
# start the tournament 
#
#

proc do_tourn {} {
  global rob1 rob2 rob3 rob4 parms running halted ticks maxticks execCmd 
  global tlimit outfile numList finish

  set finish ""
  set running 0
  set halted  0
  set ticks   0

  set robots ""
  .tourn.f4.lst delete 0 end

  if {[catch {set tlimit [expr round($tlimit)]}] == 1} {
    .tourn.f4.l configure -text \
	    "Maximum time limit must be numeric"
    return  
  }

  # get robot filenames from window
  set robots ""
  set lst .f2.fr.l1
  set i $numList
  
  # get unique robot files
  for {set i 1} {$i <= $numList} {incr i} {
    set rob [$lst get [expr $i - 1]]
    if {[lsearch -exact $robots $rob] == -1} {
      lappend robots $rob
    }
  }

  set dot_geom [winfo geom .]
  set dot_geom [split $dot_geom +]
  set dot_x [lindex $dot_geom 1]
  set dot_y [lindex $dot_geom 2]

  set num_bots [llength $robots]
  if {$num_bots < 2} {
    .l configure  -text \
      "Must have at least two unique files selected to run tournament"
    return
  }
  
  set results ""
  foreach idx $robots  {
    set f [file tail $idx]
    lappend save_robots $f
    set tourney($f)     0
  }

  
  set tot_matches  [expr (($num_bots * $num_bots) - $num_bots) / 2]
  set cur_match    0
  .tourn.f4.l configure -text "$tot_matches matches to run"

  .tourn.f1.start configure -state disabled
  .tourn.f1.end   configure -state disabled
  .tourn.f2.t     configure -state disabled
  .tourn.f3.f     configure -state disabled

  .l configure -text "Running Tournament"
  set execCmd halt
  .f1.b1 configure -state normal    -text "Halt"
  pack forget .f2
  pack .c -side top -expand 1 -fill both


  while {[llength $robots] > 1} {  
    set current [lindex $robots 0]
    set robots  [lrange $robots 1 end]
    .c delete all
    draw_arena
    foreach rr $robots {
      # clean up robots
      foreach robx {rob1 rob2 rob3 rob4} {
	upvar #0 $robx r
	set r(status) 0
	set r(mstate) 0
	set r(name)   ""
	set r(pid)    -1
      }

      set colors $parms(colors)
      set quads  $parms(quads)
      set numbots 4
      # pick random starting quadrant, colors and init robots
      set i 1
      foreach f "$current $rr" {
	set n [rand $numbots]
	set color [lindex $colors $n]
	set colors [lreplace $colors $n $n]
	set n [rand $numbots]
	set quad [lindex $quads $n]
	set quads [lreplace $quads $n $n]

	set x [expr [lindex $quad 0]+[rand 300]]
	set y [expr [lindex $quad 1]+[rand 300]]
	
	set winx [expr $dot_x+540]
	set winy [expr $dot_y+(($i-1)*145)]

	set rc [robot_init rob$i $f $x $y $winx $winy $color]

	if {$rc == 0} {
	  oops rob$i
	  clean_up
	  reset2
	  # .f1.b1 configure -state normal -text "Reset"
	  .tourn.f1.start configure -state normal 
	  .tourn.f1.end   configure -state normal 
	  .tourn.f2.t     configure -state normal 
	  .tourn.f3.f     configure -state normal 
	  return
	}

	incr i
	incr numbots -1
      }

      # start robots
      incr cur_match
      .l configure -text "Running Match $cur_match of $tot_matches"
      set execCmd halt
      .f1.b1 configure -state normal    -text "Halt"
      .f1.b2 configure -state disabled
      .f1.b3 configure -state disabled
      .f1.b4 configure -state disabled
      .f1.b5 configure -state disabled

      start_robots

      # start physics package
      show_robots
      set running 1
      set ticks 0
      set maxticks [expr int(($tlimit*60)/($parms(simtick)/1000.0)+1)]
      check_time
      every $parms(tick) update_robots {$running}
      every $parms(tick) check_time    {$running}

      tkwait variable running

      .l configure -text "Match over"
      update

      # shutdown all spawned wishes
      set i 1
      foreach ff "rob1 rob2" {
	upvar #0 rob$i r
	if {$r(status)} {
	  disable_robot rob$i 0
	}
	kill_robot rob$i
	incr i
      }

      # check for halted
      if {$halted} {
	.l configure -text "Tournament halted"
	set execCmd reset2
	.f1.b1 configure -state normal -text "Reset"
	return
      }

      # find winnner rob1=t_current rob2=t_rr
      set t_current [file tail $current]
      set t_rr      [file tail $rr     ]
      if {$rob1(damage)<100 && $rob2(damage)==100} {
        set res "$t_current vs. $t_rr : $t_current ($rob1(damage)%) wins"
        incr tourney($t_current) 3 
      } elseif {$rob1(damage)==100 && $rob2(damage)<100} {
        set res "$t_current vs. $t_rr : $t_rr ($rob2(damage)%) wins"
        incr tourney($t_rr) 3
      } else {
        set res \
 "$t_current vs. $t_rr : tie $t_current ($rob1(damage)%) $t_rr ($rob2(damage)%)"
        incr tourney($t_current) 
	incr tourney($t_rr)
      }
      .tourn.f4.lst insert end $res
      append results  $res \n
      .tourn.f4.lst yview [expr $cur_match-4 > 0 ? $cur_match-4 : 0]
      .c delete all
      draw_arena
      update
    
    }

  }

  # rank results
  append results \n \n results \n \n
  foreach n [array names tourney] {
    lappend resList "$tourney($n)  $n"
  }
  set resList [lsort -decreasing -command lcomp $resList]
  foreach l $resList {
    append results2 $l \n
  }
  .tourn.f4.lst insert end "" "" "results"  
  foreach l [split $results2 \n] {
    .tourn.f4.lst insert end $l
  }

  # save results to file
  if {$outfile != ""} {
    catch {write_file $outfile $results\n$results2}
  }

  set execCmd reset2
  # .f1.b1 configure -state normal -text "Reset"
  .tourn.f1.start configure -state normal 
  .tourn.f1.end   configure -state normal 
  .tourn.f2.t     configure -state normal 
  .tourn.f3.f     configure -state normal 

}

###############################################################################
#
# start the tournament controller
#
#

proc tournament {} {
  global rob1 rob2 rob3 rob4 parms running halted ticks execCmd 
  global tlimit outfile numList 

  set running 0
  set halted  0
  set ticks   0
  .l configure -text "Tournament"

  set dot_geom [winfo geom .]
  set dot_geom [split $dot_geom +]
  set dot_x [lindex $dot_geom 1]
  set dot_y [lindex $dot_geom 2]

  .l configure -text "Running Tournament"
  set execCmd reset
  .f1.b1 configure -state disabled
  .f1.b2 configure -state disabled
  .f1.b3 configure -state disabled
  .f1.b4 configure -state disabled
  .f1.b5 configure -state disabled


  # make a toplevel icon window, iconwindow doesn't have transparent bg :-(
  catch {destroy .icont}
  toplevel .icont
  pack [label .icont.i -image iconfn]

  # create toplevel tournament window
  catch {destroy .tourn}
  toplevel .tourn
  wm title .tourn "Tournament Controller"
  wm iconwindow .tourn .icont
  wm iconname .tourn "TclRobots Tourney"
  wm group .tourn .
  wm group . .tourn 
  wm protocol .tourn WM_DELETE_WINDOW "catch {.tourn.f1.end invoke}"
  set i 3
  set dot_geom [winfo geom .]
  set dot_geom [split $dot_geom +]
  set dot_x [lindex $dot_geom 1]
  set dot_y [lindex $dot_geom 2]
  set winx [expr $dot_x+540]
  set winy [expr $dot_y+(($i-1)*145)]
  wm geom .tourn +${winx}+$winy
  wm minsize .tourn 220 180
  frame .tourn.f1 -relief raised -borderwidth 2
  button .tourn.f1.start -text " Start Tournament " -command do_tourn
  button .tourn.f1.end -text " Close  " \
     -command "set halted 1; clean_up; reset; destroy .tourn"
  pack .tourn.f1.start .tourn.f1.end -expand 1 -side left -pady 5 -padx 1

  frame .tourn.f2 -relief raised -borderwidth 2
  label .tourn.f2.l1 -text "Maximum minutes per match:" -anchor e -width 25
  entry .tourn.f2.t -width 5 -textvariable tlimit -width 5 -relief sunken
  pack  .tourn.f2.l1 .tourn.f2.t -side left -pady 5 -padx 1
  # override binding for Any-Keypress, but save others
  foreach e {.tourn.f2.t} {
    set cur_bind [bind Entry]
    foreach c $cur_bind {
      bind $e $c "[bind Entry $c] ; return -code break"
    }
    bind $e <KeyPress> {num_only %W %A}
  }
 
  frame .tourn.f3 -relief raised -borderwidth 2
  label .tourn.f3.l2 -text "Optional results filename:"  -anchor e -width 25
  entry .tourn.f3.f -width 5 -textvariable outfile -width 14 -relief sunken
  pack  .tourn.f3.l2 .tourn.f3.f -side left -pady 5 -padx 1


  frame .tourn.f4 
  label .tourn.f4.l -text "" -relief raised -borderwidth 2
  label .tourn.f4.lb -text Results -relief raised -borderwidth 2
  listbox .tourn.f4.lst -yscrollcommand ".tourn.f4.scr set" \
                        -xscrollcommand ".tourn.f4.scx set" \
                        -relief sunken
  scrollbar .tourn.f4.scr -command ".tourn.f4.lst yview"
  scrollbar .tourn.f4.scx -command ".tourn.f4.lst xview" -orient horizontal
  pack .tourn.f4.l -side top -fill x
  pack .tourn.f4.lb -side top -fill x
  pack .tourn.f4.scr -side right -fill y
  pack .tourn.f4.scx -side bottom -fill x
  pack .tourn.f4.lst -side left -fill both -expand 1

  pack .tourn.f1 .tourn.f2  .tourn.f3 .tourn.f4 -side top -fill x

}

# standard tk_dialog modified to use -image on label

proc tk_dialog2 {w title text bitmap default args} {
    global nowin
    global tkPriv

    if {$nowin} return

    # 1. Create the top-level window and divide it into top
    # and bottom parts.

    catch {destroy $w}
    toplevel $w -class Dialog
    wm title $w $title
    wm iconname $w Dialog
    wm protocol $w WM_DELETE_WINDOW { }
    wm transient $w [winfo toplevel [winfo parent $w]]
    frame $w.top -relief raised -bd 1
    pack $w.top -side top -fill both
    frame $w.bot -relief raised -bd 1
    pack $w.bot -side bottom -fill both

    # 2. Fill the top part with bitmap and message.

    label $w.msg -wraplength 3i -justify left -text $text  
    pack $w.msg -in $w.top -side right -expand 1 -fill both -padx 3m -pady 3m
    if {$bitmap != ""} {
        if {[llength $bitmap] > 1} { 
          switch -- [lindex $bitmap 0] {
	    -image {set type -image; set bitmap [lindex $bitmap 1]}
	    -bitmap {set type -bitmap; set bitmap [lindex $bitmap 1]}
	    default {set type -bitmap; set bitmap [lindex $bitmap 1]}
	  }
        } else {
          set type -bitmap
        }
	label $w.bitmap $type $bitmap
	pack $w.bitmap -in $w.top -side left -padx 3m -pady 3m
    }

    # 3. Create a row of buttons at the bottom of the dialog.

    set i 0
    foreach but $args {
	button $w.button$i -text $but -command "set tkPriv(button) $i"
	if {$i == $default} {
	    frame $w.default -relief sunken -bd 1
	    raise $w.button$i $w.default
	    pack $w.default -in $w.bot -side left -expand 1 -padx 3m -pady 2m
	    pack $w.button$i -in $w.default -padx 2m -pady 2m
	    bind $w <Return> "$w.button$i flash; set tkPriv(button) $i"
	} else {
	    pack $w.button$i -in $w.bot -side left -expand 1  -padx 3m -pady 2m
	}
	incr i
    }

    # 4. Withdraw the window, then update all the geometry information
    # so we know how big it wants to be, then center the window in the
    # display and de-iconify it.

    wm withdraw $w
    update idletasks
    set x [expr [winfo screenwidth $w]/2 - [winfo reqwidth $w]/2  - [winfo vrootx [winfo parent $w]]]
    set y [expr [winfo screenheight $w]/2 - [winfo reqheight $w]/2  - [winfo vrooty [winfo parent $w]]]
    wm geom $w +$x+$y
    wm deiconify $w

    # 5. Set a grab and claim the focus too.

    set oldFocus [focus]
    set oldGrab [grab current $w]
    if {$oldGrab != ""} {
	set grabStatus [grab status $oldGrab]
    }
    grab $w
    tkwait visibility $w
    if {$default >= 0} {
	focus $w.button$default
    } else {
	focus $w
    }

    # 6. Wait for the user to respond, then restore the focus and
    # return the index of the selected button.  Restore the focus
    # before deleting the window, since otherwise the window manager
    # may take the focus away so we can't redirect it.  Finally,
    # restore any grab that was in effect.

    tkwait variable tkPriv(button)
    catch {focus $oldFocus}
    destroy $w
    if {$oldGrab != ""} {
	if {$grabStatus == "global"} {
	    grab -global $oldGrab
	} else {
	    grab $oldGrab
	}
    }
    return $tkPriv(button)
}


#############################################################################
# do it!
# main line code

# check for command line args, run tournament if any 

set nowin 0
set arg_tlimit  10
set arg_outfile "results.out"
set arg_files   ""
set tourn_type  0

while {[llength $argv] > 0} {
  set arg  [lindex $argv 0]
  set argv [lrange $argv 1 end]
  switch -glob -- $arg  {
    -t* {
      set arg [string range $arg 2 end]
      if {[string length $arg] == 0 && [llength $argv] > 0} {
        set arg  [lindex $argv 0]
        set argv [lrange $argv 1 end]
      }
      if {[catch {expr "$arg+0 == $arg"}] == 0} {
        set tourn_type 1
        set arg_tlimit $arg
      }
    }
    -o* {
      set arg [string range $arg 2 end]
      if {[string length $arg] == 0 && [llength $argv] > 0} {
        set arg  [lindex $argv 0]
        set argv [lrange $argv 1 end]
      }
      if {[string length $arg] > 0} {
        set arg_outfile $arg
      }
    }
    -nowin {
        set nowin 1
    }
    default {
      if {[file isfile [pwd]/$arg]} {
        lappend arg_files [pwd]/$arg
      } else {
        puts "'$arg' not found, skipping"
      }
    }
  }
}

# check for tournament, two or more files on command line
if {[llength $arg_files] >= 2} {
  # if not a one-on-one and 2 or more files, set battle match
  if {$tourn_type == 0} {
    set tourn_type 4
  }
  wm geom . +20+20
  if {$nowin} {
    wm withdraw .
    # if -nowin, then speed up game by factor of 5
    set parms(tick)    [expr $parms(tick)/5]
    set parms(do_wait) [expr $parms(do_wait)/5]
    # and don't bother drawing on canvas or updating robot damage
    proc show_scan {args} {}
    proc show_robots {args} {}
    proc show_explode {args} {}
    proc up_damage {args} {}
  }
  main_win
  update
  foreach f $arg_files {
    .f2.fr.l1 insert end $f
  }
  set numList [llength $arg_files]
  set tlimit $arg_tlimit
  set outfile $arg_outfile
  switch $tourn_type {
    1 {
      tournament
      if {$nowin} {wm withdraw .tourn}
      update
      do_tourn
    }
    4 {
      start
    }
    default {
    }
  }
  clean_up
  update
  destroy .
} else {
  # no files for tourny, run interactive
  set nowin      0
  set tourn_type 0
  main_win
}

# finis