#!/bin/sh
# This is a shell archive, meaning:
# 1. Remove everything above the #!/bin/sh line.
# 2. Save the resulting text in a file.
# 3. Execute the file with /bin/sh (not csh) to create the files:
#	.
# This archive created: Thu Oct 14 11:27:30 1993
export PATH; PATH=/bin:$PATH
echo shar: extracting "'ToDo'" '(19 characters)'
if test -f 'ToDo'
then
	echo shar: over-writing existing file "'ToDo'"
fi
cat << \SHAR_EOF > 'ToDo'
Reset high scores?
SHAR_EOF
echo shar: extracting "'Changes'" '(850 characters)'
if test -f 'Changes'
then
	echo shar: over-writing existing file "'Changes'"
fi
cat << \SHAR_EOF > 'Changes'
New in Release 1.5:
-------------------
Now works with tcl 7.0

New in Release 1.4:
-------------------
Max height reduced by one (to deal with big window borders)
Can now enter name in high-score list explicitly

New in Release 1.3:
-------------------
Fix for menu compatibility with Tk version 3.0

New in Release 1.2:
-------------------
High score list

Redone "custom" board size intfce


New in Release 1.1:
-------------------
Faster resizing & board creation

Lazy evaluation of neighbor counts (gradually counts mines at neighbor
squares, unless immediate evaluation is called for)

Gripe facility

Debugging facilities for performance profiling

Test for extended TCL before assuming it's there

Better arg-parsing: width, height, mines

Monochrome support

Max board-size: fills the screen

Accurate message in README as to tclX location
SHAR_EOF
if test ! -d 'bitmaps'
then
	echo shar: creating directory "'bitmaps'"
	mkdir 'bitmaps'
fi
echo shar: entering directory "'bitmaps'"
cd 'bitmaps'
echo shar: extracting "'empty'" '(278 characters)'
if test -f 'empty'
then
	echo shar: over-writing existing file "'empty'"
fi
cat << \SHAR_EOF > 'empty'
#define empty_width 16
#define empty_height 16
static char empty_bits[] = {
   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00};
SHAR_EOF
echo shar: extracting "'1'" '(266 characters)'
if test -f '1'
then
	echo shar: over-writing existing file "'1'"
fi
cat << \SHAR_EOF > '1'
#define 1_width 16
#define 1_height 16
static char 1_bits[] = {
   0x00, 0x00, 0x80, 0x01, 0x80, 0x01, 0x80, 0x01, 0x80, 0x01, 0x80, 0x01,
   0x80, 0x01, 0x80, 0x01, 0x80, 0x01, 0x80, 0x01, 0x80, 0x01, 0x80, 0x01,
   0x80, 0x01, 0x80, 0x01, 0x80, 0x01, 0x00, 0x00};
SHAR_EOF
echo shar: extracting "'2'" '(266 characters)'
if test -f '2'
then
	echo shar: over-writing existing file "'2'"
fi
cat << \SHAR_EOF > '2'
#define 2_width 16
#define 2_height 16
static char 2_bits[] = {
   0x00, 0x00, 0xfc, 0x3f, 0xfc, 0x3f, 0x00, 0x30, 0x00, 0x30, 0x00, 0x30,
   0x00, 0x30, 0xfc, 0x3f, 0xfc, 0x3f, 0x0c, 0x00, 0x0c, 0x00, 0x0c, 0x00,
   0x0c, 0x00, 0xfc, 0x3f, 0xfc, 0x3f, 0x00, 0x00};
SHAR_EOF
echo shar: extracting "'3'" '(266 characters)'
if test -f '3'
then
	echo shar: over-writing existing file "'3'"
fi
cat << \SHAR_EOF > '3'
#define 3_width 16
#define 3_height 16
static char 3_bits[] = {
   0x00, 0x00, 0xfc, 0x3f, 0xfc, 0x3f, 0x00, 0x30, 0x00, 0x30, 0x00, 0x30,
   0x00, 0x30, 0xfc, 0x3f, 0xfc, 0x3f, 0x00, 0x30, 0x00, 0x30, 0x00, 0x30,
   0x00, 0x30, 0xfc, 0x3f, 0xfc, 0x3f, 0x00, 0x00};
SHAR_EOF
echo shar: extracting "'5'" '(266 characters)'
if test -f '5'
then
	echo shar: over-writing existing file "'5'"
fi
cat << \SHAR_EOF > '5'
#define 5_width 16
#define 5_height 16
static char 5_bits[] = {
   0x00, 0x00, 0xfc, 0x3f, 0xfc, 0x3f, 0x0c, 0x00, 0x0c, 0x00, 0x0c, 0x00,
   0x0c, 0x00, 0xfc, 0x3f, 0xfc, 0x3f, 0x00, 0x30, 0x00, 0x30, 0x00, 0x30,
   0x00, 0x30, 0xfc, 0x3f, 0xfc, 0x3f, 0x00, 0x00};
SHAR_EOF
echo shar: extracting "'4'" '(266 characters)'
if test -f '4'
then
	echo shar: over-writing existing file "'4'"
fi
cat << \SHAR_EOF > '4'
#define 4_width 16
#define 4_height 16
static char 4_bits[] = {
   0x00, 0x00, 0x0c, 0x30, 0x0c, 0x30, 0x0c, 0x30, 0x0c, 0x30, 0x0c, 0x30,
   0x0c, 0x30, 0xfc, 0x3f, 0xfc, 0x3f, 0x00, 0x30, 0x00, 0x30, 0x00, 0x30,
   0x00, 0x30, 0x00, 0x30, 0x00, 0x30, 0x00, 0x00};
SHAR_EOF
echo shar: extracting "'6'" '(266 characters)'
if test -f '6'
then
	echo shar: over-writing existing file "'6'"
fi
cat << \SHAR_EOF > '6'
#define 6_width 16
#define 6_height 16
static char 6_bits[] = {
   0x00, 0x00, 0xfc, 0x3f, 0xfc, 0x3f, 0x0c, 0x00, 0x0c, 0x00, 0x0c, 0x00,
   0x0c, 0x00, 0xfc, 0x3f, 0xfc, 0x3f, 0x0c, 0x30, 0x0c, 0x30, 0x0c, 0x30,
   0x0c, 0x30, 0xfc, 0x3f, 0xfc, 0x3f, 0x00, 0x00};
SHAR_EOF
echo shar: extracting "'8'" '(266 characters)'
if test -f '8'
then
	echo shar: over-writing existing file "'8'"
fi
cat << \SHAR_EOF > '8'
#define 8_width 16
#define 8_height 16
static char 8_bits[] = {
   0x00, 0x00, 0xfc, 0x3f, 0xfc, 0x3f, 0x0c, 0x30, 0x0c, 0x30, 0x0c, 0x30,
   0x0c, 0x30, 0xfc, 0x3f, 0xfc, 0x3f, 0x0c, 0x30, 0x0c, 0x30, 0x0c, 0x30,
   0x0c, 0x30, 0xfc, 0x3f, 0xfc, 0x3f, 0x00, 0x00};
SHAR_EOF
echo shar: extracting "'7'" '(266 characters)'
if test -f '7'
then
	echo shar: over-writing existing file "'7'"
fi
cat << \SHAR_EOF > '7'
#define 7_width 16
#define 7_height 16
static char 7_bits[] = {
   0x00, 0x00, 0xfc, 0x3f, 0xfc, 0x3f, 0x00, 0x30, 0x00, 0x30, 0x00, 0x30,
   0x00, 0x30, 0x00, 0x30, 0x00, 0x30, 0x00, 0x30, 0x00, 0x30, 0x00, 0x30,
   0x00, 0x30, 0x00, 0x30, 0x00, 0x30, 0x00, 0x00};
