#!/usr/local/bin/wish -f
set wishexec wish

# TclRobots
# Copyright 1994 Tom Poindexter
# tpoind@advtech.uswest.com or tpoindex@nyx.cs.du.edu
#
# version 1.0
#

global rob1 rob2 rob3 rob4 c_tab s_tab parms 
global running halted ticks maxticks execCmd numList tlimit iconfn

# 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(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)] 
				;# missle reload time in ticks
set parms(lreload)	[expr $parms(mreload)*3]
				;# missle long reload time after clip
set parms(clip)		4	;# number of missles 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(dia1)		10	;# diameter of maximum missle damage
set parms(dia2)		20	;#     "    "  medium    "      "
set parms(dia3)		30	;#     "    "  minimum   "      "   
set parms(hit1)		10	;# %damage within range 1
set parms(hit2)		5	;#    "       "     "   2
set parms(hit3)		2	;#    "       "     "   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(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 {[tk colormodel .]=="color" } {
  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

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

}

# execute these commands on tclrobot startup
set setup {

  # setup windows, .l for file name
  frame .f
  canvas .f.c -width 20 -height 20 
  label .f.l -relief sunken -width 30  -text "(loading robot code..)" 
  pack .f.c -side left
  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} {
    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 {}}
  }

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

  # our own tkerror proc
  proc tkerror {args} {
    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
  upvar #0 $robx r

  set name [file tail $fn]

  # generate a new send command
  set newsig     [rand 65535]
  set newdestroy _d_$newsig
  set newafter   _a_$newsig
  set newsend    _s_$newsig
  set newtkwait  _t_$newsig
  set newupdate  _u_$newsig
  set newexit    _e_$newsig
  set ourname    [winfo name .]

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

  set r(name)   ${name}_$newsig	;# window name = source.file_randnumber
  set r(num)    $newsig 	;# the rand number
  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

  # startup a new wish with specified name
  
  catch { [exec $wishexec -geom 180x110+$winx+$winy -name $r(name) \
                        </dev/null >/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
  }

  # 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(num) 100 {set _start_ 1}"
    }
  }
}


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

proc disable_robot {robx} {
  upvar #0 $robx r
  # break the remote tcl interpreter 
  catch {send $r(name) \
    "_a_$r(num) 1 \".d.l insert end disabled;_u_$r(num);_t_$r(num) window .\""}
  update
}


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

proc kill_robot {robx} {
  upvar #0 $robx r
  catch {send $r(name)  "rename _s_$r(num) send" }
  catch {send $r(name)  _a_$r(num) 200 "_u_$r(num);_d_$r(num) ." }
  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
  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(dia1)} {
	      incr rr(damage) $parms(hit1)
	    } elseif {$d<$parms(dia2)} {
	      incr rr(damage) $parms(hit2)
	    } else {
	      incr rr(damage) $parms(hit3)
	    }
	   .fd.$robrx configure -text $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 }
      }
    }

    # 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)
	.fd.$robx configure -text $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)
	.fd.$robx configure -text $r(damage)%
      }
    }
  }

  # check for robot health
  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
        .fd.$robx configure -text \
	   [lindex {"garbage" "dead" "toast" "scrap" "wasted" "junk"} \
	   [rand 5]]
	disable_robot $robx
      } else {
	incr num_rob
      }
    }
  }

  if {$num_rob<=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} {
  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 line $x $y \
      [expr $x+($c_tab($deg)*800)] [expr $y-($s_tab($deg)*800)] \
      -fill $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-2.5] [expr $y-2.5] [expr $x+2.5] [expr $y+2.5] \
	-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-2.5] [expr $y-2.5] [expr $x+2.5] [expr $y+2.5] \
	-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"
  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 ? 10 : 0) + [rand $derr]]
        set fud  [expr [rand 2]==0 ? \"-\" : \"+\"]
	set near [expr $dist $fud $terr]
	if {$near<0} {set near 0} 
	set dsp  $rob(num)
	set dmg  $rob(damage)
      }
    }
  }
  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(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)"
}



