• when the main windows is resized, the squares adapts to the size of the window
• the size when starting the game is set as minimum size of the window
• seen squares get background white; this way I find it easier to distinguish them from the unseen squares

• Classic minesweeper never hits a mine with your first move. It does this by moving the mine if you were about to hit it (there certainly used to be a cheat that let you confirm this). This is only the case for the first move.
• You can continue your game after losing!
• On slower Windows machines, the use of loads of buttons makes the whole app seem a bit sluggish (Win isn't too keen on hundreds of windows at once). Better to use a few more images and put everything on a canvas.

 #!/bin/sh
 # Restart with tcl: -*- mode: tcl; tab-width: 8; -*- \
 exec wish $0 ${1+"$@"}

 # Tkmines -- plays minesweeper w/ some extra features
 # Original tcl version: P Kern, [email protected], 99/02/18
 # (http://cns.utoronto.ca/~pkern/stuff/tkmines)
 # Revised: Keith Vetter

 # GLOBAL ARRAYS
 # board(type,x,y) => "mine", "seen", or # of neighboring mines
 # board(mark,x,y) => 0 nothing, 1 flag, 2 question
 # board(was,$x,$y) for "pop"
 # Map(Bombs)      => x,y  x,y  x,y ... => where the mines are
 # Map(Flags)      => x,y  x,y  x,y ... => where the flags are
 # player(count)   => # of mines left to be found
 # player(elapsed) => seconds since starting
 # player(auto)    => true or false
 # player(marks)   => true or false for flag marks

 package require Tk

 set usage {
    -beginner       beginner level (8x8  40 mines).
    -intermediate   medium level (16x16  60 mines).
    -expert         expert level (30x16  99 mines).
    -x <val>        x dimension of board.
    -y <val>        y dimension of board.
    -mines <val>    number of mines.
    -ratio <val>    ratio of mines to board squares.
    -seed <val>     seed for random numbers.
 }
 array set modes {beg,ident Beginner beg,XSize 8 beg,YSize 8 beg,Mines 10}
 array set modes {int,ident Intermediate int,XSize 16 int,YSize 16 int,Mines 40}
 array set modes {exp,ident Expert exp,XSize 30 exp,YSize 16 exp,Mines 99}
 array set modes {usr,ident Custom usr,XSize 16 usr,YSize 16 usr,Mines 40}
 array set board {Seed -1 ratio -1.0 custom 0}
 array set player {auto 1 marks 0 timing 0}

 # bitmaps: smiley, shades, croak, oops, flag, blank, qmark, mine, wrong, numbers

 image create bitmap smiley -background yellow -data "
 #define smiley_width 26
 #define smiley_height 26
 static unsigned char smiley_bits[] = {
   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xfc, 0x01, 0x00,
   0x00, 0x03, 0x06, 0x00, 0xc0, 0x00, 0x18, 0x00, 0x20, 0x00, 0x20, 0x00,
   0x10, 0x00, 0x40, 0x00, 0x10, 0x00, 0x40, 0x00, 0x08, 0x00, 0x80, 0x00,
   0x08, 0x06, 0x83, 0x00, 0x04, 0x06, 0x03, 0x01, 0x04, 0x00, 0x00, 0x01,
   0x04, 0x00, 0x00, 0x01, 0x04, 0x00, 0x00, 0x01, 0x04, 0x00, 0x00, 0x01,
   0x44, 0x00, 0x10, 0x01, 0x84, 0x00, 0x08, 0x01, 0x08, 0x03, 0x86, 0x00,
   0x08, 0xfc, 0x81, 0x00, 0x10, 0x00, 0x40, 0x00, 0x10, 0x00, 0x40, 0x00,
   0x20, 0x00, 0x20, 0x00, 0xc0, 0x00, 0x18, 0x00, 0x00, 0x03, 0x06, 0x00,
   0x00, 0xfc, 0x01, 0x00, 0x00, 0x00, 0x00, 0x00};
 " -maskdata "
 #define smiley_width 26
 #define smiley_height 26
 static unsigned char smiley_bits[] = {
   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xfc, 0x01, 0x00,
   0x00, 0xff, 0x07, 0x00, 0xc0, 0xff, 0x1f, 0x00, 0xe0, 0xff, 0x3f, 0x00,
   0xf0, 0xff, 0x7f, 0x00, 0xf0, 0xff, 0x7f, 0x00, 0xf8, 0xff, 0xff, 0x00,
   0xf8, 0xff, 0xff, 0x00, 0xfc, 0xff, 0xff, 0x01, 0xfc, 0xff, 0xff, 0x01,
   0xfc, 0xff, 0xff, 0x01, 0xfc, 0xff, 0xff, 0x01, 0xfc, 0xff, 0xff, 0x01,
   0xfc, 0xff, 0xff, 0x01, 0xfc, 0xff, 0xff, 0x01, 0xf8, 0xff, 0xff, 0x00,
   0xf8, 0xff, 0xff, 0x00, 0xf0, 0xff, 0x7f, 0x00, 0xf0, 0xff, 0x7f, 0x00,
   0xe0, 0xff, 0x3f, 0x00, 0xc0, 0xff, 0x1f, 0x00, 0x00, 0xff, 0x07, 0x00,
   0x00, 0xfc, 0x01, 0x00, 0x00, 0x00, 0x00, 0x00};
 "

 image create bitmap shades -background yellow -data "
 #define shades_width 26
 #define shades_height 26
 static unsigned char shades_bits[] = {
   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xfc, 0x01, 0x00,
   0x00, 0x03, 0x06, 0x00, 0xc0, 0x00, 0x18, 0x00, 0x20, 0x00, 0x20, 0x00,
   0x10, 0x00, 0x40, 0x00, 0x10, 0x00, 0x40, 0x00, 0x08, 0x00, 0x80, 0x00,
   0xc8, 0xff, 0x9f, 0x00, 0xe4, 0xdf, 0x3f, 0x01, 0x94, 0x8f, 0x4f, 0x01,
   0x0c, 0x07, 0x87, 0x01, 0x04, 0x00, 0x00, 0x01, 0x04, 0x00, 0x00, 0x01,
   0x44, 0x00, 0x10, 0x01, 0x84, 0x00, 0x08, 0x01, 0x08, 0x03, 0x86, 0x00,
   0x08, 0xfc, 0x81, 0x00, 0x10, 0x00, 0x40, 0x00, 0x10, 0x00, 0x40, 0x00,
   0x20, 0x00, 0x20, 0x00, 0xc0, 0x00, 0x18, 0x00, 0x00, 0x03, 0x06, 0x00,
   0x00, 0xfc, 0x01, 0x00, 0x00, 0x00, 0x00, 0x00};
 " -maskdata "
 #define smiley_width 26
 #define smiley_height 26
 static unsigned char smiley_bits[] = {
   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xfc, 0x01, 0x00,
   0x00, 0xff, 0x07, 0x00, 0xc0, 0xff, 0x1f, 0x00, 0xe0, 0xff, 0x3f, 0x00,
   0xf0, 0xff, 0x7f, 0x00, 0xf0, 0xff, 0x7f, 0x00, 0xf8, 0xff, 0xff, 0x00,
   0xf8, 0xff, 0xff, 0x00, 0xfc, 0xff, 0xff, 0x01, 0xfc, 0xff, 0xff, 0x01,
   0xfc, 0xff, 0xff, 0x01, 0xfc, 0xff, 0xff, 0x01, 0xfc, 0xff, 0xff, 0x01,
   0xfc, 0xff, 0xff, 0x01, 0xfc, 0xff, 0xff, 0x01, 0xf8, 0xff, 0xff, 0x00,
   0xf8, 0xff, 0xff, 0x00, 0xf0, 0xff, 0x7f, 0x00, 0xf0, 0xff, 0x7f, 0x00,
   0xe0, 0xff, 0x3f, 0x00, 0xc0, 0xff, 0x1f, 0x00, 0x00, 0xff, 0x07, 0x00,
   0x00, 0xfc, 0x01, 0x00, 0x00, 0x00, 0x00, 0x00};
 "
 image create bitmap croak -background yellow -data "
 #define croak_width 26
 #define croak_height 26
 static unsigned char croak_bits[] = {
   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xfc, 0x01, 0x00,
   0x00, 0x03, 0x06, 0x00, 0xc0, 0x00, 0x18, 0x00, 0x20, 0x00, 0x20, 0x00,
   0x10, 0x00, 0x40, 0x00, 0x90, 0x88, 0x48, 0x00, 0x08, 0x05, 0x85, 0x00,
   0x08, 0x02, 0x82, 0x00, 0x04, 0x05, 0x05, 0x01, 0x84, 0x88, 0x08, 0x01,
   0x04, 0x00, 0x00, 0x01, 0x04, 0x00, 0x00, 0x01, 0x04, 0x00, 0x00, 0x01,
   0x04, 0xfc, 0x01, 0x01, 0x04, 0xa3, 0x06, 0x01, 0x88, 0xa0, 0x8a, 0x00,
   0x48, 0xa0, 0x92, 0x00, 0x10, 0x20, 0x42, 0x00, 0x10, 0xc0, 0x41, 0x00,
   0x20, 0x00, 0x20, 0x00, 0xc0, 0x00, 0x18, 0x00, 0x00, 0x03, 0x06, 0x00,
   0x00, 0xfc, 0x01, 0x00, 0x00, 0x00, 0x00, 0x00};
 " -maskdata "
 #define smiley_width 26
 #define smiley_height 26
 static unsigned char smiley_bits[] = {
   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xfc, 0x01, 0x00,
   0x00, 0xff, 0x07, 0x00, 0xc0, 0xff, 0x1f, 0x00, 0xe0, 0xff, 0x3f, 0x00,
   0xf0, 0xff, 0x7f, 0x00, 0xf0, 0xff, 0x7f, 0x00, 0xf8, 0xff, 0xff, 0x00,
   0xf8, 0xff, 0xff, 0x00, 0xfc, 0xff, 0xff, 0x01, 0xfc, 0xff, 0xff, 0x01,
   0xfc, 0xff, 0xff, 0x01, 0xfc, 0xff, 0xff, 0x01, 0xfc, 0xff, 0xff, 0x01,
   0xfc, 0xff, 0xff, 0x01, 0xfc, 0xff, 0xff, 0x01, 0xf8, 0xff, 0xff, 0x00,
   0xf8, 0xff, 0xff, 0x00, 0xf0, 0xff, 0x7f, 0x00, 0xf0, 0xff, 0x7f, 0x00,
   0xe0, 0xff, 0x3f, 0x00, 0xc0, 0xff, 0x1f, 0x00, 0x00, 0xff, 0x07, 0x00,
   0x00, 0xfc, 0x01, 0x00, 0x00, 0x00, 0x00, 0x00};
 "
 image create bitmap oops -background yellow -data "
 #define img_width 26
 #define img_height 26
 static unsigned char img_bits[] = {
    0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xfc, 0x01, 0x00,
    0x00, 0x03, 0x06, 0x00, 0xc0, 0x00, 0x18, 0x00, 0x20, 0x00, 0x20, 0x00,
    0x10, 0x00, 0x40, 0x00, 0x10, 0x00, 0x40, 0x00, 0x08, 0x07, 0x87, 0x00,
    0x08, 0x07, 0x87, 0x00, 0x04, 0x07, 0x07, 0x01, 0x04, 0x00, 0x00, 0x01,
    0x04, 0x00, 0x00, 0x01, 0x04, 0x00, 0x00, 0x01, 0x04, 0xf8, 0x00, 0x01,
    0x04, 0x8c, 0x01, 0x01, 0x04, 0x8c, 0x01, 0x01, 0x08, 0x8c, 0x81, 0x00,
    0x08, 0xf8, 0x80, 0x00, 0x10, 0x00, 0x40, 0x00, 0x10, 0x00, 0x40, 0x00,
    0x20, 0x00, 0x20, 0x00, 0xc0, 0x00, 0x18, 0x00, 0x00, 0x03, 0x06, 0x00,
    0x00, 0xfc, 0x01, 0x00, 0x00, 0x00, 0x00, 0x00,
 };
 " -maskdata "
 #define smiley_width 26
 #define smiley_height 26
 static unsigned char smiley_bits[] = {
   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xfc, 0x01, 0x00,
   0x00, 0xff, 0x07, 0x00, 0xc0, 0xff, 0x1f, 0x00, 0xe0, 0xff, 0x3f, 0x00,
   0xf0, 0xff, 0x7f, 0x00, 0xf0, 0xff, 0x7f, 0x00, 0xf8, 0xff, 0xff, 0x00,
   0xf8, 0xff, 0xff, 0x00, 0xfc, 0xff, 0xff, 0x01, 0xfc, 0xff, 0xff, 0x01,
   0xfc, 0xff, 0xff, 0x01, 0xfc, 0xff, 0xff, 0x01, 0xfc, 0xff, 0xff, 0x01,
   0xfc, 0xff, 0xff, 0x01, 0xfc, 0xff, 0xff, 0x01, 0xf8, 0xff, 0xff, 0x00,
   0xf8, 0xff, 0xff, 0x00, 0xf0, 0xff, 0x7f, 0x00, 0xf0, 0xff, 0x7f, 0x00,
   0xe0, 0xff, 0x3f, 0x00, 0xc0, 0xff, 0x1f, 0x00, 0x00, 0xff, 0x07, 0x00,
   0x00, 0xfc, 0x01, 0x00, 0x00, 0x00, 0x00, 0x00};
 "
 image create bitmap flag -background red -data "
 #define flag_width 12
 #define flag_height 12
 static unsigned char flag_bits[] = {
   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
   0x00, 0x00, 0x00, 0x00, 0xe0, 0x01, 0xe0, 0x01, 0xf8, 0x03, 0xf8, 0x03};
 " -maskdata "
 #define flag_width 12
 #define flag_height 12
 static unsigned char flag_bits[] = {
   0x80, 0x00, 0xc0, 0x00, 0xf0, 0x00, 0xf8, 0x00, 0xf0, 0x00, 0xc0, 0x00,
   0x80, 0x00, 0x80, 0x00, 0xe0, 0x01, 0xe0, 0x01, 0xf8, 0x03, 0xf8, 0x03};
 "
 image create bitmap blank -data "
 #define blank_width 12
 #define blank_height 12
 static unsigned char blank_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};
 "
 image create bitmap qmark -foreground blue -data "
 #define huh_width 12
 #define huh_height 12
 static unsigned char huh_bits[] = {
   0xf0, 0x00, 0xf8, 0x01, 0x0c, 0x03, 0x0c, 0x03, 0x80, 0x01, 0xc0, 0x00,
   0x60, 0x00, 0x60, 0x00, 0x60, 0x00, 0x00, 0x00, 0x60, 0x00, 0x60, 0x00};
 "
 image create bitmap mine -data "
 #define mine_width 12
 #define mine_height 12
 static unsigned char mine_bits[] = {
   0x00, 0x00, 0x42, 0x08, 0xf4, 0x05, 0xf8, 0x03, 0xec, 0x07, 0xec, 0x07,
   0xfe, 0x0f, 0xfc, 0x07, 0xfc, 0x07, 0xf8, 0x03, 0xf4, 0x05, 0x42, 0x08};
 "
 image create bitmap wrong -background red -data "
 #define wrong_width 12
 #define wrong_height 12
 static unsigned char wrong_bits[] = {
   0x00, 0x00, 0x40, 0x00, 0xf0, 0x01, 0xf0, 0x00, 0x64, 0x06, 0x0c, 0x07,
   0x9e, 0x0f, 0x0c, 0x07, 0x64, 0x06, 0xf0, 0x00, 0xf0, 0x01, 0x40, 0x00};
 " -maskdata "
 #define wrong_width 12
 #define wrong_height 12
 static unsigned char wrong_bits[] = {
   0x00, 0x00, 0x42, 0x0c, 0xf6, 0x07, 0xfc, 0x03, 0xec, 0x07, 0xfc, 0x07,
   0xfe, 0x0f, 0xfc, 0x07, 0xfc, 0x07, 0xfc, 0x03, 0xf6, 0x07, 0x42, 0x0c};
 "
 set numb(0) "
 #define 0_width 12
 #define 0_height 12
 static unsigned char 0_bits[] = {
   0xf0, 0x01, 0xf8, 0x03, 0x18, 0x03, 0x18, 0x03, 0x18, 0x03, 0x18, 0x03,
   0x18, 0x03, 0x18, 0x03, 0x18, 0x03, 0x18, 0x03, 0xf8, 0x03, 0xf0, 0x01};
 "
 set numb(1) "
 #define 1_width 12
 #define 1_height 12
 static unsigned char 1_bits[] = {
   0xe0, 0x00, 0xe0, 0x00, 0xc0, 0x00, 0xc0, 0x00, 0xc0, 0x00, 0xc0, 0x00,
   0xc0, 0x00, 0xc0, 0x00, 0xc0, 0x00, 0xc0, 0x00, 0xf0, 0x03, 0xf0, 0x03};
 "
 set numb(2) "
 #define 2_width 12
 #define 2_height 12
 static unsigned char 2_bits[] = {
   0xf8, 0x03, 0xf8, 0x03, 0x18, 0x03, 0x18, 0x03, 0x00, 0x03, 0x80, 0x03,
   0xc0, 0x01, 0xe0, 0x00, 0x70, 0x00, 0x38, 0x00, 0xf8, 0x03, 0xf8, 0x03};
 "
 set numb(3) "
 #define 3_width 12
 #define 3_height 12
 static unsigned char 3_bits[] = {
   0xf8, 0x03, 0xf8, 0x03, 0x00, 0x03, 0x00, 0x03, 0x00, 0x03, 0xf0, 0x03,
   0xf0, 0x03, 0x00, 0x03, 0x00, 0x03, 0x00, 0x03, 0xf8, 0x03, 0xf8, 0x03};
 "
 set numb(4) "
 #define 4_width 12
 #define 4_height 12
 static unsigned char 4_bits[] = {
   0x18, 0x00, 0x18, 0x00, 0x98, 0x01, 0x98, 0x01, 0x98, 0x01, 0x98, 0x01,
   0xf8, 0x03, 0xf8, 0x03, 0x80, 0x01, 0x80, 0x01, 0x80, 0x01, 0x80, 0x01};
 "
 set numb(5) "
 #define 5_width 12
 #define 5_height 12
 static unsigned char 5_bits[] = {
   0xf8, 0x03, 0xf8, 0x03, 0x18, 0x00, 0x18, 0x00, 0x18, 0x00, 0xf8, 0x01,
   0xf0, 0x03, 0x00, 0x03, 0x00, 0x03, 0x00, 0x03, 0xf8, 0x03, 0xf8, 0x01};
 "
 set numb(6) "
 #define 6_width 12
 #define 6_height 12
 static unsigned char 6_bits[] = {
   0xf8, 0x03, 0xf8, 0x03, 0x18, 0x00, 0x18, 0x00, 0x18, 0x00, 0xf8, 0x03,
   0xf8, 0x03, 0x18, 0x03, 0x18, 0x03, 0x18, 0x03, 0xf8, 0x03, 0xf8, 0x03};
 "
 set numb(7) "
 #define 7_width 12
 #define 7_height 12
 static unsigned char 7_bits[] = {
   0xf8, 0x03, 0xf8, 0x03, 0x00, 0x03, 0x00, 0x03, 0x00, 0x03, 0x80, 0x03,
   0xc0, 0x01, 0xc0, 0x00, 0xc0, 0x00, 0xc0, 0x00, 0xc0, 0x00, 0xc0, 0x00};
 "
 set numb(8) "
 #define 8_width 12
 #define 8_height 12
 static unsigned char 8_bits[] = {
   0xf8, 0x03, 0xf8, 0x03, 0x18, 0x03, 0x18, 0x03, 0x18, 0x03, 0xf8, 0x03,
   0xf8, 0x03, 0x18, 0x03, 0x18, 0x03, 0x18, 0x03, 0xf8, 0x03, 0xf8, 0x03};
 "
 set numb(9) "
 #define 9_width 12
 #define 9_height 12
 static unsigned char 9_bits[] = {
   0xf8, 0x03, 0xf8, 0x03, 0x18, 0x03, 0x18, 0x03, 0x18, 0x03, 0xf8, 0x03,
   0xf8, 0x03, 0x00, 0x03, 0x00, 0x03, 0x00, 0x03, 0xf8, 0x03, 0xf8, 0x03};
 "

 image create bitmap 0 -data [blank cget -data]
 #image create bitmap 0 -data $numb(0) -foreground #646464
 image create bitmap 1 -data $numb(1) -foreground #0000ff
 image create bitmap 2 -data $numb(2) -foreground #00c800 ;# 00c850
 image create bitmap 3 -data $numb(3) -foreground #ff0000
 image create bitmap 4 -data $numb(4) -foreground #0000af
 image create bitmap 5 -data $numb(5) -foreground #ff00ff
 image create bitmap 6 -data $numb(6) -foreground #00c8c8
 image create bitmap 7 -data $numb(7) -foreground #b400b4
 image create bitmap 8 -data $numb(8) -foreground #000000

 proc setmode {mode} {
    global board modes

    set m [string range $mode 1 3]
    if {! [info exists modes($m,XSize)]} { return 0 }

    set board(XSize) $modes($m,XSize)
    set board(YSize) $modes($m,YSize)
    set board(Mines) $modes($m,Mines)
    return 1
 }
 ##+##########################################################################
 #
 # reveal -- Shows all the mines, and mistakes if victory is false
 #
 proc reveal {victory} {
    global board Map

    foreach coord $Map(Bombs) {
        foreach {x y} $coord break
        if {$victory} {
            if {! $board(mark,$x,$y)} {
                mark $x $y
            }
            continue
        } else {
            if {! $board(mark,$x,$y)} {
                .field.y$y.x$x configure -relief flat -image mine
            }
        }
        # Remove from the flags coordinate list
        set f [ lsearch $Map(Flags) $coord ]
        if { $f > -1 } {
            set Map(Flags) [ lreplace $Map(Flags) $f $f ]
        }
    }
    if {$victory} return

    # show mistakes, i.e. anything left in the flag coordinate list
    foreach coord $Map(Flags) {
        set j [ lindex $coord 1 ]
        set i [ lindex $coord 0 ]
        .field.y$j.x$i configure -relief flat -image wrong
    }
 }
 ##+##########################################################################
 #
 # done -- Finished, show results
 #
 proc done { type } {
    after cancel timer
    .status.butn configure -image $type
    reveal [string equal $type "shades"]
 }
 ##+##########################################################################
 #
 # step -- step on a square.
 # Value: mark, nop         if square is marked
 #        seen, nop         if square already stepped on
 #        mine, game over   if square is a mine
 #        #,    open        otherwise
 #
 proc step { x y } {
    global board

    if {$board(mark,$x,$y)} { return "mark" }
    bind .field.y$y.x$x <Button-1> break        ;# disable buttonclicks.
    # use white background for all seen squares
    .field.y$y.x$x configure -background white -activebackground white

    set type $board(type,$x,$y)
    if { $type == "seen" } { return $type }
    if { $type == "mine" } {                    ;# stepped on a mine! game over.
        .field.y$y.x$x configure -background red
        .field.y$y.x$x configure -activebackground red
        done croak
        return $type
    }
    .field.y$y.x$x configure -relief flat -image $board(type,$x,$y)
    set board(type,$x,$y) seen
    set board(mark,$x,$y) -1
    if {[incr board(Unseen) -1] == 0} { done shades }

    return $type
 }
 proc updatestatus {} {
    set ::status(count) [ format "%03d" $::player(count) ]
    set ::status(scnds) [ format "%03d" $::player(elapsed) ]
 }
 # game clock
 proc timer {} {
    set ::player(elapsed) [expr {[clock seconds] - $::player(start)}]
    after 1000 timer
    updatestatus
 }
 proc blink {how who} {
    set win .field
    foreach coord $who {
        foreach {x y} $coord {
            if {$how} {
                $win.y$y.x$x config -relief flat
            } else {
                $win.y$y.x$x config -relief raised
            }
        }
    }
    update idletasks
 }
 ##+##########################################################################
 #
 # oop -- Toggles the smiley face w/ the oops face
 #
 proc oop { how } {
    global board
    if {$board(Unseen) == 0} return             ;# If done, don't animate
    set image smiley
    if {$how} {
        set image oops
    }
    .status.butn config -image $image
 }
 ##+##########################################################################
 #
 # pop
 #
 # It clears around an uncovered numbered mine. Clearing involves stepping
 # on any unmarked & unseen neighboring squares providing:
 #  o there are exactly N squares marked as mines
 #
 # On button-down, it just sinks the neighboring squares
 # On button-up, it does the clearing
 #
 proc pop { down x y } {
    global board

    foreach {marked unseen} [neighbors $x $y] break
    blink $down $unseen

    if {$down} return                           ;# Don't clear on button-down
    if { $board(type,$x,$y) != "seen" } return  ;# Ignore if not yet uncovered

    set missing [expr {$board(was,$x,$y) - $marked}]
    if {$missing == 0} {
        foreach coord $unseen {
            foreach {xx yy} $coord break
            look $xx $yy
        }
    } elseif { $missing == [llength $unseen] } {
        ;# all unseen neighbors are mines
        ;#puts "obvious"
    }
 }
 ##+##########################################################################
 #
 # neighbors -- Returns number of marked neighbors and list of unseen neighbors.
 #
 proc neighbors {x y} {
    global board

    set unseen {}                               ;# Unseen neighbors
    set marked 0                                ;# Unmarked neighbors

    set ylist [list [expr {$y - 1}] $y [expr {$y + 1}]]
    set xlist [list [expr {$x - 1}] $x [expr {$x + 1}]]
    foreach yy $ylist {
        if { $yy < 0 || $yy >= $board(YSize) } continue
        foreach xx $xlist {
            if { $xx < 0 || $xx >= $board(XSize) } continue
            if { $yy == $y && $xx == $x } continue
            if {$board(mark,$xx,$yy) == 1} {
                incr marked
            } elseif { $board(type,$xx,$yy) != "seen" } {
                lappend unseen [list $xx $yy]
            }
        }
    }
    return [list $marked $unseen]
 }

 ##+##########################################################################
 #
 # look -- examine a square. Returns 1 if we die
 #
 proc look {x y} {
    global board timing player

    if { $player(timing) == 0 } {               ;# start the game clock.
        incr player(timing)
        after 1000 timer
    }

    set type [ step $x $y ]                 ;# "step" on it to see what's there.
    if { $type == "mine" } { return 1}
    if { $type == "mark" } { return 0}
    if { $type == "seen" } { return 0}

    auto
    if { $type > 0 } { return 0}

    # no mine(s) near by. check out neighbouring squares.
    set ylist [list [expr {$y - 1}] $y [expr {$y + 1}]]
    set xlist [list [expr {$x - 1}] $x [expr {$x + 1}]]

    incr player(inauto)                         ;# Turn off auto mode
    foreach j $ylist {
        if { $j < 0 || $j >= $board(YSize) } continue
        foreach i $xlist {
            if { $i < 0 || $i >= $board(XSize) } continue
            if { $j != $y || $i != $x } {
                look $i $j
            }
        }
    }
    incr player(inauto) -1                      ;# Turn back on auto mode
    auto
    return 0
 }
 ##+##########################################################################
 #
 # mark -- Marks a square, toggling between blank -> flag -> qmark -> blank
 #   qmark is toggled by player(marks)
 #
 proc mark { x y} {
    global player Map board

    set coord [ list $x $y ]

    # mark of -1 means already seen
    # cycle: blank (0) -> flag (1) -> qmark (2) -> blank (0)
    switch -- $board(mark,$x,$y) {
        -1 {return 0}
        0 { set bm flag
            incr player(count) -1
            lappend Map(Flags) $coord
            set board(mark,$x,$y) 1
        }
        1 { incr player(count)
            set f [ lsearch $Map(Flags) $coord ]
            if { $f > -1 } {
                set Map(Flags) [ lreplace $Map(Flags) $f $f ]
            }
            if {$player(marks)} {
                set bm qmark
                set board(mark,$x,$y) 2
            } else {
                set bm blank
                set board(mark,$x,$y) 0
            }
        }
        2 { set board(mark,$x,$y) 0
            set bm blank
        }
    }
    .field.y$y.x$x configure -image $bm
    if {$board(mark,$x,$y) > 0} {
        bind .field.y$y.x$x <Button-1> break
    } else {
        bind .field.y$y.x$x <Button-1> [list oop 1]
    }
    auto
    updatestatus
    return 0
 }
 # build the minefield. initialize settings.
 proc initboard {{force 0}} {
    global board Map player

    # Clear the board and randomize: we put all the positions into an
    # associative array keyed by a random number, and extract out the
    # first N keys for where the mines go

    catch {unset all}
    for { set y -1 } { $y <= $board(YSize) } { incr y } {
        for { set x -1 } { $x <= $board(XSize) } { incr x } {
            set board(type,$x,$y) 0             ;# No neighboring mines yet
            set board(mark,$x,$y) 0             ;# 0 blank, 1 marked
            set board(was,$x,$y)  0             ;# Copy of type
            if {$y == -1            || $x == -1}            continue
            if {$y == $board(YSize) || $x == $board(XSize)} continue

            set a [expr {rand()}]
            set all($a) [list $x $y]
        }
    }

    expr {srand([expr {$board(Seed) == -1 ? [clock clicks] : $board(Seed)}])}
    if {$board(ratio) > 0.0} {
        set v [ expr {$board(ratio) * $board(XSize) * $board(YSize) + 0.5} ]
        set board(Mines) [ expr {int($v)} ]
    }

    set mines $board(Mines)

    set Map(Bombs) {}
    set Map(Flags) {}

    foreach coord [array name all] {
        if {$mines == 0} break;
        foreach {x y} $all($coord) break

        set board(type,$x,$y) mine
        set board(was,$x,$y) mine
        incr mines -1
        lappend Map(Bombs) [ list $x $y ]

        set ylist [list [expr {$y - 1}] $y [expr {$y + 1}]]
        set xlist [list [expr {$x - 1}] $x [expr {$x + 1}]]

        # increment neighbour's counts.
        foreach j $ylist {
            foreach i $xlist {
                if { [string compare $board(type,$i,$j) "mine"] } {
                    incr board(type,$i,$j)
                    incr board(was,$i,$j)
                }
            }
        }
    }

    set player(count) $board(Mines)
    set player(inauto) 0
    set board(Unseen) [expr {($board(XSize) * $board(YSize)) - $board(Mines)}]

    set win .field
    if {!$force && [winfo exists $win]} {
        fixboard
    } else {
        catch { destroy $win }
        frame $win -relief ridge -bd 8
        pack $win -side bottom -fill both -expand 1

        for { set y 0 } { $y < $board(YSize) } { incr y } {
            frame $win.y$y
            for { set x 0 } { $x < $board(XSize) } { incr x } {
                set b $win.y$y.x$x
                button $b -bd 2 -highlightthickness 0 -image blank
                set bgnd [ $b cget -background ]
                $b configure -activebackground $bgnd
                $b config -command [list look $x $y]
                #bind $b <Button-1> "look $x $y"
                bind $b <Button-1> "oop 1"
                bind $b <ButtonRelease-1> "oop 0"
                bind $b <Button-2> "pop 1 $x $y; oop 1"
                bind $b <ButtonRelease-2> "pop 0 $x $y; oop 0"
                bind $b <Shift-Button-3> "pop 1 $x $y ; oop 1"
                bind $b <Shift-ButtonRelease-3> "pop 0 $x $y ; oop 0"
                bind $b <Button-3> "mark $x $y"
                pack $b -side left -expand 1 -fill both
            }
            pack $win.y$y -expand 1 -fill both
        }
    }
    after cancel timer
    set player(elapsed) 0
    set player(start) [clock seconds]
    set player(timing) 0
    updatestatus

    .status.butn configure -image smiley
    .status.butn configure -command initboard
    bind . <F2> initboard
    bind . <Control-a> [list auto 1]
    bind . <Control-z> [list zero]
    bind . <Control-x> [list zero 1]
 }
 ##+##########################################################################
 #
 # fixboard
 #
 # Resets the board buttons to starting state without
 # destroying and rebuilding it.
 #
 proc fixboard {} {
    global board

    catch {destroy .xyz}                        ;# Default background color
    button .xyz
    set bgnd [.xyz cget -bg]
    catch {destroy .xyz}

    set win .field
    for { set y 0 } { $y < $board(YSize) } { incr y } {
        for { set x 0 } { $x < $board(XSize) } { incr x } {
            set b $win.y$y.x$x
            $b config -image blank -relief raised
            $b config -background $bgnd -activebackground $bgnd
            bind $win.y$y.x$x <Button-1> "oop 1"
        }
    }
 }
 ##+##########################################################################
 #
 # cheat -- Prints out an text version of the board
 #
 proc cheat {} {
    global board
    for { set y 0 } { $y < $board(YSize) } { incr y } {
        for { set x 0 } { $x < $board(XSize) } { incr x } {
            if {$board(type,$x,$y) == "mine"} {
                puts -nonewline "B"
            } else {
                puts -nonewline "."
            }
        }
        puts ""
    }
 }
 ##+##########################################################################
 #
 # zero -- Finds a random safe position on the board
 #
 proc zero {{safe 0}} {
    global board

    set zero ""
    set zero2 ""
    for { set y 0 } { $y < $board(YSize) } { incr y } {
        for { set x 0 } { $x < $board(XSize) } { incr x } {
            if {$board(type,$x,$y) == 0} {
                lappend zero [list $x $y]
            } elseif {$safe && [string is int $board(type,$x,$y)]} {
                lappend zero [list $x $y]
                lappend zero2 [list $x $y]
            }
        }
    }
    set l [llength $zero]
    if {$l == 0} {set zero $zero2}
    set l [llength $zero]
    if {$l == 0} return
    set n [expr {int ($l * rand())}]
    set pos [lindex $zero $n]
    eval look $pos
 }
 # choose another mode and restart (invoked by the "Mode" menu).
 proc newmode { type } {
    setmode "-$type"
    initboard 1
 }
 # display help information (invoked by the "Help" menu).
 proc help {} {
    set w .help
    catch {destroy $w}
    wm title [toplevel $w] "TkMines Help"
    focus $w
    text $w.t -border 5 -relief flat -wrap word -yscrollcommand [list $w.s set]
    scrollbar $w.s -orient v -command [list $w.t yview]

    frame $w.bottom -bd 2 -relief ridge
    button $w.b -text "Dismiss" -command [list destroy $w]
    pack $w.bottom -side bottom -fill both
    pack $w.b -side bottom -expand 1 -pady 10 -in $w.bottom
    pack $w.s -fill y -side right
    pack $w.t -fill both -expand 1 -side left
    focus $w.t

    $w.t tag config hdr -font {Times 16}
    $w.t tag config hdr2 -font {Times 9 bold}
    $w.t tag config fix -font {Courier 9} -lmargin1 10 -lmargin2 10
    set n [font measure [$w.t cget -font] "* "]
    $w.t tag config blt -lmargin1 5 -lmargin2 [expr {5 + $n}]

    $w.t insert end "Overview" hdr \n\n
    set m "TkMines is a tcl/tk port of the popular Windows game of "
    append m "Minesweeper with a few extra features."
    append m "The object of the game is to locate all mines. If you "
    append m "uncover a mine, you lose the game.\n\n"
    $w.t insert end $m

    set m "This version contains all the features of the standard Windows "
    append m "version including the middle button functionality, plus is has a "
    append m "few extra features to eliminate some of the mechanical aspects "
    append m "of the games. See the \"Extra Menu\" section below for "
    append m "details.\n\n"
    $w.t insert end $m

    $w.t insert end "Starting a new game" hdr \n\n
    $w.t insert end "* To start a new game either click on the " blt
    $w.t insert end "smiley face or click on New on the Game menu.\n" blt
    $w.t insert end "* To change the size of the board, select Beginner, " blt
    $w.t insert end "Intermediate or Expert on the Game menu.\n\n" blt

    $w.t insert end "Playing TkMines" hdr \n\n
    $w.t insert end "* Click on a square to uncover it. " blt
    $w.t insert end "If you uncover a mine you lose." blt \n
    $w.t insert end "* If a number appears on a square, " blt
    $w.t insert end "it indicates how many of the eight neighboring " blt
    $w.t insert end "squares contain mines." blt \n
    $w.t insert end "* Right clicking on a square will mark it as a mine" blt \n
    $w.t insert end "* Middle clicking on a numbered square " blt
    $w.t insert end "will uncover all unmarked neighboring squares if the " blt
    $w.t insert end "number of marked mines equals the square's number.\n\n" blt

    $w.t insert end "Command Line Options" hdr \n\n
    $w.t insert end "TkMines recognizes the following command line options:\n"
    foreach line [split [string trim $::usage] \n] {
        $w.t insert end [string trim $line] fix \n
    }
    $w.t insert end \n

    $w.t insert end "Extra Menu" hdr \n\n

    set m "TkMines has two sets of extra features for solving the puzzle: one "
    append m "assists in the mechanical aspect of clearing mines, the other "
    append m "lets you cheat.\n\n"
    $w.t insert end $m

    $w.t insert end "The first extra feature I call "
    $w.t insert end "Auto Step." hdr2
    set m " The program searches the board for all numbered squares which "
    append m "have the correct number of marked neighboring bombs. When it "
    append m "finds such a square, it automatically uncovers all other "
    append m "neighboring squares. You can think of this as having the program "
    append m "pressing the middle button on every square of the board. "
    append m "You can have the program do this just once or always.\n\n"
    $w.t insert end $m

    set m "The second extra feature is a pure cheat. If you get stuck, you "
    append m "can have the program uncover an empty (non-bomb) square. Or it "
    append m "can uncover a lonely square--an empty square with no neighboring "
    append m "bombs.\n\n"
    append m "I typically start each game by revealing a lonely square.\n\n"
    $w.t insert end $m

    $w.t insert end "Credits" hdr \n\n
    set m "The original version was XMine by Greg Lesher ([email protected]) "
    append m "released January 1993. P. Kern ([email protected]) ported "
    append m "it to tcl/tk on February 18, 1999. This version, by "
    append m "Keith Vetter, is released in September, 2003. There's a totally "
    append m "separate version of TkMines by Joel Fine from October 1993 that "
    append m "runs under tclx."
    $w.t insert end $m
 }
 ##+##########################################################################
 #
 # DoDisplay  -- Draws the non-playing area of the display
 #
 proc DoDisplay {} {
    global board modes

    menu .m -tearoff 0
    .m add cascade -menu .m.game -label "Game" -underline 0
    .m add cascade -menu .m.extra -label  "Extra" -underline 0
    .m add cascade -menu .m.help -label "Help" -underline 0

    menu .m.game -tearoff 0
    .m.game add command -label "New" -command initboard -underline 0
    .m.game add separator
    set mlist { beg int exp }
    if {$board(custom) > 0} { lappend mlist usr }
    foreach mn $mlist {
        .m.game add command -command "newmode $mn" \
                -label $modes($mn,ident) -underline 0
    }
    .m.game add separator
    .m.game add checkbutton -label "Marks (?)" -underline 0 \
        -variable player(marks)
    .m.game add separator
    .m.game add command -label Exit -command exit -underline 1

    menu .m.extra -tearoff 0
    .m.extra add checkbutton -label "Auto Step" -command AutoToggle \
        -underline 0 -variable player(auto)
    .m.extra add command -label "Auto Step Once" -accelerator "Ctrl-A" \
        -command {auto 1} -underline 10
    AutoToggle ;# Set state of previous entry
    .m.extra add separator
    .m.extra add command -label "Step Empty Square" \
        -command {zero 1} -underline 5
    .m.extra add command -label "Step Lonely Square" -accelerator "Ctrl-Z" \
        -command zero -underline 5

    menu .m.help -tearoff 0
    .m.help add command -command help -label "Help"
    . configure -menu .m

    #####
    # set up the status display.
    set font [eval font create [font actual 12x24]]
    font configure $font -weight bold

    set win .status
    frame $win -relief ridge -bd 8
    button $win.butn -bd 3 -image smiley
    label $win.minesleft -textvariable status(count) -anchor e \
            -relief sunken -foreground red -background black \
            -font $font -width 3
    label $win.seconds -textvariable status(scnds) -anchor e \
            -relief sunken -foreground red -background black \
            -font $font -width 3
    pack $win.minesleft -side left -pady 1m -padx 1m
    pack $win.seconds -side right  -pady 1m -padx 1m
    pack $win.butn -side left -expand 1 ;#-before $win.minesleft
    pack $win -side top -fill both
    
    # set the size after first creation to the minimum size
    after 1000 {catch {wm minsize . [lindex [split [wm geometry .] x+] 0] \
        [lindex [split [wm geometry .] x+] 1]}}

 }
 ##+##########################################################################
 #
 # auto -- Loops through every square seeing if it is eligible for assistance.
 #
 proc auto {{once 0}} {
    global board player
    if {! $once && !$player(auto)} return
    if {$player(inauto)} return
    incr player(inauto) 1

    set action(1) "look"
    set action(2) "mark"

    set changes 0
    set change 1
    while {$change} {
        set change 0

        for { set x 0 } { $x < $board(XSize) } { incr x } {
            for { set y 0 } { $y < $board(YSize) } { incr y } {
                foreach {what who} [auto2 $x $y] break
                if {$what == 0} continue
                set change 1
                incr changes
                foreach pos $who {
                    set die [eval $action($what) $pos]
                    if {$die} {return $changes}
                }
                if {$once > 0} {
                    incr player(inauto) -1
                    return $changes
                }
            }
        }
        update idletasks
        if {$once > 0} break
    }
    incr player(inauto) -1
    return $changes
 }
 ##+##########################################################################
 #
 # auto2 -- Determines if square X Y is either:
 #  o has all its needed mines
 #    => step on all it's unseen neighbors
 #    => value: 1 <neighbor list>
 #
 #  o has the same amount of unseen neighbors as missing mines
 #    => mark all unseen neighbors as mines
 #    => value: 2 <neighbor list>
 #
 proc auto2 {x y} {
    global board

    if {$board(type,$x,$y) != "seen"} { return 0 }
    if {$board(was,$x,$y) == 0} { return 0 }
    foreach {marked unseen} [neighbors $x $y] break
    set l [llength $unseen]
    if {$l == 0} {return 0}

    if {$marked == $board(was,$x,$y)} {
        return [list 1 $unseen]
    }
    set missing [expr {$board(was,$x,$y) - $marked}]
    if {$missing == $l} {
        return [list 2 $unseen]
    }
    return 0
 }
 proc AutoToggle {} {
    set state normal
    if {$::player(auto)} { set state disabled }
    .m.extra entryconfigure 1 -state $state
 }

 #+##############################################################

 setmode "-exp"                                  ;# Set the default mode

 # parse command-line arguments.
 set ac 0
 foreach arg $argv {
    incr ac
    if {[ setmode $arg ] != 0} continue
    set field ""
    switch -glob -- $arg {
        -x  { set field XSize }
        -y  { set field YSize }
        -mines  { set field Mines }
        -ratio  { set board(ratio) [ lindex $argv $ac] }
        -seed   { set board(Seed) [ lindex $argv $ac] }
        -*  { puts stderr "$argv0 options: $usage"; exit 0 }
    }
    if {$field != ""} {
        set board($field) [ lindex $argv $ac ]
        set board(custom) 1

    }
 }
 if {$board(custom) > 0} {                      ;# save custom choices
    foreach field { XSize YSize Mines } {
        set modes(usr,$field) $board($field)
    }
 }
 DoDisplay
 initboard

• Home
• Recent changes
• Help
• WhoAmI/Logout
• Create new page
• Random page
• Previous page
• Next page
• 
  
• Add comments
• Edit
• History
• Edit summary
• References