SHAR_EOF
echo shar: extracting "'0'" '(266 characters)'
if test -f '0'
then
	echo shar: over-writing existing file "'0'"
fi
cat << \SHAR_EOF > '0'
#define 0_width 16
#define 0_height 16
static char 0_bits[] = {
   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
   0x00, 0x00, 0x80, 0x01, 0x80, 0x01, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00};
SHAR_EOF
echo shar: extracting "'mark'" '(275 characters)'
if test -f 'mark'
then
	echo shar: over-writing existing file "'mark'"
fi
cat << \SHAR_EOF > 'mark'
#define mark_width 16
#define mark_height 16
static char mark_bits[] = {
   0x00, 0x00, 0xfc, 0x3f, 0xfc, 0x3f, 0x00, 0x30, 0x00, 0x30, 0x00, 0x30,
   0x00, 0x30, 0x80, 0x3f, 0x80, 0x3f, 0x80, 0x01, 0x80, 0x01, 0x00, 0x00,
   0x00, 0x00, 0x80, 0x01, 0x80, 0x01, 0x00, 0x00};
SHAR_EOF
echo shar: extracting "'mine'" '(275 characters)'
if test -f 'mine'
then
	echo shar: over-writing existing file "'mine'"
fi
cat << \SHAR_EOF > 'mine'
#define mine_width 16
#define mine_height 16
static char mine_bits[] = {
   0x00, 0x00, 0x00, 0x38, 0x00, 0x3e, 0x00, 0x33, 0xc0, 0x31, 0x60, 0x30,
   0x60, 0x30, 0xc0, 0x31, 0x00, 0x33, 0x00, 0x3e, 0x00, 0x38, 0x00, 0x30,
   0x00, 0x30, 0x00, 0x30, 0x00, 0x30, 0x00, 0x00};
SHAR_EOF
echo shar: extracting "'grey.25'" '(275 characters)'
if test -f 'grey.25'
then
	echo shar: over-writing existing file "'grey.25'"
fi
cat << \SHAR_EOF > 'grey.25'
#define grey_width 16
#define grey_height 16
static char grey_bits[] = {
   0x11, 0x11, 0x44, 0x44, 0x11, 0x11, 0x44, 0x44, 0x11, 0x11, 0x44, 0x44,
   0x11, 0x11, 0x44, 0x44, 0x11, 0x11, 0x44, 0x44, 0x11, 0x11, 0x44, 0x44,
   0x11, 0x11, 0x44, 0x44, 0x11, 0x11, 0x44, 0x44};
SHAR_EOF
echo shar: extracting "'unfoundMine'" '(296 characters)'
if test -f 'unfoundMine'
then
	echo shar: over-writing existing file "'unfoundMine'"
fi
cat << \SHAR_EOF > 'unfoundMine'
#define unfoundMine_width 16
#define unfoundMine_height 16
static char unfoundMine_bits[] = {
   0x00, 0x00, 0x00, 0x03, 0x80, 0x01, 0xe0, 0x03, 0x98, 0x0c, 0x84, 0x10,
   0x04, 0x10, 0x02, 0x20, 0x02, 0x20, 0x02, 0x20, 0x02, 0x20, 0x02, 0x20,
   0x04, 0x10, 0x04, 0x10, 0x18, 0x0c, 0xe0, 0x03};
SHAR_EOF
echo shar: extracting "'wrongMine'" '(290 characters)'
if test -f 'wrongMine'
then
	echo shar: over-writing existing file "'wrongMine'"
fi
cat << \SHAR_EOF > 'wrongMine'
#define wrongMine_width 16
#define wrongMine_height 16
static char wrongMine_bits[] = {
   0x03, 0xc0, 0x07, 0xf8, 0x0e, 0x7e, 0x1c, 0x3b, 0xd8, 0x39, 0x60, 0x34,
   0x60, 0x32, 0xc0, 0x31, 0x80, 0x33, 0x40, 0x3e, 0x20, 0x3c, 0x18, 0x38,
   0x1c, 0x38, 0x0e, 0x70, 0x07, 0xf0, 0x03, 0xc0};
SHAR_EOF
echo shar: extracting "'grey.5'" '(275 characters)'
if test -f 'grey.5'
then
	echo shar: over-writing existing file "'grey.5'"
fi
cat << \SHAR_EOF > 'grey.5'
#define grey_width 16
#define grey_height 16
static char grey_bits[] = {
   0x55, 0x55, 0xaa, 0xaa, 0x55, 0x55, 0xaa, 0xaa, 0x55, 0x55, 0xaa, 0xaa,
   0x55, 0x55, 0xaa, 0xaa, 0x55, 0x55, 0xaa, 0xaa, 0x55, 0x55, 0xaa, 0xaa,
   0x55, 0x55, 0xaa, 0xaa, 0x55, 0x55, 0xaa, 0xaa};
SHAR_EOF
echo shar: done with directory "'bitmaps'"
cd ..
echo shar: extracting "'README'" '(824 characters)'
if test -f 'README'
then
	echo shar: over-writing existing file "'README'"
fi
cat << \SHAR_EOF > 'README'
Welcome to tkmines! This program requires wish and extended Tcl,
available from sprite.berkeley.edu.

Feel free to send this to your friends. If you like it, please let me
know. If you hate it, please let me know. Please leave my name
attached somewhere if you pass it along.

To run:

edit the file "Make.config" to point to your copy of (EXTENDED) wish,
and to indicate where you want tkmines installed.

Then, just run the program:
> tkmines

See the file "help" in this directory for instructions.

Joel Fine
joel@cs.berkeley.edu

-----------------------------------------------------------------------
IF YOU DO NOT HAVE WISH AND EXTENDED TCL:
Anonymous ftp from sprite.berkeley.edu, directory "tcl": get
tk3.2.tar.Z, tcl6.7.tar.Z, tclX6.5c.tar.Z. Uncomress, untar, and
follow the instructions in the README's therein.
SHAR_EOF
echo shar: extracting "'help'" '(1842 characters)'
if test -f 'help'
then
	echo shar: over-writing existing file "'help'"
fi
cat << \SHAR_EOF > 'help'
Welcome to tkmines! In this game, you are a minefield inspector,
trying to identify the unsafe spots on a large grid. If you step on
a square with a bomb underneath, you lose the game. If, on the other
hand, the square you step on has no bomb beneath it, the number of
neighboring squares that DO have bombs is etched in the square.

You must identify all of the unmined squares in order to escape the
minefield. You can step on any unknown square at any time.

Press the left mouse button over a square to step on it. Use the
information revealed as you step on non-mined squares to deduce which
other squares have do have mines. If you believe that a particular
square has a mine, press the right mouse button over it to mark it
"mined." You are then safe from accidentally stepping on the square.
Of course, there is no guarantee that your guess is right!

You have an assistant who will help you step on several squares at
once, but he is very cautious. If you point out a "known" square (one
that you have already stepped on) to him, he will step on all of the
"non-mined" squares adjacent to the square you show him, under one
condition: that you have marked enough squares "mined" that you can
reasonably believe that none of the other neighbor squares are also
mined. You can ask him to do this by pressing the middle-mouse button
over any known square.

For example, if you middle-mouse over a square with a "1" in it, and
you have marked one of its neighbors with a mine-flag, your assistant
will step on all of the other squares around the "1." If your flag is
misplaced, though, then your assistant will probably blow you both up!