##############################################################################
#
# 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} {
 upvar #0 $robx r
 global wishexec
 if {$r(pid) > 0} {
   # bad send text
   mkDialog .oops! "-aspect 200 -text \"Couldn't find or send to a new wish,\
    bailing out!\n\n\
    Is your X server configured for xauth style security?\n\n\
    TclRobots uses the Tk 'send' command, which requires that xhost\
    security not be used.  Use xauth if possible.\n\n\
    Alternatively,  re-compile the wish\n\
    executable '$wishexec' with '-DTK_NO_SECURITY' flag.\n\\n\
    \"" {OK {}}
  
  } else {
    # bad wish exec
   mkDialog .oops! "-aspect 200 -text \"Couldn't start a new wish,\
    bailing out!\n\n\
    TclRobots is expecting '$wishexec' as the name of the wish executable.\n\
    Is it in your PATH?\n\
    \"" {OK {}}
  
  }
}

###############################################################################
#
# 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
    }
  }
  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
  foreach robx {rob1 rob2 rob3 rob4} {
    .fs.$robx configure -text ""
    .fd.$robx configure -text ""
  }
  .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
}


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

  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
    .fs.$robx configure  -text ""
    .fd.$robx configure  -text ""
  }

  # 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)*140)]

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

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

    .fs.rob$i configure -text [file tail $f] -fg $color
    .fd.rob$i configure -text "0%"

    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

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

  # find winnner
  if {$halted} {
    .l configure -text "Battle halted"
  } else {
    set alive 0
    set winner ""
    set win_color black
    foreach robx {rob1 rob2 rob3 rob4} {
      upvar #0 $robx r
      if {$r(status)} {
	incr alive
	lappend winner $r(name)
	set win_color $r(color)
      }
    }
    switch $alive {
      0 { 
	.l configure -text "No robots left alive"
      }
      1 {
	.l configure -text "$winner wins!" -fg $win_color
      }
      default {
	.l configure -text "Tie: $winner"
      }
    }
  }

  set execCmd reset
  .f1.b1 configure -state normal -text "Reset"

}


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

proc about {} {
  global iconfn
  mkDialog .about_TclRobots {-aspect 1000 -text "\
     TclRobots\n\
     Copyright 1994  Tom Poindexter\n\n\
     tpoind@advtech.uswest.com\n\
     tpoindex@nyx.cs.du.edu\n\n\
     Version 1.0   August, 1994\n\n\
     "} {OK {}}
  .about_TclRobots.bot.0.button config -bitmap @$iconfn

}

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

proc main_win {} {

  global execCmd numList iconfn parms

  # make a temp file to hold 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};
}

  set iconfn /tmp/tr.[pid]
  exec echo $tr_icon > $iconfn

  set numList 0
  set execCmd start
  set me [winfo name .]
  if {$parms(cmodel)} {
    option add $me*background        gray80
    option add $me*activeBackground  gray90
    option add $me*Scrollbar*Foreground  gray80
    option add $me*Scrollbar*activeForeground  gray90
  }
  wm title . "TclRobots"
  wm iconbitmap . @$iconfn
  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; \
			     exec rm -f $iconfn; 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 .fs 
  label .fs.rob1 -relief sunken -width 15
  label .fs.rob2 -relief sunken -width 15
  label .fs.rob3 -relief sunken -width 15
  label .fs.rob4 -relief sunken -width 15
  pack .fs.rob1 .fs.rob2 .fs.rob3 .fs.rob4 -side left -expand 1 -fill both
  frame .fd -relief raised
  label .fd.rob1 -relief sunken -width 15
  label .fd.rob2 -relief sunken -width 15
  label .fd.rob3 -relief sunken -width 15
  label .fd.rob4 -relief sunken -width 15
  pack .fd.rob1 .fd.rob2 .fd.rob3 .fd.rob4 -side left -expand 1 -fill both

  frame .f2 -width 500 -height 500 
  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"
  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
  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
  tk_listboxSingleSelect .f2.fr.l1

  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 .fs .fd  -side top -fill both
  pack .f2 -side top -expand 1 -fill both
  
  wm geom . 520x608
  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 view $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" \
	    -relief sunken
  
  label $win.l3   -text "Selection" -anchor w
  scrollbar $win.scrl -orient horizontal -relief sunken \
                      -command "$win.sel view"
  entry $win.sel  -relief sunken -scroll "$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"
  tk_listboxSingleSelect $win.l.lst
  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"
  bind $win <ButtonRelease-1> \
	"$win.o.ok invoke ; $win.o.ok deactivate"
  bind $win <Return> "$win.o.ok invoke "
  bind $win.o <Enter> "$win.o.ok activate"
  bind $win.o <Leave> "$win.o.ok deactivate"


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

}

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


