tkmines
Keith Vetter 2003-09-24 : There haven't been enough light entertainment pages put up on wiki recently so I thought I'd dredge up this game I revised many years ago.
P. Kern ported a simple version of XMines to tcl/tk back in 1999, but he left out what I think is the most important feature--the middle button. Those who just dabble with minesweeper probably don't know this feature, but those who want fast times rely on it heavily.
I've also added two extra features. The first, inspired by a shareware program called MineHelp, automatically uncovers neighboring squares when a numbered square has the correct number of neighboring bombs.
The second extra feature is to cheat and have the program uncover an empty or lonely square. Before you dismiss this as too cheaty, let me say that when used in a certain limited way it is extremely helpful--to wit, I use it once when beginning a new game to get something to work with (as opposed to randomly clicking squares until one pops).
The original P. Kern version can found at [L1 ]. A C and tcl version based on tclx by Joel Fine can be found at [L2 ].
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.
Jeff Smith 2019-05-03 : Below is an online demo using CloudTk
#!/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
initboarduniquename 2013aug01
The 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.
Note the 'smiley-face-is-dead' image at the top of the GUI. I found a mine in one click.