You can also mark a square with a "?" by pressing the right-mouse
button an extra time. The "?" has no effect, other than to help you
mark a square as a memory aid.

Good luck, and tread lightly.


SHAR_EOF
if test ! -d 'src'
then
	echo shar: creating directory "'src'"
	mkdir 'src'
fi
echo shar: entering directory "'src'"
cd 'src'
echo shar: extracting "'init.tcl'" '(797 characters)'
if test -f 'init.tcl'
then
	echo shar: over-writing existing file "'init.tcl'"
fi
cat << \SHAR_EOF > 'init.tcl'
set width 10
set height 10
set mines 0
set bugs 0
set buttonWidth 24
set buttonHeight 24
set username $env(USER)

proc minwidth {} {
  return 3
}

proc minheight {} {
  return 3
}

proc maxwidth {} {
  global buttonWidth
  set rslt [expr {[winfo screenwidth .] / $buttonWidth}]
  return $rslt
}

proc maxheight {} {
  global buttonHeight
  set rslt [expr {[winfo screenheight .] / $buttonHeight - 5}]
  return $rslt
}

proc stdmines {width height} {
  set std [toint [expr {($width * $height) * .15}]]
  if {$std < [minmines $width $height]} {
    set std [minmines $width $height]
  }
  return $std
}

proc minmines {width height} {
  return 2
}

proc maxmines {width height} {
  return [expr {$width * $height - 2}]
}

proc getBitmap {name} {
  global libDir
  return "@$libDir/bitmaps/$name"
}
SHAR_EOF
echo shar: extracting "'mines.tcl'" '(18682 characters)'
if test -f 'mines.tcl'
then
	echo shar: over-writing existing file "'mines.tcl'"
fi
cat << \SHAR_EOF > 'mines.tcl'
# $f is frame/top window (already created)
# $w is width
# $h is height
# $m is number of mines
proc makeBoard {f w h m} {
  global bugs scoreFile $f.width $f.height $f.mines $f.area $f.squareList
  set $f.width $w
  set $f.height $h
  set $f.mines $m
  set $f.area [expr {$w * $h}]
  set $f.squareList {}

  # Le menu
  frame $f.m
  menubutton $f.m.mb -text "Options" -menu $f.m.mb.m -relief raised
  button $f.m.help -text "Help" -command "helpMines"
  pack append $f.m $f.m.mb {left frame w} $f.m.help {right frame e}

  menu $f.m.mb.m
  $f.m.mb.m add command -label "Play Again" -command "askResetBoard $f"
  $f.m.mb.m add cascade -label "Resize" -menu $f.m.mb.mr
  $f.m.mb.m add command -label "Give Up" -command "askShowAll $f"
  $f.m.mb.m add command -label "About..." -command "aboutMines"
  $f.m.mb.m add command -label "Gripe..." -command "gripe tkmines"
  $f.m.mb.m add command -label "High Scores..." -command "showHighScores $scoreFile"
  $f.m.mb.m add command -label "Quit" -command "quit Mines"
  if {$bugs} {
    $f.m.mb.m add command -label "Profile" -command "printProfile"
  }

  menu $f.m.mb.mr
  $f.m.mb.mr add command -label "Small" -command "askResizeBoard $f small"
  $f.m.mb.mr add command -label "Medium" -command "askResizeBoard $f medium"
  $f.m.mb.mr add command -label "Big" -command "askResizeBoard $f big"
  $f.m.mb.mr add command -label "Max" -command "askResizeBoard $f max"
  $f.m.mb.mr add command -label "Custom..." -command "askResizeBoard $f custom"

  # Status stuff
  frame $f.st

  frame $f.st.m
  frame $f.st.t
  frame $f.st.r
  pack append $f.st $f.st.m {left frame w padx 20} $f.st.t {left frame e padx 20}
  #pack append $f.st.r {left frame e padx 20}

  # Mine counts
  frame $f.st.m.l
  frame $f.st.m.n
  pack append $f.st.m $f.st.m.l {left fillx} $f.st.m.n {left fillx}

  label $f.st.m.l.found -text "Mines found:"
  label $f.st.m.l.mines -text "Mines:"
  pack append $f.st.m.l $f.st.m.l.found {top frame w} $f.st.m.l.mines {top frame w}

  label $f.st.m.n.found -relief sunken -width 3
  label $f.st.m.n.mines -relief sunken -width 3
  pack append $f.st.m.n $f.st.m.n.found {top frame e} $f.st.m.n.mines {top frame e}

  # Time
  label $f.st.t.l -text "Time:"
  label $f.st.t.n -relief sunken -width 4
  pack append $f.st.t $f.st.t.l {left frame w} $f.st.t.n {left frame e}

  # Rank
  label $f.st.r.l -text "Rank:"
  label $f.st.r.n -relief sunken -width 2
  pack append $f.st.r $f.st.r.l {left frame w} $f.st.r.n {left frame e}

  # Buttons
  frame $f.b

  pack append $f $f.m {top fillx} $f.st {top pady 20} $f.b top

  #for {set row 0} {$row < $h} {incr row}
  loop row 0 $h {
    frame $f.b.$row
    pack append $f.b $f.b.$row top
    #for {set col 0} {$col < $w} {incr col}
    loop col 0 $w {
      button $f.b.$row.$col
      pack append $f.b.$row $f.b.$row.$col left
      lappend $f.squareList "$row $col"
      $f.b.$row.$col config -command "showSquare $f $row $col"
      bind $f.b.$row.$col <3> {eval markSquare [getSquare %W]}
      bind $f.b.$row.$col <2> {
        set testSquare [getSquare %W]
        eval sinkNeighbors $testSquare
      }
      bind $f.b.$row.$col <ButtonRelease-2> {
        if {$testSquare != {}} {
          eval testSquare $testSquare
        }
      }
      bind $f.b.$row.$col <B2-Leave> {
        eval raiseNeighbors [getSquare %W]
        set testSquare {}
      }
      #bind $f.b.$row.$col <Any-B2-Enter> {eval sinkNeighbors [getSquare %W]}
    }
  }
  global scoreFile
  readHighScores $scoreFile
  resetBoard $f
}

proc getSquare {w} {
  set l [split $w .]
  set len [llength $l]
  set f [join [lrange $l 0 [expr {$len - 4}]] .]
  set r [lindex $l [expr {$len - 2}]]
  set c [lindex $l [expr {$len - 1}]]
  return [list $f $r $c]
}

proc resetBoard {f} {
  global $f.height $f.width $f.mines $f.minesguessed $f.squaresknown
  global $f.done $f.started $f.lRow $f.lCol $f.visited
  busy
  set h [set $f.height]
  set w [set $f.width]
  set m [set $f.mines]
  #for {set row 0} {$row < $h} {incr row}
  loop row 0 $h {
    #for {set col 0} {$col < $w} {incr col}
    loop col 0 $w {
      initSquare $f $row $col
    }
  }
  set $f.minesguessed 0
  set $f.squaresknown 0
  set $f.done 0
  set $f.started 0
  set $f.visited {}
  $f.st.m.n.mines config -text "$m"
  $f.st.m.l.found config -text "Mines found:"
  updateMinesguessed $f
  resetTime $f
  updateTime $f
  setMines $f $m
  set $f.lRow 0
  set $f.lCol 0
  lazyUpdate $f
  #hashMines $f
}

proc askResetBoard {f} {
  global $f.done
  if {[set $f.done]} {
    resetBoard $f
    return
  }
  yesNo "Reset Mines Board" "Are you sure you want to reset the board?" "resetBoard $f" "noop" No
}