###########################################################################
#
# stolen from ousterhout's widget demo
#


# mkDialog w msgArgs list list ...
#
# Create a dialog box with a message and any number of buttons at
# the bottom.
#
# Arguments:
#    w -	Name to use for new top-level window.
#    msgArgs -	List of arguments to use when creating the message of the
#		dialog box (e.g. text, justifcation, etc.)
#    list -	A two-element list that describes one of the buttons that
#		will appear at the bottom of the dialog.  The first element
#		gives the text to be displayed in the button and the second
#		gives the command to be invoked when the button is invoked.

proc mkDialog {w msgArgs args} {
  set win_title $w
  regsub -all {_} $win_title " " win_title
  
  catch {destroy $w}
  toplevel $w -class Dialog
  wm transient $w .
  set xpos [expr [winfo rootx .]+[winfo width .]/3]
  set ypos [expr [winfo rooty .]+[winfo height .]/3]
  wm geom $w +${xpos}+$ypos

  wm title $w [string range $win_title 1 end]

    # Create two frames in the main window. The top frame will hold the
    # message and the bottom one will hold the buttons.  Arrange them
    # one above the other, with any extra vertical space split between
    # them.

    frame $w.top -relief raised -border 1
    frame $w.bot -relief raised -border 1
    pack $w.top $w.bot -side top -fill both -expand 1
    
    # Create the message widget and arrange for it to be centered in the
    # top frame.
    
    eval message $w.top.msg -justify center \
	    -font -*-times-medium-r-normal--*-180* $msgArgs
    pack $w.top.msg -side top -expand 1 -padx 5 -pady 5
    
    # Create as many buttons as needed and arrange them from left to right
    # in the bottom frame.  Embed the left button in an additional sunken
    # frame to indicate that it is the default button, and arrange for that
    # button to be invoked as the default action for clicks and returns in
    # the dialog.

    if {[llength $args] > 0} {
	set arg [lindex $args 0]
	frame $w.bot.0 -relief sunken -border 1
	pack $w.bot.0 -side left -expand 1 -padx 20 -pady 20
	button $w.bot.0.button -text [lindex $arg 0] \
		-command "[lindex $arg 1]; destroy $w"
	pack $w.bot.0.button -expand 1 -padx 12 -pady 12
	bind $w.top <Enter> "$w.bot.0.button activate"
	bind $w.top.msg <Enter> "$w.bot.0.button activate"
	bind $w.bot <Enter> "$w.bot.0.button activate"
	bind $w.top <Leave> "$w.bot.0.button deactivate"
	bind $w.top.msg <Leave> "$w.bot.0.button deactivate"
	bind $w.bot <Leave> "$w.bot.0.button deactivate"
	bind $w <1> "$w.bot.0.button config -relief sunken"
	bind $w <ButtonRelease-1> \
		"[lindex $arg 1]; $w.bot.0.button deactivate; destroy $w"
	bind $w <Return> "[lindex $arg 1]; destroy $w"
	focus $w

	set i 1
	foreach arg [lrange $args 1 end] {
	    button $w.bot.$i -text [lindex $arg 0] \
		    -command "[lindex $arg 1]; destroy $w"
	    pack $w.bot.$i -side left -expand 1 -padx 20
	    set i [expr $i+1]
	}
    }
}


