[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 [http://cns.utoronto.ca/~pkern/stuff/tkmines]. A C and tcl version based on tclx by Joel Fine can be found at [ftp://ftp.procplace.com/pub/tcl/sorted/packages-7.6/unknown/tkmines.1.5.shar.gz]. ---- #!/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 x dimension of board. -y y dimension of board. -mines number of mines. -ratio ratio of mines to board squares. -seed 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 break ;# disable buttonclicks. 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 break } else { bind .field.y$y.x$x [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 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 "look $x $y" bind $b "oop 1" bind $b "oop 0" bind $b "pop 1 $x $y; oop 1" bind $b "pop 0 $x $y; oop 0" bind $b "pop 1 $x $y ; oop 1" bind $b "pop 0 $x $y ; oop 0" bind $b "mark $x $y" pack $b -side left } pack $win.y$y } } 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 . initboard bind . [list auto 1] bind . [list zero] bind . [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 "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 } ##+########################################################################## # # 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 # # o has the same amount of unseen neighbors as missing mines # => mark all unseen neighbors as mines # => value: 2 # 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 ---- [Category Games] | [Tcl/Tk games] | [Category Application] ----