proc askResizeBoard {f type} {
  global $f.done $f.started
  set done [set $f.done]
  set started [set $f.started]
  case $type {
    "small" {
      set width 10
      set height 10
    }
    "medium" {
      set width 20
      set height 10
    }
    "big" {
      set width 40
      set height 20
    }
    "max" {
      set width [maxwidth]
      set height [maxheight]
    }
    "custom" {
      customResize $f
      return
    }
  }
  set mines [stdmines $width $height]
  if {$done || ! $started} {
    resizeBoard $f $width $height $mines
    return
  }
  multChoice "Reset Board Size" "Are you sure you want to reset the board to $width x $height ($mines mines)?" [list [list "Yes" "resizeBoard $f $width $height $mines"] {No noop}] No
}

proc askShowAll {f} {
  global $f.done
  if {[set $f.done]} {
    inform "You can't give up; the game is already over!"
  } else {
    yesNo "Give Up Mines" "Are you sure you want to give up the game?" "showAll $f" "noop" No
  }
}

proc aboutMines {} {
  global version
  inform "tkmines version $version, by Joel A. Fine"
}

proc helpMines {} {
  global helpFile
  set id [open "$helpFile" r]
  set msg [read $id]
  inform $msg
}

proc showAll {f} {
  global $f.width $f.height $f.done
  set w [set $f.width]
  set h [set $f.height]
  set $f.done 1
  #for {set row 0} {$row < $h} {incr row}
  loop row 0 $h {
    #for {set col 0} {$col < $w} {incr col}
    loop col 0 $w {
      set guess [getGuess $f $row $col]
      setGuess $f $row $col known
      if {$guess == "known"} {
        continue
      }
      global $f.$row.$col.mined
      # We don't know for sure what this is
      if {$guess == "mine"} {
        # We think it's a mine
        if {[set $f.$row.$col.mined]} {
          continue
        }
        # Wrong!
        $f.b.$row.$col config -bitmap [getBitmap wrongMine]
        continue
      }
      if {[set $f.$row.$col.mined]} {
        $f.b.$row.$col config -bitmap [getBitmap unfoundMine]
      }
    }
    update
  }
  update idletasks
}

proc customResize {f} {
  global $f.width $f.height $f.mines
  set w [genName .customResetSize]
  toplevel $w
  dpos $w
  wm title $w "Custom Board Size"

  frame $w.m
  label $w.m.l -text "Mine Count:"
  radiobutton $w.m.std -text "Standard" -variable useStdMineCount -value 1 -command "$w.m.scale config -state disabled"
  label $w.m.stdl -relief sunken -width 3
  radiobutton $w.m.custom -text "Custom" -variable useStdMineCount -value 0 -command "$w.m.scale config -state normal"
  scale $w.m.scale -orient horizontal -length 200

  $w.m.scale set [set $f.mines]
  $w.m.std invoke

  pack append $w.m $w.m.l left $w.m.std left $w.m.stdl left $w.m.custom left $w.m.scale left

  scale $w.w -label "Width:" -orient horizontal -length 200 -from [minwidth] -to [maxwidth]
  scale $w.h -label "Height:" -orient horizontal -length 200 -from [minheight] -to [maxheight]

  $w.w config -command "customMineScale $w"
  $w.h config -command "customMineScale $w"

  $w.w set [set $f.width]
  $w.h set [set $f.height]

  pack append $w $w.w top $w.h top $w.m top

  frameMultChoice $w.yesNo "" [list [list "Resize Board" "resizeBoardCustom $f $w"] [list "Cancel" "destroy $w"]] Cancel
  pack append $w $w.yesNo {top fillx}
}

proc customMineScale {w num} {
  set min [minmines [$w.w get] [$w.h get]]
  set max [maxmines [$w.w get] [$w.h get]]
  set std [stdmines [$w.w get] [$w.h get]]
  $w.m.scale config -from $min
  $w.m.scale config -to   $max
  $w.m.scale config -tickinterval [expr {$max - $min}]
  $w.m.stdl config -text $std
}

proc resizeBoardCustom {f win} {
  global useStdMineCount
  set w [$win.w get]
  set h [$win.h get]
  if {$useStdMineCount} {
    set m [stdmines $w $h]
  } else {
    set m [$win.m.scale get]
  }
  if {$w > [maxwidth] || $w < [minwidth]} {
    warn "Width must be between [minwidth] and [maxwidth]."
    return
  }
  if {$h > [maxheight] || $h < [minheight]} {
    warn "Height must be between [minheight] and [maxheight]."
    return
  }
  if {$m > [maxmines $w $h] || $m < [minmines $w $h]} {
    warn "Number of mines must be between [minmines $w $h] and [maxmines $w $h] for a board this size"
    return
  }
  resizeBoard $f $w $h $m
  destroy $win
}

proc resizeBoard {f w h m} {
  if {! [ctype digit $w]} {
    warn "$w is not a valid width."
    return
  }
  if {! [ctype digit $h]} {
    warn "$h is not a valid height."
    return
  }
  if {! [ctype digit $m]} {
    warn "$m is not a valid number of mines."
    return
  }
  if {$w > [maxwidth] || $h > [maxheight]} {
    warn "That board is too big! It wouldn't fit on the screen."
    return
  }
  set win [inform "Resizing board. Please stand by."]
  destroy $f
  toplevel $f
  wm title $f Mines
  makeBoard $f $w $h $m
  destroy $win
}

# $f is frame/top window
# $m is number of mines
proc setMines {f m} {
  global $f.squareList
  global $f.mineList
  set squareList [set $f.squareList]
  set $f.mineList [choose $m $squareList]
  foreach square [set $f.mineList] {
    makeMined $f [lindex $square 0] [lindex $square 1]
  }
}

proc initSquare {f row col} {
  global $f.$row.$col.nbrguessed $f.$row.$col.value
  if {[info exists $f.$row.$col.value]} {
    unset $f.$row.$col.value
  }
  set $f.$row.$col.nbrguessed 0
  setGuess $f $row $col empty
  makeEmpty $f $row $col
  $f.b.$row.$col config -background lightgrey -activebackground grey -relief raised
}

proc resetTime {f} {
  global $f.time
  set $f.time [getclock]
}

proc updateTime {f} {
  global $f.done
  set time [getTime $f]
  #This code works, but I'm not sure I want it in just now
  #set rank [expr 1+[getRank $time [boardType $f]]]
  $f.st.t.n config -text $time
  #if {$rank <= 10} {
  #  $f.st.r.l config -text Rank:
  #  $f.st.r.n config -text $rank -relief sunken
  #} else {
  #  $f.st.r.l config -text ""
  #  $f.st.r.n config -text "" -relief flat
  #}
  if {[set $f.done]} {return}
  after 1000 updateTime $f
}

proc updateSquaresknown {f} {
  global $f.squaresknown
  checkWin $f
}

proc updateMinesguessed {f} {
  global $f.minesguessed
  $f.st.m.n.found config -text [set $f.minesguessed]
}

proc checkWin {f} {
  global $f.squaresknown $f.area $f.mines
  set squaresknown [set $f.squaresknown]
  set area [set $f.area]
  set mines [set $f.mines]
  if {[expr {$squaresknown + $mines}] == $area} {
    winGame $f [getTime $f]
  }
}

proc getTime {f} {
  global $f.time $f.started
  if {! [set $f.started]} {
    resetTime $f
  }
  set start [set $f.time]
  set now [getclock]
  set diff [expr {$now - $start}]
  return [fmtTime $diff]
}