###############################################################################
#
# 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
  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 gray80
    } else {
      .debug.f2.h configure -bg white -fg black
    }
  }
}


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

proc num_only {char win} {
    if {[regexp {[0123456789]} "$char"]} {
        $win insert insert $char
        tk_entrySeeCaret $win 
    }
}


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

  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
    .fs.$robx configure  -text ""
    .fd.$robx configure  -text ""
  }

  # 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)*140)]

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

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

  .fs.rob1 configure -text [file tail $f] -fg $color
  .fd.rob1 configure -text "0%"
  .fs.rob2 configure -text target -fg black
  .fd.rob2 configure -text "0%"


  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

  # start physics package
  show_robots
  set running 1

  # create toplevel simulator debug window
  set step 1
  catch {destroy .debug}
  toplevel .debug
  wm title .debug "Simulator Probe"
  wm iconbitmap .debug @$iconfn
  wm iconname .debug TclRobots
  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)*140)]
  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
  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 5

  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

  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
  pack .debug.f3.l1 .debug.f3.s .debug.f3.l3 .debug.f3.t \
       -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]
    }
    bind $e <Any-KeyPress> {num_only %A %W}
  }

  # 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
  foreach robx {rob1 rob2 rob3 rob4} {
    .fs.$robx configure -text ""
    .fd.$robx configure -text ""
  }
  .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
  }
}  


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

proc check_time {} {
  global ticks maxticks running
  if {$ticks > $maxticks} {set running 0; 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

  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
	.fs.$robx configure  -text ""
	.fd.$robx configure  -text ""
      }

      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)*140)]

	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
	}

	.fs.rob$i configure -text [file tail $f] -fg $color
	.fd.rob$i configure -text "0%"

	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(tick)/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
	}
	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 {exec cat -s >>$outfile <<$results}
    catch {exec cat -s >>$outfile <<$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 iconfn

  set running 0
  set halted  0
  set ticks   0
  set tlimit  10
  set outfile ""
  .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


  # create toplevel tournament window
  catch {destroy .tourn}
  toplevel .tourn
  wm title .tourn "Tournament Controller"
  wm iconbitmap .tourn @$iconfn
  wm iconname .tourn TclRobots
  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)*140)]
  wm geom .tourn +${winx}+$winy
  wm minsize .tourn 220 200
  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]
    }
    bind $e <Any-KeyPress> {num_only %A %W}
  }
 
  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" -relief sunken
  scrollbar .tourn.f4.scr -command ".tourn.f4.lst yview"
  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.lst -side left -fill both -expand 1

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

}


# do it!

# check for command line args, run tournament if any 

set arg_tlimit  10
set arg_outfile "results.out"
set arg_files   ""
while {[llength $argv] > 0} {
  set arg  [lindex $argv 0]
  set argv [lrange $argv 1 end]
  switch -exact -- $arg  {
    -t {
      if {[llength $argv] > 0} {
        set arg  [lindex $argv 0]
        set argv [lrange $argv 1 end]
        if {[catch {expr "$arg+0 == $arg"}] == 0} {
          set arg_tlimit $arg
        }
      }
    }
    -o {
      if {[llength $argv] > 0} {
        set arg  [lindex $argv 0]
        set argv [lrange $argv 1 end]
        set arg_outfile $arg
      }
    }
    default {
      if {[file isfile [pwd]/$arg]} {
        lappend arg_files [pwd]/$arg
      }
    }
  }

}

if {[llength $arg_files] >= 2} {
  wm geom . +20+20
  main_win
  update
  foreach f $arg_files {
    .f2.fr.l1 insert end $f
  }
  tournament
  set numList [llength $arg_files]
  set tlimit $arg_tlimit
  set outfile $arg_outfile
  update
  do_tourn
  clean_up
  update
  destroy .
} else {
  # no files for tourny, run interactive
  main_win
}

# finis
