#!/bin/sh
# This grossness allows wish to be anywhere in PATH: \
exec wish "$0" -- ${1+"$@"}

# toysoldier 3.0.0 (Tue 19 May 1998)
# Adam M. Costello <amc@cs.berkeley.edu>

# Simulates a solution to the toy soldiers problem, showing the state
# bits and the gun output.

proc usage {} {
  global argv0
  puts stderr "usage:"
  puts stderr "$argv0 \[ -n <numsoldiers> \] \[ -p <period-in-ms> \]"
  exit 1
}


# Global constants:

set states {fl fr tl0 tr0 tl1 tr1 tl2 tr2 b g}
set color(0) white
set color(1) black
set color(2) red
set color(bg) lightgray
set bitwidth 6
set bitheight 9
set soldierborder 1
set bitborder 1

# Global variables:

# S($i,$state) is 0 or 1.
# numsoldiers is the number of soldiers.

# Conceptually, soldiers are numbered sequentially from left to right,
# starting with 0.


# setup <i>
#
# Setup soldier <i>.  These must be called in order from 0 to
# <numsoldiers>.

proc setup {i} {
  global soldierborder bitborder color

  set w .soldier$i

  frame $w -borderwidth 0 -background $color(bg)
  pack $w -side left -expand 1 -fill both \
          -padx $soldierborder -pady $soldierborder

  set frameopts [list -borderwidth 0 -background $color(bg)]
  set packopts [list -expand 1 -fill both -padx $bitborder -pady $bitborder]

  eval [list frame $w.fr] $frameopts
  eval [list frame $w.fl] $frameopts
  eval [list pack $w.fr $w.fl -side top] $packopts
  eval [list frame $w.tr] $frameopts
  eval [list frame $w.tl] $frameopts
  pack $w.tr $w.tl -side top -expand 1 -fill both
  eval [list frame $w.b] $frameopts
  eval [list frame $w.g] $frameopts
  eval [list pack $w.b $w.g -side top] $packopts
  eval [list frame $w.tr0] $frameopts
  eval [list frame $w.tr1] $frameopts
  eval [list frame $w.tr2] $frameopts
  eval [list pack $w.tr2 $w.tr1 $w.tr0 -in $w.tr -side right] $packopts
  eval [list frame $w.tl0] $frameopts
  eval [list frame $w.tl1] $frameopts
  eval [list frame $w.tl2] $frameopts
  eval [list pack $w.tl2 $w.tl1 $w.tl0 -in $w.tl -side left] $packopts

  global S states
  foreach state $states { set S($i,$state) 0 }
}


# display <i>
#
# Update the display of soldier <i> to reflect its state.

proc display {i} {
  set w .soldier$i
  global S states color

  foreach state $states {
    $w.$state configure -background $color($S($i,$state))
  }
}


# compute <i>
#
# Compute the next state of soldier <i>.

proc compute {i} {
  global S numsoldiers

  if {$i > 0} {
    set j [expr {$i - 1}]
    set Ifl $S($j,fr)
    set Itl $S($j,tr2)
    set Ibl $S($j,b)
  } else {
    set Ifl 0
    set Itl 0
    set Ibl 1
  }

  if {$i < $numsoldiers - 1} {
    set j [expr {$i + 1}]
    set Ifr $S($j,fl)
    set Itr $S($j,tl2)
    set Ibr $S($j,b)
  } else {
    set Ifr 0
    set Itr 0
    set Ibr 1
  }

  set Sfl  $S($i,fl)
  set Sfr  $S($i,fr)
  set Stl0 $S($i,tl0)
  set Str0 $S($i,tr0)
  set Stl1 $S($i,tl1)
  set Str1 $S($i,tr1)
  set Stl2 $S($i,tl2)
  set Str2 $S($i,tr2)
  set Sb   $S($i,b)
  set x [expr { $Ifl && ($Stl0 || $Stl2)  ||  $Ifr && ($Str0 || $Str2)  ||
                $Sfl && $Itl  ||  $Sfr && $Itr }]

  set S($i,fl')  [expr { $Sb  ?  $Ifl  :  $Ifr || $x }]
  set S($i,fr')  [expr { $Sb  ?  $Ifr  :  $Ifl || $x }]
  set S($i,tl0') $Itr
  set S($i,tr0') $Itl
  set S($i,tl1') [expr { !$Sb && ($Stl0 || $x) }]
  set S($i,tr1') [expr { !$Sb && ($Str0 || $x) }]
  set S($i,tl2') $Stl1
  set S($i,tr2') $Str1
  set S($i,b')   [expr { $Sb || $x }]
  set S($i,g')   [expr { ($Sb && $Ibl && $Ibr) * 2 }]
  # The multiplication by 2 is a hack to get a different on color.
}


# advance <i>
#
# Advance soldier <i> to its next state, which must have been computed
# already.

proc advance {i} {
  global S states numsoldiers
  foreach state $states { set S($i,$state) $S($i,$state') }
}


# allsoldiers <action>
#
# Calls <action> for each soldier.

proc allsoldiers {action} {
  global numsoldiers
  for {set i 0} {$i < $numsoldiers} {incr i} { $action $i }
}


# cycle
#
# Performs a compute, advance, display, wait cycle.

proc cycle {} {
  global period
  allsoldiers compute
  allsoldiers advance
  allsoldiers display
  update
  after $period
}


###########
# Main loop

set numsoldiers 23
set period 200
set args $argv

while {[llength $args] > 0} {
  switch -- [lindex $args 0] {
    -n { set args [lrange $args 1 end]; set numsoldiers [lindex $args 0] }
    -p { set args [lrange $args 1 end]; set period [lindex $args 0] }
    default { usage }
  }

  set args [lrange $args 1 end]
}

if {$numsoldiers < 2} {
  puts stderr "There must be at least two soldiers."
  exit 1
}

set width [expr {
  (3 * $bitwidth + 6 * $bitborder + 2 * $soldierborder) * $numsoldiers }]
set height [expr { ($bitheight + 2 * $bitborder) * 6 + 2 * $soldierborder }]
wm geometry . ${width}x$height
. configure -background $color(bg)

allsoldiers setup
set j [expr {$numsoldiers - 1}]
set S(0,b) 1
set S($j,b) 1
allsoldiers display
after $period

for {set i 5} {$i > 0} {incr i -1} { cycle }
set S(0,fr) 1
set S(0,tr1) 1
set time 0

while {!$S(0,g)} {
  cycle
  incr time
}

puts "elapsed time: $time ticks"