proc fmtTime {time} {
  set min [expr {$time / 60}]
  set sec [expr {$time % 60}]
  # Format the time
  if {$sec == 0} {return "$min:00"}
  if {$sec < 10} {return "$min:0$sec"}
  return "$min:$sec"
}

proc makeMined {f row col} {
  global $f.$row.$col.mined
  set $f.$row.$col.mined 1
  # For debugging
  # $f.b.$row.$col config -foreground red
}

proc makeEmpty {f row col} {
  global $f.$row.$col.mined
  set $f.$row.$col.mined 0
}

# Every so often, count up the neighbor-mines of another square.
proc lazyUpdate {f} {
  global $f.width $f.height $f.lRow $f.lCol $f.started $f.done
  if {[set $f.done]} {return}
  set row [set $f.lRow]
  set col [set $f.lCol]
  global $f.$row.$col.value
  #if {[info exists $f.$row.$col.value]} {return}
  set $f.$row.$col.value [countNeighborMines $f $row $col]
  incr col
  if {$col == [set $f.width]} {
    set col 0
    incr row
  }
  set $f.lRow $row
  set $f.lCol $col
  # Have we reached the end?
  if {$row != [set $f.height]} {
    if {[set $f.started]} {
      set nextTime 50
    } else {
      set nextTime 1
    }
    after $nextTime lazyUpdate $f
  } else {
    $f.st.m.l.found config -text "Mines Found:"
  }
}

# How many neighbors are mines?
proc countNeighborMines {f row col} {
  global $f.$row.$col.value
  # Just in case I've computed it already
  if {[info exists $f.$row.$col.value]} {
    return [set $f.$row.$col.value]
  }
  set count 0
  foreach square [getNeighbors $f $row $col] {
    set nr [lindex $square 0]
    set nc [lindex $square 1]
    global $f.$nr.$nc.mined
    incr count [set $f.$nr.$nc.mined]
  }

  return $count
}

proc visitSquare {f row col} {
  global $f.$row.$col.mined $f.squaresknown $f.started
  global $f.done
  if {[set $f.done]} {return}
  if {[getGuess $f $row $col] == "known"} {
    return
  }
  if {[getGuess $f $row $col] == "mine"} {
    return
  }
  if {[set $f.$row.$col.mined]} {
    $f.b.$row.$col config -background red -activeforeground red
    loseGame $f [getTime $f]
    return
  }
  if {! [set $f.started]} {
    set $f.started 1
  }
  set count [countNeighborMines $f $row $col]
  setGuess $f $row $col known
  incr $f.squaresknown
  updateSquaresknown $f
  $f.b.$row.$col config -bitmap [getBitmap $count]
  $f.b.$row.$col config -foreground [getForeground $count] -activeforeground [getForeground $count] -activebackground lightgrey
  $f.b.$row.$col config -relief sunken
  update
}

proc showSquare {f row col} {
  global $f.visited $f.done
  if {[set $f.done]} {return}
  visitSquare $f $row $col
  set count [countNeighborMines $f $row $col]
  if {$count == 0} {
    #set $f.visited {}
    set zero {}
    while 1 {
      foreach square [getNeighbors $f $row $col] {
        set nr [lindex $square 0]
        set nc [lindex $square 1]
        visitSquare $f $nr $nc
        if ![countNeighborMines $f $nr $nc] {
          if {[lsearch [set $f.visited] $square] < 0} {lappend zero $square}
        }
        if {[lsearch [set $f.visited] $square] < 0} {lappend $f.visited $square}
      }
      if {[llength $zero] != 0} {
        set row [lindex [lindex $zero 0] 0]
        set col [lindex [lindex $zero 0] 1]
        set zero [lrange $zero 1 end]
      } else {
        return
      }
    }
  }
}

proc markSquare {f row col} {
  set guess [getGuess $f $row $col]
  if {$guess == "known"} {return}
  case $guess {
    "empty" {
      set guess mine
      set incr 1
    }
    "mine" {
      set guess mark
      set incr -1
    }
    "mark" {
      set guess empty
      set incr 0
    }
  }
  setGuess $f $row $col $guess
  foreach square [getNeighbors $f $row $col] {
    set nr [lindex $square 0]
    set nc [lindex $square 1]
    global $f.$nr.$nc.nbrguessed
    incr $f.$nr.$nc.nbrguessed $incr
  }
  global $f.minesguessed
  incr $f.minesguessed $incr
  updateMinesguessed $f
}

proc setGuess {f row col guess} {
  global $f.$row.$col.guess
  set $f.$row.$col.guess $guess
  if {$guess != "known"} {
    $f.b.$row.$col config -bitmap [getBitmap $guess]
    $f.b.$row.$col config -foreground [getForeground $guess]
    $f.b.$row.$col config -activeforeground [getActiveForeground $guess]
  }
}

proc getGuess {f row col} {
  getParam $f $row $col guess
}

proc getParam {f row col param} {
  global $f.$row.$col.$param
  return [set $f.$row.$col.$param]
}

proc getActiveForeground {value} {
  if {[tk colormodel .] != "color"} {
    return black
  }
  case $value {
    "mine" {return red}
    "mark" {return black}
    "empty" {return black}
  }
}

proc getForeground {value} {
  if {[tk colormodel .] != "color"} {
    return black
  }
  case $value {
    "mine" {return red}
    "mark" {return black}
    "empty" {return black}
    "0" {return lightgrey}
    "1" {return blue}
    "2" {return seagreen}
    "3" {return red}
    "4" {return white}
    "5" {return black}
    "6" {return yellow}
    "7" {return limegreen}
    "8" {return limegreen}
  }
}

proc sinkNeighbors {f row col} {
  global $f.done
  if {[set $f.done]} {return}
  foreach square [getNeighbors $f $row $col] {
    set nr [lindex $square 0]
    set nc [lindex $square 1]
    set guess [getGuess $f $nr $nc]
    if {$guess != "mine"} {
      $f.b.$nr.$nc config -relief sunken
    }
  }
  $f.b.$row.$col config -relief sunken
}

proc raiseNeighbors {f row col} {
  foreach square [getNeighbors $f $row $col] {
    set nr [lindex $square 0]
    set nc [lindex $square 1]
    set guess [getGuess $f $nr $nc]
    if {$guess != "known"} {
      $f.b.$nr.$nc config -relief raised
    }
  }
  if {[getGuess $f $row $col] != "known"} {
    $f.b.$row.$col config -relief raised
  }
}


# $f.$row.$col.nbrguessed = number of neighbors guessed to be bombs.

# If I already know the value of this button, and I've already marked
# that many mines around it, expose the rest of its neighbors.
proc testSquare {f row col} {
  global $f.$row.$col.nbrguessed
  raiseNeighbors $f $row $col
  # If the square isn't known, testSquare does nothing.
  if {[getGuess $f $row $col] != "known"} {
    return
  }
  set value [countNeighborMines $f $row $col]
  set nbrguessed [set $f.$row.$col.nbrguessed]
  if {$value <= $nbrguessed} {
    foreach square [getNeighbors $f $row $col] {
      set nr [lindex $square 0]
      set nc [lindex $square 1]
      if {[getGuess $f $nr $nc] != "mine"} {
        showSquare $f $nr $nc
      }
    }
  }
}

proc loseGame {f time} {
  showAll $f
  multChoice "Loser!" "You lost, in only $time!" [list {OK noop} [list "Play Again" "resetBoard $f"] [list "Quit" "quit Mines 0"]] "Play Again"
}

