HZe 16-OCT-2005 : I like this one. And I appreciate every game that's available as Tcl/Tk version. I added some features, I hope you like it:
- 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
DKF 24-Nov-2005: Bug report time :-)
- 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, pkern@utcc.utoronto.ca, 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 (lesher@cns.bu.edu) "
append m "released January 1993. P. Kern (pkern@utcc.utoronto.ca) 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
initboarduniquename 2013aug01The image above is stored at 'external site' imageshack.us. In case that image goes dead, here is a 'locally stored' image, stored at this wiki.