proc winGame {f time} {
  global scoreFile
  after 50 showAll $f
  set boardType [boardType $f]
  set index [addHighScore $time $boardType ]
  if { $index < 10 && $index > -1 } {
    # Made the high score list
    showHighScoresReset $f $scoreFile [list $boardType $index] "Congratulations, you made the high score list!"
  } else {
    multChoice "Winner!" "You won, in only $time!" [list {OK noop} [list "Play Again" "resetBoard $f"] [list "Quit" "quit Mines 0"]] "Play Again"
  }
}

proc printProfile {} {
  # Profiling should already be turned on by the time this procedure
  # is called
  profile off pro
  profrep pro cpu 3 tkmines.report
  profile -commands on
}

proc boardType {f} {
  global $f.width $f.height $f.mines
  set w [set $f.width]
  set h [set $f.height]
  set m [set $f.mines]
  if {$w == 10 && $h == 10 && $m == 15} {
    return "small"
  }
  if {$w == 20 && $h == 10 && $m == 30} {
    return "medium"
  }
  if {$w == 40 && $h == 20 && $m == 120} {
    return "big"
  }
  return "custom"
}
SHAR_EOF
echo shar: extracting "'misc.tcl'" '(4143 characters)'
if test -f 'misc.tcl'
then
	echo shar: over-writing existing file "'misc.tcl'"
fi
cat << \SHAR_EOF > 'misc.tcl'
proc busy {} {
  # Commented out: MUCH too slow
  #forAllWindows setBusy
  foreach w [winfo children .] {
    setBusy $w
  }
  after 100 unbusy
}

proc unbusy {} {
  #forAllWindows setUnbusy
  foreach w [winfo children .] {
    setUnbusy $w
  }
}

proc setBusy {w} {
  global oldCursor
  if {$w != "."} {
    set oldCursor($w) [lindex [$w config -cursor] 4]
    $w config -cursor watch
  }
}

proc setUnbusy {w} {
  global oldCursor
  if {$w != "."} {
    if {[info exists oldCursor($w)]} {
      $w config -cursor $oldCursor($w)
    }
  }
}

proc forAllWindows {cmd} {
  forAllWindows1 . $cmd
}

proc forAllWindows1 {w cmd} {
  $cmd $w
  foreach c [winfo children $w] {
    forAllWindows1 $c $cmd
  }
}

proc waitFor {w} {
  global $w.iHaveBeenExposed
  set $w.iHaveBeenExposed 0
  bind $w <Expose> "set $w.iHaveBeenExposed 1"
  #tkwait variable $w.iHaveBeenExposed
  bind $w <Expose> ""
  update
}

proc dpos {w} {
  wm geometry $w +300+300
}

proc inform { msg {aspect 1000}} {
  set w [genName .info]
  toplevel $w
  dpos $w
  wm title $w "Information"
  frame $w.m
  pack append $w $w.m {top expand fill}

  message $w.m.l -text "$msg" -aspect $aspect
  button $w.m.b -command "destroy $w" -text "Dismiss"

  pack append $w.m $w.m.l top $w.m.b top
  waitFor $w
  grab $w
  return $w
}

proc warn { msg {aspect 1000}} {
  set w [genName .warn]
  toplevel $w
  dpos $w
  wm title $w "Warning!"
  frame $w.m
  pack append $w $w.m {top expand fill}

  message $w.m.l -text "Warning: $msg" -aspect $aspect
  button $w.m.b -command "destroy $w" -text "OK"

  pack append $w.m $w.m.l top $w.m.b top
  waitFor $w
  grab $w
  return $w
}

proc genName {{var var}} {
  global nameCount
  if [info exists nameCount($var)] {
    incr nameCount($var)
  } else {
    set nameCount($var) 0
  }
  return "$var$nameCount($var)"
}

proc frameMultChoice {frame msg choices default} {
  frame $frame
  subMultChoice $frame $msg $choices $default
}

proc multChoice {title msg choices default} {
  set w [genName .mult]
  toplevel $w
  dpos $w
  wm title $w $title
  subMultChoice $w $msg $choices $default
  grab $w
}

proc subMultChoice {w msg choices default} {
  set var [genName]
  frame $w.m -relief raised -border 1
  frame $w.b -relief raised -border 1
  set style {top fill expand}
  if {$msg != ""} {
    pack append $w $w.m $style
  }
  pack append $w $w.b $style
  label $w.m.l -text $msg
  pack append $w.m $w.m.l top
  foreach i $choices {
    set text [lindex $i 0]
    set command [lindex $i 1]
    set style1 {left expand padx 40 pady 20}
    if {$text == $default} {
      set style2 {expand padx 5 pady 5}
      set button default
    } {
      set style2 {expand}
      set button [genName button]
    }
    frame $w.b.$button -relief sunken -border 1
    pack append $w.b $w.b.$button $style1
    button $w.b.$button.b -text $text -command "destroy $w; $command"
    pack append $w.b.$button $w.b.$button.b $style2
    bind $w.b.$button <Enter> "$w.b.$button.b activate"
    bind $w.b.$button <Leave> "$w.b.$button.b deactivate"
    bind $w.b.$button <Return> "$w.b.$button.b invoke"
    bind $w.b.$button.b <Return> "$w.b.$button.b invoke"
  }
  bind $w.m <Enter>	"$w.b.default.b activate"
  bind $w.m.l <Enter>	"$w.b.default.b activate"
  bind $w.b <Enter>	"$w.b.default.b activate"
  bind $w.m <Leave>	"$w.b.default.b deactivate"
  bind $w.m.l <Leave>	"$w.b.default.b deactivate"
  bind $w.b <Leave>	"$w.b.default.b deactivate"
  bind $w.m <Return>	"$w.b.default.b invoke"
  bind $w.m.l <Return>	"$w.b.default.b invoke"
  bind $w.b <Return>	"$w.b.default.b invoke"
  eval [list proc $w.invoke_default {} [list $w.b.default.b invoke]]
}

proc yesNo { title msg yesAction noAction default} {
  multChoice $title $msg [list "Yes [list $yesAction]" "No [list $noAction]"] $default
}

proc quit { prog {confirm 1}} {
  if $confirm {
    yesNo "Quit" "Are you sure you want to quit $prog?" "quit $prog 0" "noop" No
  } else {
    destroy .
    exit
  }
}

proc noop {} {
}  

proc toggle {var} {
  global $var
  if [info exists $var] {
    if [set $var] {
      set $var 0
    } else {
      set $var 1
    }
  } else {
    set $var 1
  }
}
SHAR_EOF
echo shar: extracting "'parseArgs.tcl'" '(1524 characters)'
if test -f 'parseArgs.tcl'
then
	echo shar: over-writing existing file "'parseArgs.tcl'"
fi
cat << \SHAR_EOF > 'parseArgs.tcl'
proc parseArgs {argc argv} {
  global width height mines
  set minesSpecified 0
  for {set i 0} {$i < $argc} {incr i} {
    set arg [lindex $argv $i]
    case $arg {
      -help	printHelp
      -bugs {
         # Turn on debugging
         global bugs
         set bugs 1
      }
      -v {
        global version
        echo "tkmines, version $version. By Joel A. Fine"
        exit
      }
      -width	{
        incr i
        set width [lindex $argv $i]
      }
      -height	{
        incr i
        set height [lindex $argv $i]
      }
      -small	{
	set width 10
	set height 10
	set mines 15
      }
      -med*	{
	set width 20
	set height 10
	set mines 30
      }
      -big	{
	set width 40
	set height 20
	set mines 120
      }
      -mines	{
        incr i
        set mines [lindex $argv $i]
        set minesSpecified 1
      }
      default	printHelp
    }
  }
  if {$width > [maxwidth] || $width < [minwidth]} {printHelp}
  if {$height > [maxheight] || $height < [minheight]} {printHelp}

  if {! $minesSpecified} {
    set mines [stdmines $width $height]
  }
  if {$mines > [maxmines $width $height] || $mines < [minmines $width $height]} {printHelp}
}

proc printHelp {} {
  global width height mines
  echo {tkmines [-big] [-med] [-small] -width [width] -height [height] -mines [mines]}
  echo width must be less than [maxwidth], height must be less than
  echo [maxheight], and mines must be between [minmines [minwidth] [minheight]] and [maxmines [maxwidth] [maxheight]]
  exit
}

parseArgs $argc $argv
SHAR_EOF
echo shar: extracting "'random.tcl'" '(952 characters)'
if test -f 'random.tcl'
then
	echo shar: over-writing existing file "'random.tcl'"
fi
cat << \SHAR_EOF > 'random.tcl'
# Choose $num elements at random from $l
proc choose {num l} {
  random seed
  set nl {}
  #for {set i 1} {$i <= $num} {incr i}
  loop i 0 $num {
    set index [random [llength $l]]
    lappend nl [lindex $l $index]
    set l [lreplace $l $index $index]
  }
  return $nl
}

proc chooseOld {num l} {
  lrange [randOrder $l] 0 [expr {$num - 1}]
}

# Put $l (a list) into random order
proc randOrder {l} {
  set newlist {}
  while {! [lempty $l]} {
    set x [extractRandomElement $l]
    lappend newlist [lindex $x 0]
    set l [lindex $x 1]
  }
  return $newlist
}

# Extract a single element from $l at random. Return the element, followed
# by the list, extracting the element from the list.
proc extractRandomElement {list} {
  random seed
  set index [random [llength $list]]
  set el [lindex $list $index]
  set newlist [concat [lrange $list 0 [expr {$index - 1}]] [lrange $list [expr {$index + 1}] [llength $list]]]
  return [list $el $newlist]
}
SHAR_EOF
echo shar: extracting "'start.tcl'" '(117 characters)'
if test -f 'start.tcl'
then
	echo shar: over-writing existing file "'start.tcl'"
fi
cat << \SHAR_EOF > 'start.tcl'
if {$bugs} {
  profile -commands on
}
wm withdraw .
toplevel .w
wm title .w Mines
makeBoard .w $width $height $mines
SHAR_EOF
echo shar: extracting "'util.tcl'" '(1049 characters)'
if test -f 'util.tcl'
then
	echo shar: over-writing existing file "'util.tcl'"
fi
cat << \SHAR_EOF > 'util.tcl'
# Convert float to int
proc toint {num} {
  return [format "%.0f" $num]
}

proc getNeighbors {f row col} {
  global $f.width $f.height

  set w [set $f.width]
  set h [set $f.height]

  if {$row >= $h} {return {}}
  if {$col >= $w} {return {}}

  set nl {}

  # Above
  if {$row > 0} {
    set nr [expr {$row - 1}]
    # Left
    if {$col > 0} {
      lappend nl [list $nr [expr {$col - 1}]]
    }
    # Middle
    lappend nl [list $nr $col]
    # Right
    if {$col < [expr {$w - 1}]} {
      lappend nl [list $nr [expr {$col + 1}]]
    }
  }

  # Below
  if {$row < [expr {$h - 1}]} {
    set nr [expr {$row + 1}]
    # Left
    if {$col > 0} {
      lappend nl [list $nr [expr {$col - 1}]]
    }
    # Middle
    lappend nl [list $nr $col]
    # Right
    if {$col < [expr {$w - 1}]} {
      lappend nl [list $nr [expr {$col + 1}]]
    }
  }

  # Even
  set nr $row
  # Left
  if {$col > 0} {
    lappend nl [list $nr [expr {$col - 1}]]
  }
  # Right
  if {$col < [expr {$w - 1}]} {
    lappend nl [list $nr [expr {$col + 1}]]
  }
  return $nl
}
SHAR_EOF
echo shar: extracting "'high.tcl'" '(5284 characters)'
if test -f 'high.tcl'
then
	echo shar: over-writing existing file "'high.tcl'"
fi
cat << \SHAR_EOF > 'high.tcl'
# For debugging
proc addRandomHighScore {f} {
  set type [lindex {small medium big} [random 3]]
  set time [random 5]:[random 60]
  echo Adding high score: $type $time
  addHighScore $time $type
}

# highlight: which score to highlight?
proc showHighScoresReset {f file {highlight {}} {msg {High Score List}}} {
  readHighScores $file
  set w [toplevel [genName .scores]]
  wm title $w "High scores"
  label $w.title -text $msg
  pack append $w $w.title top
  frameHighScore $w.s $highlight
  pack append $w $w.s top
  frameMultChoice $w.ok "" [list [list "OK" "changeHighScore $w.s $highlight;destroy $w"] [list "Play Again" "changeHighScore $w.s $highlight;destroy $w;resetBoard $f"] [list "Quit" "changeHighScore $w.s $highlight;destroy [winfo parent $f]"]] "Play Again"
  pack append $w $w.ok top
  #bind $w <Destroy> "changeHighScore $w.s $highlight"
}

# highlight: which score to highlight?
proc showHighScores {file {highlight {}} {msg {High Score List}}} {
  readHighScores $file
  set w [toplevel [genName .scores]]
  wm title $w "High scores"
  label $w.title -text $msg
  pack append $w $w.title top
  frameHighScore $w.s $highlight
  pack append $w $w.s top
  frameMultChoice $w.ok "" [list [list Dismiss "destroy $w"]] Dismiss
  pack append $w $w.ok top
}

proc frameHighScore {f {highlight {}}} {
  global scores
  global username
  frame $f
  set htype [lindex $highlight 0]
  set hindex [lindex $highlight 1]
  foreach type {small medium big} {
    set index 0
    frame $f.$type -relief raised -bd 2
    pack append $f $f.$type {left filly expand}
    label $f.$type.title -text $type
    pack append $f.$type $f.$type.title top
    frame $f.$type.name
    frame $f.$type.time
    frame $f.$type.date
    pack append $f.$type $f.$type.name {left filly expand} $f.$type.time {left filly expand} $f.$type.date {left filly expand}
    label $f.$type.name.title -text "Name"
    label $f.$type.time.title -text "Time"
    label $f.$type.date.title -text "Date"
    pack append $f.$type.name $f.$type.name.title top
    pack append $f.$type.time $f.$type.time.title top
    pack append $f.$type.date $f.$type.date.title top
    foreach scoreLine $scores($type) {
      label $f.$type.time.$index -text [fmtTime [lindex $scoreLine 0]]
      label $f.$type.date.$index -text [fmtclock [lindex $scoreLine 2] "%D"]
      if {$htype == $type && $hindex == $index} {
        entry $f.$type.name.$index
        set w [winfo parent $f].ok
        bind $f.$type.name.$index <Return> "$w.b.default.b invoke"
	# "changeHighScore $f $highlight;destroy [winfo parent $f]"
        focus $f.$type.name.$index
        $f.$type.name.$index insert 0 $username
        $f.$type.time.$index config -relief raised
        $f.$type.date.$index config -relief raised
        $f.$type.name.$index config -relief raised
      } else {
        label $f.$type.name.$index -text [lindex $scoreLine 1]
      }
      pack append $f.$type.name $f.$type.name.$index top
      pack append $f.$type.time $f.$type.time.$index top
      pack append $f.$type.date $f.$type.date.$index top
      incr index
    }
  }
}

proc readHighScores {file} {
  global scores
  if {! [file exists $file]} {
    exec touch $file
  }
  set id [open $file r]
  set scoreList [read $id]
  set scores(small) [lindex $scoreList 0]
  set scores(medium) [lindex $scoreList 1]
  set scores(big) [lindex $scoreList 2]
  close $id
}

proc writeHighScores {file} {
  global scores
  write_file $file [list $scores(small) $scores(medium) $scores(big)]
  catch "chmod 0777 $file"
}

proc changeHighScore {f boardType index} {
  global scores scoreFile
  global username
  set username [$f.$boardType.name.$index get]

  # Gotta be an appropriate type of board
  if {[lsearch {small medium big} $boardType] == -1} {return -1}

  readHighScores $scoreFile

  set scoreline [lindex $scores($boardType) $index]
  set scoreline [lreplace $scoreline 1 1 $username] 
  set scores($boardType) [lreplace $scores($boardType) $index $index $scoreline]

  writeHighScores $scoreFile
}

proc addHighScore {time boardType} {
  global scores scoreFile

  # Gotta be an appropriate type of board
  if {[lsearch {small medium big} $boardType] == -1} {return -1}

  readHighScores $scoreFile

  set index [getRank $time $boardType]
  set score [str2scr $time]
  set scores($boardType) [linsert $scores($boardType) $index [makeScoreLine $score]]

  set scores($boardType) [lrange $scores($boardType) 0 9]

  writeHighScores $scoreFile

  return $index
}

proc getRank {time boardType} {
  global scores
  # Gotta be an appropriate type of board
  if {[lsearch {small medium big} $boardType] == -1} {return -1}

  set score [str2scr $time]
  set index 0
  while {$score >= [getScore [lindex $scores($boardType) $index]]} {
    incr index
  }
  return $index
}

proc getScore {scoreLine} {
  if {$scoreLine == {} } {
    return 99999
  }
  return [lindex $scoreLine 0]
}

proc makeScoreLine {score} {
  global env
  if {[info exists env(TKMINESUSER)]} {
    set user $env(TKMINESUSER)
  } else {
    set user [id user]
  }
  return [list $score $user [getclock]]
}

proc str2scr {str} {
  scan $str "%d:%d" min sec
  return [expr {60 * $min + $sec}]
}

proc scr2str {scr} {
  set min [expr {$scr / 60}]
  set sec [expr {$scr % 60}]
  return "$min:$sec"
}
SHAR_EOF
echo shar: extracting "'load.tcl'" '(545 characters)'
if test -f 'load.tcl'
then
	echo shar: over-writing existing file "'load.tcl'"
fi
cat << \SHAR_EOF > 'load.tcl'
# exit on ^C
signal default SIGINT

# Check for Extended TCL
if { [catch "infox version"] } {
  puts stdout "You need Extended TCL to run tkmines. You can get that through"
  puts stdout "anonymous ftp, at"
  puts stdout "sprite.berkeley.edu:/tcl/tclX6.5c.tar.Z."
  exit
}

source "$sourceDir/init.tcl"
source "$sourceDir/mines.tcl"
source "$sourceDir/misc.tcl"
source "$sourceDir/random.tcl"
source "$sourceDir/util.tcl"
source "$sourceDir/gripe.tcl"
source "$sourceDir/high.tcl"
source "$sourceDir/parseArgs.tcl"
source "$sourceDir/start.tcl"
SHAR_EOF
echo shar: extracting "'gripe.tcl'" '(828 characters)'
if test -f 'gripe.tcl'
then
	echo shar: over-writing existing file "'gripe.tcl'"
fi
cat << \SHAR_EOF > 'gripe.tcl'
proc gripe {sub} {
  set w [genName .gripe]
  toplevel $w
  wm title $w "Gripe to the author"
  label $w.l -text "Send a message to the author"
  frame $w.h
  frame $w.t -relief sunken -bd 2
  text $w.t.txt -wrap word
  pack append $w.t $w.t.txt top

  frameMultChoice $w.b "" [list [list "Send" "sendGripe $w.t.txt $sub; destroy $w"] [list "Cancel" "destroy $w"]] Send

  pack append $w $w.l {top expand fillx} $w.h {top expand fillx} $w.t {top pady 10} $w.b {top pady 20}

  label $w.h.to -text "To: joel@cs.berkeley.edu"
  label $w.h.sub -text "Subject: $sub"
  pack append $w.h $w.h.to {top frame w} $w.h.sub {top frame w}
}

proc sendGripe {t sub} {
  global version
  sendMail "joel@cs.berkeley.edu" "$sub $version gripe!" [$t get 1.0 end]
}

proc sendMail {to subject text} {
  exec echo $text | mail -s $subject $to &
}
SHAR_EOF
echo shar: done with directory "'src'"
cd ..
echo shar: extracting "'Makefile'" '(978 characters)'
if test -f 'Makefile'
then
	echo shar: over-writing existing file "'Makefile'"
fi
cat << \SHAR_EOF > 'Makefile'
# Don't even THINK about changing this file. 8^)
include Make.config

VERSION		= 1.5

SOURCE_DIR	= $(LIB_DIR)/src
SCORE_FILE	= $(LIB_DIR)/scores
HELP_FILE	= $(LIB_DIR)/help
LOAD_FILE	= $(SOURCE_DIR)/load.tcl"

install: uninstall tkmines
	- mkdir -p $(LIB_DIR)
	- mkdir -p $(BIN_DIR)
	cp -p tkmines $(BIN_DIR)
	cp -rp src $(LIB_DIR)/src
	cp -rp bitmaps $(LIB_DIR)/bitmaps
	cp -rp help $(LIB_DIR)/help
	touch scores
	cp -p scores $(SCORE_FILE)
	chmod 777 $(SCORE_FILE)
	@echo tkmines is now installed.

tkmines:
	@echo >  $@ "#! $(WISH) -f"
	@echo >> $@ "set version $(VERSION)"
	@echo >> $@ "set libDir "$(LIB_DIR)"
	@echo >> $@ "set sourceDir $(SOURCE_DIR)"
	@echo >> $@ "set scoreFile $(SCORE_FILE)"
	@echo >> $@ "set helpFile $(HELP_FILE)"
	@echo >> $@ "source $(LOAD_FILE)"
	chmod +x $@

uninstall:
	- mv $(SCORE_FILE) .
	rm -rf $(LIB_DIR) tkmines $(BIN_DIR)/tkmines

clean: uninstall

tidy:
	rm -rf *~ */*~ tkmines scores

shar: tidy
	shar -v . > ../tkmines.$(VERSION).shar
SHAR_EOF
echo shar: extracting "'Make.config'" '(318 characters)'
if test -f 'Make.config'
then
	echo shar: over-writing existing file "'Make.config'"
fi
cat << \SHAR_EOF > 'Make.config'
# WISH is the location of your Extended tcl wish binary
WISH		= /usr/sww/X11/bin/wishx

# LIB_DIR is the directory where you would like the source code installed
LIB_DIR		= /home/sequoia/joel/local/lib/tkmines

# BIN_DIR is the directory where you would like the executable installed
BIN_DIR		= /home/sequoia/joel/bin
SHAR_EOF
#	End of shell archive
exit 0
