home *** CD-ROM | disk | FTP | other *** search
Wrap
Path: uunet!news.tek.com!master!saab!billr From: billr@saab.CNA.TEK.COM (Bill Randle) Newsgroups: comp.sources.games Subject: v17i075: tkmines - minefield game in Tcl and Wish, Part01/01 Message-ID: <4927@master.CNA.TEK.COM> Date: 19 Apr 93 02:26:31 GMT Sender: news@master.CNA.TEK.COM Reply-To: joel@cs.berkeley.edu Lines: 1896 Approved: billr@saab.CNA.TEK.COM Xref: uunet comp.sources.games:1754 Submitted-by: Joel A. Fine <joel@postgres.berkeley.edu> Posting-number: Volume 17, Issue 75 Archive-name: tkmines/Part01 Environment: WISH, Extended Tcl [I don't have a copy of WISH, so I haven't tested this.... -br] #! /bin/sh # This is a shell archive. Remove anything before this line, then unpack # it by saving it into a file and typing "sh file". To overwrite existing # files, type "sh file -c". You can also feed this as standard input via # unshar, or by typing "sh <file", e.g.. If this archive is complete, you # will see the following message at the end: # "End of archive 1 (of 1)." # Contents: README MANIFEST Changes Hdr Make.config Makefile ToDo # bitmaps bitmaps/0 bitmaps/1 bitmaps/2 bitmaps/3 bitmaps/4 # bitmaps/5 bitmaps/6 bitmaps/7 bitmaps/8 bitmaps/empty # bitmaps/grey.25 bitmaps/grey.5 bitmaps/mark bitmaps/mine # bitmaps/unfoundMine bitmaps/wrongMine help src/gripe.tcl # src/high.tcl src/init.tcl src/load.tcl src/mines.tcl src/misc.tcl # src/parseArgs.tcl src/random.tcl src/start.tcl src/util.tcl # Wrapped by billr@saab on Sun Apr 18 19:23:11 1993 PATH=/bin:/usr/bin:/usr/ucb ; export PATH if test -f 'README' -a "${1}" != "-c" ; then echo shar: Will not clobber existing file \"'README'\" else echo shar: Extracting \"'README'\" \(824 characters\) sed "s/^X//" >'README' <<'END_OF_FILE' XWelcome to tkmines! This program requires wish and extended Tcl, Xavailable from sprite.berkeley.edu. X XFeel free to send this to your friends. If you like it, please let me Xknow. If you hate it, please let me know. Please leave my name Xattached somewhere if you pass it along. X XTo run: X Xedit the file "Make.config" to point to your copy of (EXTENDED) wish, Xand to indicate where you want tkmines installed. X XThen, just run the program: X> tkmines X XSee the file "help" in this directory for instructions. X XJoel Fine Xjoel@cs.berkeley.edu X X----------------------------------------------------------------------- XIF YOU DO NOT HAVE WISH AND EXTENDED TCL: XAnonymous ftp from sprite.berkeley.edu, directory "tcl": get Xtk3.2.tar.Z, tcl6.7.tar.Z, tclX6.5c.tar.Z. Uncomress, untar, and Xfollow the instructions in the README's therein. END_OF_FILE if test 824 -ne `wc -c <'README'`; then echo shar: \"'README'\" unpacked with wrong size! fi # end of 'README' fi if test -f 'MANIFEST' -a "${1}" != "-c" ; then echo shar: Will not clobber existing file \"'MANIFEST'\" else echo shar: Extracting \"'MANIFEST'\" \(1199 characters\) sed "s/^X//" >'MANIFEST' <<'END_OF_FILE' X File Name Archive # Description X----------------------------------------------------------- X Changes 1 X Hdr 1 X MANIFEST 1 This shipping list X Make.config 1 X Makefile 1 X README 1 X ToDo 1 X bitmaps 1 X bitmaps/0 1 X bitmaps/1 1 X bitmaps/2 1 X bitmaps/3 1 X bitmaps/4 1 X bitmaps/5 1 X bitmaps/6 1 X bitmaps/7 1 X bitmaps/8 1 X bitmaps/empty 1 X bitmaps/grey.25 1 X bitmaps/grey.5 1 X bitmaps/mark 1 X bitmaps/mine 1 X bitmaps/unfoundMine 1 X bitmaps/wrongMine 1 X help 1 X src/gripe.tcl 1 X src/high.tcl 1 X src/init.tcl 1 X src/load.tcl 1 X src/mines.tcl 1 X src/misc.tcl 1 X src/parseArgs.tcl 1 X src/random.tcl 1 X src/start.tcl 1 X src/util.tcl 1 END_OF_FILE if test 1199 -ne `wc -c <'MANIFEST'`; then echo shar: \"'MANIFEST'\" unpacked with wrong size! fi # end of 'MANIFEST' fi if test -f 'Changes' -a "${1}" != "-c" ; then echo shar: Will not clobber existing file \"'Changes'\" else echo shar: Extracting \"'Changes'\" \(548 characters\) sed "s/^X//" >'Changes' <<'END_OF_FILE' XNew in Release 1.2: X------------------- XHigh score list X XRedone "custom" board size intfce X X XNew in Release 1.1: X------------------- XFaster resizing & board creation X XLazy evaluation of neighbor counts (gradually counts mines at neighbor Xsquares, unless immediate evaluation is called for) X XGripe facility X XDebugging facilities for performance profiling X XTest for extended TCL before assuming it's there X XBetter arg-parsing: width, height, mines X XMonochrome support X XMax board-size: fills the screen X XAccurate message in README as to tclX location END_OF_FILE if test 548 -ne `wc -c <'Changes'`; then echo shar: \"'Changes'\" unpacked with wrong size! fi # end of 'Changes' fi if test -f 'Hdr' -a "${1}" != "-c" ; then echo shar: Will not clobber existing file \"'Hdr'\" else echo shar: Extracting \"'Hdr'\" \(926 characters\) sed "s/^X//" >'Hdr' <<'END_OF_FILE' XFrom joel@postgres.Berkeley.EDU Wed Apr 14 15:51:58 1993 XReceived: from master.CNA.TEK.COM by saab.CNA.TEK.COM (4.1/6.24) X id AA04535; Wed, 14 Apr 93 15:51:55 PDT XReceived: from tektronix.TEK.COM by master.CNA.TEK.COM (4.1/7.1) X id AA16281; Wed, 14 Apr 93 15:51:34 PDT XReceived: from saffron.CS.Berkeley.EDU ([128.32.150.4]) by tektronix.TEK.COM (4.1/8.0) X id AA11020; Wed, 14 Apr 93 15:51:51 PDT XReceived: by saffron.CS.Berkeley.EDU (5.57/Ultrix3.0-C) id AA08856; Wed, 14 Apr 93 15:53:25 -0700 XDate: Wed, 14 Apr 93 15:53:25 -0700 XFrom: Joel A. Fine <joel@postgres.berkeley.edu> XMessage-Id: <9304142253.AA08856@saffron.CS.Berkeley.EDU> XTo: billr@saab.CNA.TEK.COM (Bill Randle) XSubject: Re: Game submission XReferences: <9304142229.AA08483@saffron.CS.Berkeley.EDU> X <joel@postgres.berkeley.edu> X <9304141543.ZM4528@saab> XReply-To: joel@cs.berkeley.edu XStatus: OR X XOK, here it is. I just posted it to comp.lang.tcl, by the way. X END_OF_FILE if test 926 -ne `wc -c <'Hdr'`; then echo shar: \"'Hdr'\" unpacked with wrong size! fi # end of 'Hdr' fi if test -f 'Make.config' -a "${1}" != "-c" ; then echo shar: Will not clobber existing file \"'Make.config'\" else echo shar: Extracting \"'Make.config'\" \(318 characters\) sed "s/^X//" >'Make.config' <<'END_OF_FILE' X# WISH is the location of your Extended tcl wish binary XWISH = /usr/sww/X11/bin/wishX X X# LIB_DIR is the directory where you would like the source code installed XLIB_DIR = /home/sequoia/joel/local/lib/tkmines X X# BIN_DIR is the directory where you would like the executable installed XBIN_DIR = /home/sequoia/joel/bin END_OF_FILE if test 318 -ne `wc -c <'Make.config'`; then echo shar: \"'Make.config'\" unpacked with wrong size! fi # end of 'Make.config' fi if test -f 'Makefile' -a "${1}" != "-c" ; then echo shar: Will not clobber existing file \"'Makefile'\" else echo shar: Extracting \"'Makefile'\" \(871 characters\) sed "s/^X//" >'Makefile' <<'END_OF_FILE' X# Don't even THINK about changing this file. 8^) Xinclude Make.config X XVERSION = 1.2 X XSOURCE_DIR = $(LIB_DIR)/src XSCORE_FILE = $(LIB_DIR)/scores XHELP_FILE = $(LIB_DIR)/help XLOAD_FILE = $(SOURCE_DIR)/load.tcl" X Xinstall: tkmines X - mkdir $(LIB_DIR) X cp -p tkmines $(BIN_DIR) X cp -rp src $(LIB_DIR)/src X cp -rp bitmaps $(LIB_DIR)/bitmaps X cp -rp help $(LIB_DIR)/help X touch $(SCORE_FILE) X chmod 777 $(SCORE_FILE) X @echo tkmines is now installed. X Xtkmines: X @echo > $@ "#! $(WISH) -f" X @echo >> $@ "set version $(VERSION)" X @echo >> $@ "set libDir "$(LIB_DIR)" X @echo >> $@ "set sourceDir $(SOURCE_DIR)" X @echo >> $@ "set scoreFile $(SCORE_FILE)" X @echo >> $@ "set helpFile $(HELP_FILE)" X @echo >> $@ "source $(LOAD_FILE)" X chmod +x $@ X Xclean: X rm -rf $(LIB_DIR) tkmines $(BIN_DIR)/tkmines X Xtidy: X rm -rf *~ */*~ tkmines X Xshar: tidy X shar -v . > ../tkmines.$(VERSION).shar END_OF_FILE if test 871 -ne `wc -c <'Makefile'`; then echo shar: \"'Makefile'\" unpacked with wrong size! fi # end of 'Makefile' fi if test -f 'ToDo' -a "${1}" != "-c" ; then echo shar: Will not clobber existing file \"'ToDo'\" else echo shar: Extracting \"'ToDo'\" \(19 characters\) sed "s/^X//" >'ToDo' <<'END_OF_FILE' XReset high scores? END_OF_FILE if test 19 -ne `wc -c <'ToDo'`; then echo shar: \"'ToDo'\" unpacked with wrong size! fi # end of 'ToDo' fi if test ! -d 'bitmaps' ; then echo shar: Creating directory \"'bitmaps'\" mkdir 'bitmaps' fi if test -f 'bitmaps/0' -a "${1}" != "-c" ; then echo shar: Will not clobber existing file \"'bitmaps/0'\" else echo shar: Extracting \"'bitmaps/0'\" \(266 characters\) sed "s/^X//" >'bitmaps/0' <<'END_OF_FILE' X#define 0_width 16 X#define 0_height 16 Xstatic char 0_bits[] = { X 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, X 0x00, 0x00, 0x80, 0x01, 0x80, 0x01, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, X 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00}; END_OF_FILE if test 266 -ne `wc -c <'bitmaps/0'`; then echo shar: \"'bitmaps/0'\" unpacked with wrong size! fi # end of 'bitmaps/0' fi if test -f 'bitmaps/1' -a "${1}" != "-c" ; then echo shar: Will not clobber existing file \"'bitmaps/1'\" else echo shar: Extracting \"'bitmaps/1'\" \(266 characters\) sed "s/^X//" >'bitmaps/1' <<'END_OF_FILE' X#define 1_width 16 X#define 1_height 16 Xstatic char 1_bits[] = { X 0x00, 0x00, 0x80, 0x01, 0x80, 0x01, 0x80, 0x01, 0x80, 0x01, 0x80, 0x01, X 0x80, 0x01, 0x80, 0x01, 0x80, 0x01, 0x80, 0x01, 0x80, 0x01, 0x80, 0x01, X 0x80, 0x01, 0x80, 0x01, 0x80, 0x01, 0x00, 0x00}; END_OF_FILE if test 266 -ne `wc -c <'bitmaps/1'`; then echo shar: \"'bitmaps/1'\" unpacked with wrong size! fi # end of 'bitmaps/1' fi if test -f 'bitmaps/2' -a "${1}" != "-c" ; then echo shar: Will not clobber existing file \"'bitmaps/2'\" else echo shar: Extracting \"'bitmaps/2'\" \(266 characters\) sed "s/^X//" >'bitmaps/2' <<'END_OF_FILE' X#define 2_width 16 X#define 2_height 16 Xstatic char 2_bits[] = { X 0x00, 0x00, 0xfc, 0x3f, 0xfc, 0x3f, 0x00, 0x30, 0x00, 0x30, 0x00, 0x30, X 0x00, 0x30, 0xfc, 0x3f, 0xfc, 0x3f, 0x0c, 0x00, 0x0c, 0x00, 0x0c, 0x00, X 0x0c, 0x00, 0xfc, 0x3f, 0xfc, 0x3f, 0x00, 0x00}; END_OF_FILE if test 266 -ne `wc -c <'bitmaps/2'`; then echo shar: \"'bitmaps/2'\" unpacked with wrong size! fi # end of 'bitmaps/2' fi if test -f 'bitmaps/3' -a "${1}" != "-c" ; then echo shar: Will not clobber existing file \"'bitmaps/3'\" else echo shar: Extracting \"'bitmaps/3'\" \(266 characters\) sed "s/^X//" >'bitmaps/3' <<'END_OF_FILE' X#define 3_width 16 X#define 3_height 16 Xstatic char 3_bits[] = { X 0x00, 0x00, 0xfc, 0x3f, 0xfc, 0x3f, 0x00, 0x30, 0x00, 0x30, 0x00, 0x30, X 0x00, 0x30, 0xfc, 0x3f, 0xfc, 0x3f, 0x00, 0x30, 0x00, 0x30, 0x00, 0x30, X 0x00, 0x30, 0xfc, 0x3f, 0xfc, 0x3f, 0x00, 0x00}; END_OF_FILE if test 266 -ne `wc -c <'bitmaps/3'`; then echo shar: \"'bitmaps/3'\" unpacked with wrong size! fi # end of 'bitmaps/3' fi if test -f 'bitmaps/4' -a "${1}" != "-c" ; then echo shar: Will not clobber existing file \"'bitmaps/4'\" else echo shar: Extracting \"'bitmaps/4'\" \(266 characters\) sed "s/^X//" >'bitmaps/4' <<'END_OF_FILE' X#define 4_width 16 X#define 4_height 16 Xstatic char 4_bits[] = { X 0x00, 0x00, 0x0c, 0x30, 0x0c, 0x30, 0x0c, 0x30, 0x0c, 0x30, 0x0c, 0x30, X 0x0c, 0x30, 0xfc, 0x3f, 0xfc, 0x3f, 0x00, 0x30, 0x00, 0x30, 0x00, 0x30, X 0x00, 0x30, 0x00, 0x30, 0x00, 0x30, 0x00, 0x00}; END_OF_FILE if test 266 -ne `wc -c <'bitmaps/4'`; then echo shar: \"'bitmaps/4'\" unpacked with wrong size! fi # end of 'bitmaps/4' fi if test -f 'bitmaps/5' -a "${1}" != "-c" ; then echo shar: Will not clobber existing file \"'bitmaps/5'\" else echo shar: Extracting \"'bitmaps/5'\" \(266 characters\) sed "s/^X//" >'bitmaps/5' <<'END_OF_FILE' X#define 5_width 16 X#define 5_height 16 Xstatic char 5_bits[] = { X 0x00, 0x00, 0xfc, 0x3f, 0xfc, 0x3f, 0x0c, 0x00, 0x0c, 0x00, 0x0c, 0x00, X 0x0c, 0x00, 0xfc, 0x3f, 0xfc, 0x3f, 0x00, 0x30, 0x00, 0x30, 0x00, 0x30, X 0x00, 0x30, 0xfc, 0x3f, 0xfc, 0x3f, 0x00, 0x00}; END_OF_FILE if test 266 -ne `wc -c <'bitmaps/5'`; then echo shar: \"'bitmaps/5'\" unpacked with wrong size! fi # end of 'bitmaps/5' fi if test -f 'bitmaps/6' -a "${1}" != "-c" ; then echo shar: Will not clobber existing file \"'bitmaps/6'\" else echo shar: Extracting \"'bitmaps/6'\" \(266 characters\) sed "s/^X//" >'bitmaps/6' <<'END_OF_FILE' X#define 6_width 16 X#define 6_height 16 Xstatic char 6_bits[] = { X 0x00, 0x00, 0xfc, 0x3f, 0xfc, 0x3f, 0x0c, 0x00, 0x0c, 0x00, 0x0c, 0x00, X 0x0c, 0x00, 0xfc, 0x3f, 0xfc, 0x3f, 0x0c, 0x30, 0x0c, 0x30, 0x0c, 0x30, X 0x0c, 0x30, 0xfc, 0x3f, 0xfc, 0x3f, 0x00, 0x00}; END_OF_FILE if test 266 -ne `wc -c <'bitmaps/6'`; then echo shar: \"'bitmaps/6'\" unpacked with wrong size! fi # end of 'bitmaps/6' fi if test -f 'bitmaps/7' -a "${1}" != "-c" ; then echo shar: Will not clobber existing file \"'bitmaps/7'\" else echo shar: Extracting \"'bitmaps/7'\" \(266 characters\) sed "s/^X//" >'bitmaps/7' <<'END_OF_FILE' X#define 7_width 16 X#define 7_height 16 Xstatic char 7_bits[] = { X 0x00, 0x00, 0xfc, 0x3f, 0xfc, 0x3f, 0x00, 0x30, 0x00, 0x30, 0x00, 0x30, X 0x00, 0x30, 0x00, 0x30, 0x00, 0x30, 0x00, 0x30, 0x00, 0x30, 0x00, 0x30, X 0x00, 0x30, 0x00, 0x30, 0x00, 0x30, 0x00, 0x00}; END_OF_FILE if test 266 -ne `wc -c <'bitmaps/7'`; then echo shar: \"'bitmaps/7'\" unpacked with wrong size! fi # end of 'bitmaps/7' fi if test -f 'bitmaps/8' -a "${1}" != "-c" ; then echo shar: Will not clobber existing file \"'bitmaps/8'\" else echo shar: Extracting \"'bitmaps/8'\" \(266 characters\) sed "s/^X//" >'bitmaps/8' <<'END_OF_FILE' X#define 8_width 16 X#define 8_height 16 Xstatic char 8_bits[] = { X 0x00, 0x00, 0xfc, 0x3f, 0xfc, 0x3f, 0x0c, 0x30, 0x0c, 0x30, 0x0c, 0x30, X 0x0c, 0x30, 0xfc, 0x3f, 0xfc, 0x3f, 0x0c, 0x30, 0x0c, 0x30, 0x0c, 0x30, X 0x0c, 0x30, 0xfc, 0x3f, 0xfc, 0x3f, 0x00, 0x00}; END_OF_FILE if test 266 -ne `wc -c <'bitmaps/8'`; then echo shar: \"'bitmaps/8'\" unpacked with wrong size! fi # end of 'bitmaps/8' fi if test -f 'bitmaps/empty' -a "${1}" != "-c" ; then echo shar: Will not clobber existing file \"'bitmaps/empty'\" else echo shar: Extracting \"'bitmaps/empty'\" \(278 characters\) sed "s/^X//" >'bitmaps/empty' <<'END_OF_FILE' X#define empty_width 16 X#define empty_height 16 Xstatic char empty_bits[] = { X 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, X 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, X 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00}; END_OF_FILE if test 278 -ne `wc -c <'bitmaps/empty'`; then echo shar: \"'bitmaps/empty'\" unpacked with wrong size! fi # end of 'bitmaps/empty' fi if test -f 'bitmaps/grey.25' -a "${1}" != "-c" ; then echo shar: Will not clobber existing file \"'bitmaps/grey.25'\" else echo shar: Extracting \"'bitmaps/grey.25'\" \(275 characters\) sed "s/^X//" >'bitmaps/grey.25' <<'END_OF_FILE' X#define grey_width 16 X#define grey_height 16 Xstatic char grey_bits[] = { X 0x11, 0x11, 0x44, 0x44, 0x11, 0x11, 0x44, 0x44, 0x11, 0x11, 0x44, 0x44, X 0x11, 0x11, 0x44, 0x44, 0x11, 0x11, 0x44, 0x44, 0x11, 0x11, 0x44, 0x44, X 0x11, 0x11, 0x44, 0x44, 0x11, 0x11, 0x44, 0x44}; END_OF_FILE if test 275 -ne `wc -c <'bitmaps/grey.25'`; then echo shar: \"'bitmaps/grey.25'\" unpacked with wrong size! fi # end of 'bitmaps/grey.25' fi if test -f 'bitmaps/grey.5' -a "${1}" != "-c" ; then echo shar: Will not clobber existing file \"'bitmaps/grey.5'\" else echo shar: Extracting \"'bitmaps/grey.5'\" \(275 characters\) sed "s/^X//" >'bitmaps/grey.5' <<'END_OF_FILE' X#define grey_width 16 X#define grey_height 16 Xstatic char grey_bits[] = { X 0x55, 0x55, 0xaa, 0xaa, 0x55, 0x55, 0xaa, 0xaa, 0x55, 0x55, 0xaa, 0xaa, X 0x55, 0x55, 0xaa, 0xaa, 0x55, 0x55, 0xaa, 0xaa, 0x55, 0x55, 0xaa, 0xaa, X 0x55, 0x55, 0xaa, 0xaa, 0x55, 0x55, 0xaa, 0xaa}; END_OF_FILE if test 275 -ne `wc -c <'bitmaps/grey.5'`; then echo shar: \"'bitmaps/grey.5'\" unpacked with wrong size! fi # end of 'bitmaps/grey.5' fi if test -f 'bitmaps/mark' -a "${1}" != "-c" ; then echo shar: Will not clobber existing file \"'bitmaps/mark'\" else echo shar: Extracting \"'bitmaps/mark'\" \(275 characters\) sed "s/^X//" >'bitmaps/mark' <<'END_OF_FILE' X#define mark_width 16 X#define mark_height 16 Xstatic char mark_bits[] = { X 0x00, 0x00, 0xfc, 0x3f, 0xfc, 0x3f, 0x00, 0x30, 0x00, 0x30, 0x00, 0x30, X 0x00, 0x30, 0x80, 0x3f, 0x80, 0x3f, 0x80, 0x01, 0x80, 0x01, 0x00, 0x00, X 0x00, 0x00, 0x80, 0x01, 0x80, 0x01, 0x00, 0x00}; END_OF_FILE if test 275 -ne `wc -c <'bitmaps/mark'`; then echo shar: \"'bitmaps/mark'\" unpacked with wrong size! fi # end of 'bitmaps/mark' fi if test -f 'bitmaps/mine' -a "${1}" != "-c" ; then echo shar: Will not clobber existing file \"'bitmaps/mine'\" else echo shar: Extracting \"'bitmaps/mine'\" \(275 characters\) sed "s/^X//" >'bitmaps/mine' <<'END_OF_FILE' X#define mine_width 16 X#define mine_height 16 Xstatic char mine_bits[] = { X 0x00, 0x00, 0x00, 0x38, 0x00, 0x3e, 0x00, 0x33, 0xc0, 0x31, 0x60, 0x30, X 0x60, 0x30, 0xc0, 0x31, 0x00, 0x33, 0x00, 0x3e, 0x00, 0x38, 0x00, 0x30, X 0x00, 0x30, 0x00, 0x30, 0x00, 0x30, 0x00, 0x00}; END_OF_FILE if test 275 -ne `wc -c <'bitmaps/mine'`; then echo shar: \"'bitmaps/mine'\" unpacked with wrong size! fi # end of 'bitmaps/mine' fi if test -f 'bitmaps/unfoundMine' -a "${1}" != "-c" ; then echo shar: Will not clobber existing file \"'bitmaps/unfoundMine'\" else echo shar: Extracting \"'bitmaps/unfoundMine'\" \(296 characters\) sed "s/^X//" >'bitmaps/unfoundMine' <<'END_OF_FILE' X#define unfoundMine_width 16 X#define unfoundMine_height 16 Xstatic char unfoundMine_bits[] = { X 0x00, 0x00, 0x00, 0x03, 0x80, 0x01, 0xe0, 0x03, 0x98, 0x0c, 0x84, 0x10, X 0x04, 0x10, 0x02, 0x20, 0x02, 0x20, 0x02, 0x20, 0x02, 0x20, 0x02, 0x20, X 0x04, 0x10, 0x04, 0x10, 0x18, 0x0c, 0xe0, 0x03}; END_OF_FILE if test 296 -ne `wc -c <'bitmaps/unfoundMine'`; then echo shar: \"'bitmaps/unfoundMine'\" unpacked with wrong size! fi # end of 'bitmaps/unfoundMine' fi if test -f 'bitmaps/wrongMine' -a "${1}" != "-c" ; then echo shar: Will not clobber existing file \"'bitmaps/wrongMine'\" else echo shar: Extracting \"'bitmaps/wrongMine'\" \(290 characters\) sed "s/^X//" >'bitmaps/wrongMine' <<'END_OF_FILE' X#define wrongMine_width 16 X#define wrongMine_height 16 Xstatic char wrongMine_bits[] = { X 0x03, 0xc0, 0x07, 0xf8, 0x0e, 0x7e, 0x1c, 0x3b, 0xd8, 0x39, 0x60, 0x34, X 0x60, 0x32, 0xc0, 0x31, 0x80, 0x33, 0x40, 0x3e, 0x20, 0x3c, 0x18, 0x38, X 0x1c, 0x38, 0x0e, 0x70, 0x07, 0xf0, 0x03, 0xc0}; END_OF_FILE if test 290 -ne `wc -c <'bitmaps/wrongMine'`; then echo shar: \"'bitmaps/wrongMine'\" unpacked with wrong size! fi # end of 'bitmaps/wrongMine' fi if test -f 'help' -a "${1}" != "-c" ; then echo shar: Will not clobber existing file \"'help'\" else echo shar: Extracting \"'help'\" \(1842 characters\) sed "s/^X//" >'help' <<'END_OF_FILE' XWelcome to tkmines! In this game, you are a minefield inspector, Xtrying to identify the unsafe spots on a large grid. If you step on Xa square with a bomb underneath, you lose the game. If, on the other Xhand, the square you step on has no bomb beneath it, the number of Xneighboring squares that DO have bombs is etched in the square. X XYou must identify all of the unmined squares in order to escape the Xminefield. You can step on any unknown square at any time. X XPress the left mouse button over a square to step on it. Use the Xinformation revealed as you step on non-mined squares to deduce which Xother squares have do have mines. If you believe that a particular Xsquare has a mine, press the right mouse button over it to mark it X"mined." You are then safe from accidentally stepping on the square. XOf course, there is no guarantee that your guess is right! X XYou have an assistant who will help you step on several squares at Xonce, but he is very cautious. If you point out a "known" square (one Xthat you have already stepped on) to him, he will step on all of the X"non-mined" squares adjacent to the square you show him, under one Xcondition: that you have marked enough squares "mined" that you can Xreasonably believe that none of the other neighbor squares are also Xmined. You can ask him to do this by pressing the middle-mouse button Xover any known square. X XFor example, if you middle-mouse over a square with a "1" in it, and Xyou have marked one of its neighbors with a mine-flag, your assistant Xwill step on all of the other squares around the "1." If your flag is Xmisplaced, though, then your assistant will probably blow you both up! X XYou can also mark a square with a "?" by pressing the right-mouse Xbutton an extra time. The "?" has no effect, other than to help you Xmark a square as a memory aid. X XGood luck, and tread lightly. X X END_OF_FILE if test 1842 -ne `wc -c <'help'`; then echo shar: \"'help'\" unpacked with wrong size! fi # end of 'help' fi if test -f 'src/gripe.tcl' -a "${1}" != "-c" ; then echo shar: Will not clobber existing file \"'src/gripe.tcl'\" else echo shar: Extracting \"'src/gripe.tcl'\" \(828 characters\) sed "s/^X//" >'src/gripe.tcl' <<'END_OF_FILE' Xproc gripe {sub} { X set w [genName .gripe] X toplevel $w X wm title $w "Gripe to the author" X label $w.l -text "Send a message to the author" X frame $w.h X frame $w.t -relief sunken -bd 2 X text $w.t.txt -wrap word X pack append $w.t $w.t.txt top X X frameMultChoice $w.b "" [list [list "Send" "sendGripe $w.t.txt $sub; destroy $w"] [list "Cancel" "destroy $w"]] Send X X pack append $w $w.l {top expand fillx} $w.h {top expand fillx} $w.t {top pady 10} $w.b {top pady 20} X X label $w.h.to -text "To: joel@cs.berkeley.edu" X label $w.h.sub -text "Subject: $sub" X pack append $w.h $w.h.to {top frame w} $w.h.sub {top frame w} X} X Xproc sendGripe {t sub} { X global version X sendMail "joel@cs.berkeley.edu" "$sub $version gripe!" [$t get 1.0 end] X} X Xproc sendMail {to subject text} { X exec echo $text | mail -s $subject $to & X} END_OF_FILE if test 828 -ne `wc -c <'src/gripe.tcl'`; then echo shar: \"'src/gripe.tcl'\" unpacked with wrong size! fi # end of 'src/gripe.tcl' fi if test -f 'src/high.tcl' -a "${1}" != "-c" ; then echo shar: Will not clobber existing file \"'src/high.tcl'\" else echo shar: Extracting \"'src/high.tcl'\" \(3963 characters\) sed "s/^X//" >'src/high.tcl' <<'END_OF_FILE' X# For debugging Xproc addRandomHighScore {f} { X set type [lindex {small medium big} [random 3]] X set time [random 5]:[random 60] X echo Adding high score: $type $time X addHighScore $time $type X} X X# highlight: which score to highlight? Xproc showHighScoresReset {f file {highlight {}} {msg {High Score List}}} { X readHighScores $file X set w [toplevel [genName .scores]] X wm title $w "High scores" X label $w.title -text $msg X pack append $w $w.title top X frameHighScore $w.s $highlight X pack append $w $w.s top X frameMultChoice $w.ok "" [list [list "OK" "destroy $w"] [list "Reset Board" "destroy $w;resetBoard $f"] [list "Quit" "destroy [winfo parent $f]"]] "Reset Board" X pack append $w $w.ok top X} X X# highlight: which score to highlight? Xproc showHighScores {file {highlight {}} {msg {High Score List}}} { X readHighScores $file X set w [toplevel [genName .scores]] X wm title $w "High scores" X label $w.title -text $msg X pack append $w $w.title top X frameHighScore $w.s $highlight X pack append $w $w.s top X frameMultChoice $w.ok "" [list [list Dismiss "destroy $w"]] Dismiss X pack append $w $w.ok top X} X Xproc frameHighScore {f {highlight {}}} { X global scores X frame $f X foreach type {small medium big} { X set index 0 X frame $f.$type -relief raised -bd 2 X pack append $f $f.$type {left filly expand} X label $f.$type.title -text $type X pack append $f.$type $f.$type.title top X frame $f.$type.name X frame $f.$type.time X frame $f.$type.date X pack append $f.$type $f.$type.name {left filly expand} $f.$type.time {left filly expand} $f.$type.date {left filly expand} X label $f.$type.name.title -text "Name" X label $f.$type.time.title -text "Time" X label $f.$type.date.title -text "Date" X pack append $f.$type.name $f.$type.name.title top X pack append $f.$type.time $f.$type.time.title top X pack append $f.$type.date $f.$type.date.title top X foreach scoreLine $scores($type) { X label $f.$type.name.$index -text [lindex $scoreLine 1] X label $f.$type.time.$index -text [fmtTime [lindex $scoreLine 0]] X label $f.$type.date.$index -text [fmtclock [lindex $scoreLine 2] "%D"] X pack append $f.$type.name $f.$type.name.$index top X pack append $f.$type.time $f.$type.time.$index top X pack append $f.$type.date $f.$type.date.$index top X incr index X } X } X if {$highlight != {}} { X set htype [lindex $highlight 0] X set hindex [lindex $highlight 1] X $f.$htype.name.$hindex config -relief raised X $f.$htype.time.$hindex config -relief raised X $f.$htype.date.$hindex config -relief raised X } X} X Xproc readHighScores {file} { X global scores X if {! [file exists $file]} { X exec touch $file X } X set id [open $file r] X set scoreList [read $id] X set scores(small) [lindex $scoreList 0] X set scores(medium) [lindex $scoreList 1] X set scores(big) [lindex $scoreList 2] X close $id X} X Xproc writeHighScores {file} { X global scores X write_file $file [list $scores(small) $scores(medium) $scores(big)] X catch "chmod 0777 $file" X} X Xproc addHighScore {time boardType} { X global scores scoreFile X X # Gotta be an appropriate type of board X if {[lsearch {small medium big} $boardType] == -1} {return -1} X X readHighScores $scoreFile X X set score [str2scr $time] X set index 0 X while {$score >= [getScore [lindex $scores($boardType) $index]]} { X incr index X } X set scores($boardType) [linsert $scores($boardType) $index [makeScoreLine $score]] X X set scores($boardType) [lrange $scores($boardType) 0 9] X X writeHighScores $scoreFile X X if {$index < 10} { X } X return $index X} X Xproc getScore {scoreLine} { X if {$scoreLine == {} } { X return 99999 X } X return [lindex $scoreLine 0] X} X Xproc makeScoreLine {score} { X return [list $score [id user] [getclock]] X} X Xproc str2scr {str} { X scan $str "%d:%d" min sec X return [expr {60 * $min + $sec}] X} X Xproc scr2str {scr} { X set min [expr {$scr / 60}] X set sec [expr {$scr % 60}] X return "$min:$sec" X} END_OF_FILE if test 3963 -ne `wc -c <'src/high.tcl'`; then echo shar: \"'src/high.tcl'\" unpacked with wrong size! fi # end of 'src/high.tcl' fi if test -f 'src/init.tcl' -a "${1}" != "-c" ; then echo shar: Will not clobber existing file \"'src/init.tcl'\" else echo shar: Extracting \"'src/init.tcl'\" \(773 characters\) sed "s/^X//" >'src/init.tcl' <<'END_OF_FILE' Xset width 10 Xset height 10 Xset mines 0 Xset bugs 0 Xset buttonWidth 24 Xset buttonHeight 24 X Xproc minwidth {} { X return 3 X} X Xproc minheight {} { X return 3 X} X Xproc maxwidth {} { X global buttonWidth X set rslt [expr {[winfo screenwidth .] / $buttonWidth}] X return $rslt X} X Xproc maxheight {} { X global buttonHeight X set rslt [expr {[winfo screenheight .] / $buttonHeight - 3}] X return $rslt X} X Xproc stdmines {width height} { X set std [toint [expr {($width * $height) * .15}]] X if {$std < [minmines $width $height]} { X set std [minmines $width $height] X } X return $std X} X Xproc minmines {width height} { X return 2 X} X Xproc maxmines {width height} { X return [expr {$width * $height - 2}] X} X Xproc getBitmap {name} { X global libDir X return "@$libDir/bitmaps/$name" X} END_OF_FILE if test 773 -ne `wc -c <'src/init.tcl'`; then echo shar: \"'src/init.tcl'\" unpacked with wrong size! fi # end of 'src/init.tcl' fi if test -f 'src/load.tcl' -a "${1}" != "-c" ; then echo shar: Will not clobber existing file \"'src/load.tcl'\" else echo shar: Extracting \"'src/load.tcl'\" \(539 characters\) sed "s/^X//" >'src/load.tcl' <<'END_OF_FILE' X# exit on ^C Xsignal default SIGINT X X# Check for Extended TCL Xif { ! [info exists TCLINIT] } { X puts stdout "You need Extended TCL to run tkmines. You can get that from" X puts stdout "sprite.berkeley.edu, anonymous ftp, directory tcl, file tclX6.4c.tar.Z." X exit X} X Xsource "$sourceDir/init.tcl" Xsource "$sourceDir/mines.tcl" Xsource "$sourceDir/misc.tcl" Xsource "$sourceDir/random.tcl" Xsource "$sourceDir/util.tcl" Xsource "$sourceDir/gripe.tcl" Xsource "$sourceDir/high.tcl" Xsource "$sourceDir/parseArgs.tcl" Xsource "$sourceDir/start.tcl" END_OF_FILE if test 539 -ne `wc -c <'src/load.tcl'`; then echo shar: \"'src/load.tcl'\" unpacked with wrong size! fi # end of 'src/load.tcl' fi if test -f 'src/mines.tcl' -a "${1}" != "-c" ; then echo shar: Will not clobber existing file \"'src/mines.tcl'\" else echo shar: Extracting \"'src/mines.tcl'\" \(17523 characters\) sed "s/^X//" >'src/mines.tcl' <<'END_OF_FILE' X# $f is frame/top window (already created) X# $w is width X# $h is height X# $m is number of mines Xproc makeBoard {f w h m} { X global bugs scoreFile $f.width $f.height $f.mines $f.area $f.squareList X set $f.width $w X set $f.height $h X set $f.mines $m X set $f.area [expr {$w * $h}] X set $f.squareList {} X X # Le menu X frame $f.m X menubutton $f.m.mb -text "Options" -menu $f.m.m -relief raised X button $f.m.help -text "Help" -command "helpMines" X pack append $f.m $f.m.mb {left frame w} $f.m.help {right frame e} X X menu $f.m.m X $f.m.m add command -label "Play Again" -command "askResetBoard $f" X $f.m.m add cascade -label "Resize" -menu $f.m.mr X $f.m.m add command -label "Give Up" -command "askShowAll $f" X $f.m.m add command -label "About..." -command "aboutMines" X $f.m.m add command -label "Gripe..." -command "gripe tkmines" X $f.m.m add command -label "High Scores..." -command "showHighScores $scoreFile" X $f.m.m add command -label "Quit" -command "quit Mines" X if {$bugs} { X $f.m.m add command -label "Profile" -command "printProfile" X } X X menu $f.m.mr X $f.m.mr add command -label "Small" -command "askResizeBoard $f small" X $f.m.mr add command -label "Medium" -command "askResizeBoard $f medium" X $f.m.mr add command -label "Big" -command "askResizeBoard $f big" X $f.m.mr add command -label "Max" -command "askResizeBoard $f max" X $f.m.mr add command -label "Custom..." -command "askResizeBoard $f custom" X X # Status stuff X frame $f.st X X frame $f.st.m X frame $f.st.t X pack append $f.st $f.st.m {left frame w padx 20} $f.st.t {left frame e padx 20} X X # Mine counts X frame $f.st.m.l X frame $f.st.m.n X pack append $f.st.m $f.st.m.l {left fillx} $f.st.m.n {left fillx} X X label $f.st.m.l.found -text "Mines found:" X label $f.st.m.l.mines -text "Mines:" X pack append $f.st.m.l $f.st.m.l.found {top frame w} $f.st.m.l.mines {top frame w} X X label $f.st.m.n.found -relief sunken -width 3 X label $f.st.m.n.mines -relief sunken -width 3 X pack append $f.st.m.n $f.st.m.n.found {top frame e} $f.st.m.n.mines {top frame e} X X # Time X label $f.st.t.l -text "Time:" X label $f.st.t.n -relief sunken -width 4 X pack append $f.st.t $f.st.t.l {left frame w} $f.st.t.n {left frame e} X X # Buttons X frame $f.b X X pack append $f $f.m {top fillx} $f.st {top pady 20} $f.b top X X for {set row 0} {$row < $h} {incr row} { X frame $f.b.$row X pack append $f.b $f.b.$row top X for {set col 0} {$col < $w} {incr col} { X button $f.b.$row.$col X pack append $f.b.$row $f.b.$row.$col left X lappend $f.squareList "$row $col" X $f.b.$row.$col config -command "showSquare $f $row $col" X bind $f.b.$row.$col <3> {eval markSquare [getSquare %W]} X bind $f.b.$row.$col <2> { X set testSquare [getSquare %W] X eval sinkNeighbors $testSquare X } X bind $f.b.$row.$col <ButtonRelease-2> { X if {$testSquare != {}} { X eval testSquare $testSquare X } X } X bind $f.b.$row.$col <B2-Leave> { X eval raiseNeighbors [getSquare %W] X set testSquare {} X } X #bind $f.b.$row.$col <Any-B2-Enter> {eval sinkNeighbors [getSquare %W]} X } X } X resetBoard $f X} X Xproc getSquare {w} { X set l [split $w .] X set len [llength $l] X set f [join [lrange $l 0 [expr {$len - 4}]] .] X set r [lindex $l [expr {$len - 2}]] X set c [lindex $l [expr {$len - 1}]] X return [list $f $r $c] X} X Xproc resetBoard {f} { X global $f.height $f.width $f.mines $f.minesguessed $f.squaresknown X global $f.done $f.started $f.lRow $f.lCol $f.visited X set h [set $f.height] X set w [set $f.width] X set m [set $f.mines] X for {set row 0} {$row < $h} {incr row} { X for {set col 0} {$col < $w} {incr col} { X initSquare $f $row $col X } X } X set $f.minesguessed 0 X set $f.squaresknown 0 X set $f.done 0 X set $f.started 0 X set $f.visited {} X $f.st.m.n.mines config -text "$m" X updateMinesguessed $f X resetTime $f X updateTime $f X setMines $f $m X set $f.lRow 0 X set $f.lCol 0 X lazyUpdate $f X #hashMines $f X} X Xproc askResetBoard {f} { X global $f.done X if {[set $f.done]} { X resetBoard $f X return X } X yesNo "Reset Mines Board" "Are you sure you want to reset the board?" "resetBoard $f" "noop" No X} X Xproc askResizeBoard {f type} { X global $f.done $f.started X set done [set $f.done] X set started [set $f.started] X case $type { X "small" { X set width 10 X set height 10 X } X "medium" { X set width 20 X set height 10 X } X "big" { X set width 40 X set height 20 X } X "max" { X set width [maxwidth] X set height [maxheight] X } X "custom" { X customResize $f X return X } X } X set mines [stdmines $width $height] X if {$done || ! $started} { X resizeBoard $f $width $height $mines X return X } X multChoice "Reset Board Size" "Are you sure you want to reset the board to $width x $height ($mines mines)?" [list [list "Yes" "resizeBoard $f $width $height $mines"] {No noop}] No X} X Xproc askShowAll {f} { X global $f.done X if {[set $f.done]} { X inform "You can't give up; the game is already over!" X } else { X yesNo "Give Up Mines" "Are you sure you want to give up the game?" "showAll $f" "noop" No X } X} X Xproc aboutMines {} { X global version X inform "tkmines version $version, by Joel A. Fine" X} X Xproc helpMines {} { X global helpFile X set id [open "$helpFile" r] X set msg [read $id] X inform $msg X} X Xproc showAll {f} { X global $f.width $f.height $f.done X set w [set $f.width] X set h [set $f.height] X set $f.done 1 X for {set row 0} {$row < $h} {incr row} { X for {set col 0} {$col < $w} {incr col} { X set guess [getGuess $f $row $col] X setGuess $f $row $col known X if {$guess == "known"} { X continue X } X global $f.$row.$col.mined X # We don't know for sure what this is X if {$guess == "mine"} { X # We think it's a mine X if {[set $f.$row.$col.mined]} { X continue X } X # Wrong! X $f.b.$row.$col config -bitmap [getBitmap wrongMine] X continue X } X if {[set $f.$row.$col.mined]} { X $f.b.$row.$col config -bitmap [getBitmap unfoundMine] X } X } X update X } X} X Xproc customResize {f} { X global $f.width $f.height $f.mines X set w [genName .customResetSize] X toplevel $w X wm title $w "Custom Board Size" X X frame $w.m X label $w.m.l -text "Mine Count:" X radiobutton $w.m.std -text "Standard" -variable useStdMineCount -value 1 -command "$w.m.scale config -state disabled" X label $w.m.stdl -relief sunken -width 3 X radiobutton $w.m.custom -text "Custom" -variable useStdMineCount -value 0 -command "$w.m.scale config -state normal" X scale $w.m.scale -orient horizontal -length 200 X X $w.m.scale set [set $f.mines] X $w.m.std invoke X X pack append $w.m $w.m.l left $w.m.std left $w.m.stdl left $w.m.custom left $w.m.scale left X X scale $w.w -label "Width:" -orient horizontal -length 200 -from [minwidth] -to [maxwidth] X scale $w.h -label "Height:" -orient horizontal -length 200 -from [minheight] -to [maxheight] X X $w.w config -command "customMineScale $w" X $w.h config -command "customMineScale $w" X X $w.w set [set $f.width] X $w.h set [set $f.height] X X pack append $w $w.w top $w.h top $w.m top X X frameMultChoice $w.yesNo "" [list [list "Resize Board" "resizeBoardCustom $f $w"] [list "Cancel" "destroy $w"]] Cancel X pack append $w $w.yesNo {top fillx} X} X Xproc customMineScale {w num} { X set min [minmines [$w.w get] [$w.h get]] X set max [maxmines [$w.w get] [$w.h get]] X set std [stdmines [$w.w get] [$w.h get]] X $w.m.scale config -from $min X $w.m.scale config -to $max X $w.m.scale config -tickinterval [expr {$max - $min}] X $w.m.stdl config -text $std X} X Xproc resizeBoardCustom {f win} { X global useStdMineCount X set w [$win.w get] X set h [$win.h get] X if {$useStdMineCount} { X set m [stdmines $w $h] X } else { X set m [$win.m.scale get] X } X if {$w > [maxwidth] || $w < [minwidth]} { X warn "Width must be between [minwidth] and [maxwidth]." X return X } X if {$h > [maxheight] || $h < [minheight]} { X warn "Height must be between [minheight] and [maxheight]." X return X } X if {$m > [maxmines $w $h] || $m < [minmines $w $h]} { X warn "Number of mines must be between [minmines $w $h] and [maxmines $w $h] for a board this size" X return X } X resizeBoard $f $w $h $m X destroy $win X} X Xproc resizeBoard {f w h m} { X if {! [ctype digit $w]} { X warn "$w is not a valid width." X return X } X if {! [ctype digit $h]} { X warn "$w is not a valid height." X return X } X if {! [ctype digit $m]} { X warn "$w is not a valid number of mines." X return X } X if {$w > [maxwidth] || $h > [maxheight]} { X warn "That board is too big! It wouldn't fit on the screen." X return X } X set win [inform "Resizing board. Please stand by."] X destroy $f X toplevel $f X wm title $f Mines X makeBoard $f $w $h $m X destroy $win X} X X# $f is frame/top window X# $m is number of mines Xproc setMines {f m} { X global $f.squareList X global $f.mineList X set squareList [set $f.squareList] X set $f.mineList [choose $m $squareList] X foreach square [set $f.mineList] { X makeMined $f [lindex $square 0] [lindex $square 1] X } X} X Xproc initSquare {f row col} { X global $f.$row.$col.nbrguessed $f.$row.$col.value X if {[info exists $f.$row.$col.value]} { X unset $f.$row.$col.value X } X set $f.$row.$col.nbrguessed 0 X setGuess $f $row $col empty X makeEmpty $f $row $col X $f.b.$row.$col config -background lightgrey -activebackground grey -relief raised X} X Xproc resetTime {f} { X global $f.time X set $f.time [getclock] X} X Xproc updateTime {f} { X global $f.done X $f.st.t.n config -text [getTime $f] X if {[set $f.done]} {return} X after 1000 updateTime $f X} X Xproc updateSquaresknown {f} { X global $f.squaresknown X #echo known: [set $f.squaresknown] X checkWin $f X} X Xproc updateMinesguessed {f} { X global $f.minesguessed X $f.st.m.n.found config -text [set $f.minesguessed] X} X Xproc checkWin {f} { X global $f.squaresknown $f.area $f.mines X set squaresknown [set $f.squaresknown] X set area [set $f.area] X set mines [set $f.mines] X if {[expr {$squaresknown + $mines}] == $area} { X winGame $f [getTime $f] X } X} X Xproc getTime {f} { X global $f.time $f.started X if {! [set $f.started]} { X resetTime $f X } X set start [set $f.time] X set now [getclock] X set diff [expr {$now - $start}] X return [fmtTime $diff] X} X Xproc fmtTime {time} { X set min [expr {$time / 60}] X set sec [expr {$time % 60}] X # Format the time X if {$sec == 0} {return "$min:00"} X if {$sec < 10} {return "$min:0$sec"} X return "$min:$sec" X} X Xproc makeMined {f row col} { X global $f.$row.$col.mined X set $f.$row.$col.mined 1 X # For debugging X # $f.b.$row.$col config -foreground red X} X Xproc makeEmpty {f row col} { X global $f.$row.$col.mined X set $f.$row.$col.mined 0 X} X X# Every so often, count up the neighbor-mines of another square. Xproc lazyUpdate {f} { X global $f.width $f.height $f.lRow $f.lCol X set row [set $f.lRow] X set col [set $f.lCol] X global $f.$row.$col.value X #if {[info exists $f.$row.$col.value]} {return} X set $f.$row.$col.value [countNeighborMines $f $row $col] X incr col X if {$col == [set $f.width]} { X set col 0 X incr row X } X set $f.lRow $row X set $f.lCol $col X if {$row != [set $f.height]} { X after 50 lazyUpdate $f X } X} X X# How many neighbors are mines? Xproc countNeighborMines {f row col} { X global $f.$row.$col.value X # Just in case I've computed it already X if {[info exists $f.$row.$col.value]} { X return [set $f.$row.$col.value] X } X set count 0 X foreach square [getNeighbors $f $row $col] { X set nr [lindex $square 0] X set nc [lindex $square 1] X global $f.$nr.$nc.mined X incr count [set $f.$nr.$nc.mined] X } X X return $count X} X Xproc visitSquare {f row col} { X global $f.$row.$col.mined $f.squaresknown $f.started X if {[getGuess $f $row $col] == "known"} { X return X } X if {[getGuess $f $row $col] == "mine"} { X return X } X if {[set $f.$row.$col.mined]} { X $f.b.$row.$col config -background red -activeforeground red X loseGame $f [getTime $f] X return X } X if {! [set $f.started]} { X set $f.started 1 X } X set count [countNeighborMines $f $row $col] X setGuess $f $row $col known X incr $f.squaresknown X updateSquaresknown $f X $f.b.$row.$col config -bitmap [getBitmap $count] X $f.b.$row.$col config -foreground [getForeground $count] -activeforeground [getForeground $count] -activebackground lightgrey X $f.b.$row.$col config -relief sunken X update X} X Xproc showSquare {f row col} { X global $f.visited X visitSquare $f $row $col X set count [countNeighborMines $f $row $col] X if {$count == 0} { X #set $f.visited {} X set zero {} X while 1 { X foreach square [getNeighbors $f $row $col] { X set nr [lindex $square 0] X set nc [lindex $square 1] X visitSquare $f $nr $nc X if ![countNeighborMines $f $nr $nc] { X if {[lsearch [set $f.visited] $square] < 0} {lappend zero $square} X } X if {[lsearch [set $f.visited] $square] < 0} {lappend $f.visited $square} X } X if {[llength $zero] != 0} { X set row [lindex [lindex $zero 0] 0] X set col [lindex [lindex $zero 0] 1] X set zero [lrange $zero 1 end] X } else { X return X } X } X } X} X Xproc markSquare {f row col} { X set guess [getGuess $f $row $col] X if {$guess == "known"} {return} X case $guess { X "empty" { X set guess mine X set incr 1 X } X "mine" { X set guess mark X set incr -1 X } X "mark" { X set guess empty X set incr 0 X } X } X setGuess $f $row $col $guess X foreach square [getNeighbors $f $row $col] { X set nr [lindex $square 0] X set nc [lindex $square 1] X global $f.$nr.$nc.nbrguessed X incr $f.$nr.$nc.nbrguessed $incr X } X global $f.minesguessed X incr $f.minesguessed $incr X updateMinesguessed $f X} X Xproc setGuess {f row col guess} { X global $f.$row.$col.guess X set $f.$row.$col.guess $guess X if {$guess != "known"} { X $f.b.$row.$col config -bitmap [getBitmap $guess] X $f.b.$row.$col config -foreground [getForeground $guess] X $f.b.$row.$col config -activeforeground [getActiveForeground $guess] X } X} X Xproc getGuess {f row col} { X getParam $f $row $col guess X} X Xproc getParam {f row col param} { X global $f.$row.$col.$param X return [set $f.$row.$col.$param] X} X Xproc getActiveForeground {value} { X if {[winfo screendepth .] <= 1} { X return black X } X case $value { X "mine" {return red} X "mark" {return black} X "empty" {return black} X } X} X Xproc getForeground {value} { X if {[winfo screendepth .] <= 1} { X return black X } X case $value { X "mine" {return red} X "mark" {return black} X "empty" {return black} X "0" {return lightgrey} X "1" {return blue} X "2" {return seagreen} X "3" {return red} X "4" {return white} X "5" {return black} X "6" {return yellow} X "7" {return limegreen} X "8" {return limegreen} X } X} X Xproc sinkNeighbors {f row col} { X global $f.done X if {[set $f.done]} {return} X foreach square [getNeighbors $f $row $col] { X set nr [lindex $square 0] X set nc [lindex $square 1] X set guess [getGuess $f $nr $nc] X if {$guess != "mine"} { X $f.b.$nr.$nc config -relief sunken X } X } X $f.b.$row.$col config -relief sunken X} X Xproc raiseNeighbors {f row col} { X foreach square [getNeighbors $f $row $col] { X set nr [lindex $square 0] X set nc [lindex $square 1] X set guess [getGuess $f $nr $nc] X if {$guess != "known"} { X $f.b.$nr.$nc config -relief raised X } X } X if {[getGuess $f $row $col] != "known"} { X $f.b.$row.$col config -relief raised X } X} X X X# $f.$row.$col.nbrguessed = number of neighbors guessed to be bombs. X X# If I already know the value of this button, and I've already marked X# that many mines around it, expose the rest of its neighbors. Xproc testSquare {f row col} { X global $f.$row.$col.nbrguessed X raiseNeighbors $f $row $col X # If the square isn't known, testSquare does nothing. X if {[getGuess $f $row $col] != "known"} { X return X } X set value [countNeighborMines $f $row $col] X set nbrguessed [set $f.$row.$col.nbrguessed] X if {$value <= $nbrguessed} { X foreach square [getNeighbors $f $row $col] { X set nr [lindex $square 0] X set nc [lindex $square 1] X if {[getGuess $f $nr $nc] != "mine"} { X showSquare $f $nr $nc X } X } X } X} X Xproc loseGame {f time} { X showAll $f X multChoice "Loser!" "You lost, in only $time!" [list {OK noop} [list "Play Again" "resetBoard $f"] [list "Quit" "quit Mines 0"]] "Play Again" X} X Xproc winGame {f time} { X global scoreFile X showAll $f X set boardType [boardType $f] X set index [addHighScore $time $boardType ] X if { $index < 10 && $index > -1 } { X # Made the high score list X showHighScoresReset $f $scoreFile [list $boardType $index] "Congratulations, you made the high score list!" X } else { X multChoice "Winner!" "You won, in only $time!" [list {OK noop} [list "Play Again" "resetBoard $f"] [list "Quit" "quit Mines 0"]] "Play Again" X } X} X Xproc printProfile {} { X # Profiling should already be turned on by the time this procedure X # is called X profile off pro X profrep pro cpu 3 X profile -commands on X} X Xproc boardType {f} { X global $f.width $f.height $f.mines X set w [set $f.width] X set h [set $f.height] X set m [set $f.mines] X if {$w == 10 && $h == 10 && $m == 15} { X return "small" X } X if {$w == 20 && $h == 10 && $m == 30} { X return "medium" X } X if {$w == 40 && $h == 20 && $m == 120} { X return "big" X } X} END_OF_FILE if test 17523 -ne `wc -c <'src/mines.tcl'`; then echo shar: \"'src/mines.tcl'\" unpacked with wrong size! fi # end of 'src/mines.tcl' fi if test -f 'src/misc.tcl' -a "${1}" != "-c" ; then echo shar: Will not clobber existing file \"'src/misc.tcl'\" else echo shar: Extracting \"'src/misc.tcl'\" \(3363 characters\) sed "s/^X//" >'src/misc.tcl' <<'END_OF_FILE' Xproc waitFor {w} { X global $w.iHaveBeenExposed X set $w.iHaveBeenExposed 0 X bind $w <Expose> "set $w.iHaveBeenExposed 1" X #tkwait variable $w.iHaveBeenExposed X bind $w <Expose> "" X update X} X Xproc inform { msg {aspect 1000}} { X set w [genName .info] X toplevel $w X wm title $w "Information" X frame $w.m X pack append $w $w.m {top expand fill} X X message $w.m.l -text "$msg" -aspect $aspect X button $w.m.b -command "destroy $w" -text "Dismiss" X X pack append $w.m $w.m.l top $w.m.b top X waitFor $w X grab $w X return $w X} X Xproc warn { msg {aspect 1000}} { X set w [genName .warn] X toplevel $w X wm title $w "Warning!" X frame $w.m X pack append $w $w.m {top expand fill} X X message $w.m.l -text "Warning: $msg" -aspect $aspect X button $w.m.b -command "destroy $w" -text "OK" X X pack append $w.m $w.m.l top $w.m.b top X waitFor $w X grab $w X return $w X} X Xproc genName {{var var}} { X global nameCount X if [info exists nameCount($var)] { X incr nameCount($var) X } else { X set nameCount($var) 0 X } X return "$var$nameCount($var)" X} X Xproc frameMultChoice {frame msg choices default} { X frame $frame X subMultChoice $frame $msg $choices $default X} X Xproc multChoice {title msg choices default} { X set w [genName .mult] X toplevel $w X wm title $w $title X subMultChoice $w $msg $choices $default X grab $w X} X Xproc subMultChoice {w msg choices default} { X set var [genName] X frame $w.m -relief raised -border 1 X frame $w.b -relief raised -border 1 X set style {top fill expand} X if {$msg != ""} { X pack append $w $w.m $style X } X pack append $w $w.b $style X label $w.m.l -text $msg X pack append $w.m $w.m.l top X foreach i $choices { X set text [lindex $i 0] X set command [lindex $i 1] X set style1 {left expand padx 40 pady 20} X if {$text == $default} { X set style2 {expand padx 5 pady 5} X set button default X } { X set style2 {expand} X set button [genName button] X } X frame $w.b.$button -relief sunken -border 1 X pack append $w.b $w.b.$button $style1 X button $w.b.$button.b -text $text -command "destroy $w; $command" X pack append $w.b.$button $w.b.$button.b $style2 X bind $w.b.$button <Enter> "$w.b.$button.b activate" X bind $w.b.$button <Leave> "$w.b.$button.b deactivate" X bind $w.b.$button <Return> "$w.b.$button.b invoke" X bind $w.b.$button.b <Return> "$w.b.$button.b invoke" X } X bind $w.m <Enter> "$w.b.default.b activate" X bind $w.m.l <Enter> "$w.b.default.b activate" X bind $w.b <Enter> "$w.b.default.b activate" X bind $w.m <Leave> "$w.b.default.b deactivate" X bind $w.m.l <Leave> "$w.b.default.b deactivate" X bind $w.b <Leave> "$w.b.default.b deactivate" X bind $w.m <Return> "$w.b.default.b invoke" X bind $w.m.l <Return> "$w.b.default.b invoke" X bind $w.b <Return> "$w.b.default.b invoke" X eval [list proc $w.invoke_default {} [list $w.b.default.b invoke]] X} X Xproc yesNo { title msg yesAction noAction default} { X multChoice $title $msg [list "Yes [list $yesAction]" "No [list $noAction]"] $default X} X Xproc quit { prog {confirm 1}} { X if $confirm { X yesNo "Quit" "Are you sure you want to quit $prog?" "quit $prog 0" "noop" No X } else { X destroy . X exit X } X} X Xproc noop {} { X} X Xproc toggle {var} { X global $var X if [info exists $var] { X if [set $var] { X set $var 0 X } else { X set $var 1 X } X } else { X set $var 1 X } X} END_OF_FILE if test 3363 -ne `wc -c <'src/misc.tcl'`; then echo shar: \"'src/misc.tcl'\" unpacked with wrong size! fi # end of 'src/misc.tcl' fi if test -f 'src/parseArgs.tcl' -a "${1}" != "-c" ; then echo shar: Will not clobber existing file \"'src/parseArgs.tcl'\" else echo shar: Extracting \"'src/parseArgs.tcl'\" \(1289 characters\) sed "s/^X//" >'src/parseArgs.tcl' <<'END_OF_FILE' Xproc parseArgs {argc argv} { X global width height mines X set minesSpecified 0 X for {set i 0} {$i < $argc} {incr i} { X set arg [lindex $argv $i] X case $arg { X -help printHelp X -bugs { X # Turn on debugging X global bugs X set bugs 1 X } X -v { X global version X echo "tkmines, version $version. By Joel A. Fine" X exit X } X -width { X incr i X set width [lindex $argv $i] X } X -height { X incr i X set height [lindex $argv $i] X } X -mines { X incr i X set mines [lindex $argv $i] X set minesSpecified 1 X } X default printHelp X } X } X if {$width > [maxwidth] || $width < [minwidth]} {printHelp} X if {$height > [maxheight] || $height < [minheight]} {printHelp} X X if {! $minesSpecified} { X set mines [stdmines $width $height] X } X if {$mines > [maxmines $width $height] || $mines < [minmines $width $height]} {printHelp} X} X Xproc printHelp {} { X global width height mines X echo {tkmines -width [width] -height [height] -mines [mines]} X echo width must be less than [maxwidth], height must be less than X echo [maxheight], and mines must be between [minmines $width $height] and [maxmines $width $height] X exit X} X XparseArgs $argc $argv END_OF_FILE if test 1289 -ne `wc -c <'src/parseArgs.tcl'`; then echo shar: \"'src/parseArgs.tcl'\" unpacked with wrong size! fi # end of 'src/parseArgs.tcl' fi if test -f 'src/random.tcl' -a "${1}" != "-c" ; then echo shar: Will not clobber existing file \"'src/random.tcl'\" else echo shar: Extracting \"'src/random.tcl'\" \(995 characters\) sed "s/^X//" >'src/random.tcl' <<'END_OF_FILE' X# Choose $num elements at random from $l Xproc choose {num l} { X random seed X set nl {} X for {set i 1} {$i <= $num} {incr i} { X set index [random [llength $l]] X lappend nl [lindex $l $index] X set l [concat [lrange $l 0 [expr {$index - 1}]] [lrange $l [expr {$index + 1}] [llength $l]]] X } X return $nl X} X Xproc chooseOld {num l} { X lrange [randOrder $l] 0 [expr {$num - 1}] X} X X# Put $l (a list) into random order Xproc randOrder {l} { X set newlist {} X while {! [lempty $l]} { X set x [extractRandomElement $l] X lappend newlist [lindex $x 0] X set l [lindex $x 1] X } X return $newlist X} X X# Extract a single element from $l at random. Return the element, followed X# by the list, extracting the element from the list. Xproc extractRandomElement {list} { X random seed X set index [random [llength $list]] X set el [lindex $list $index] X set newlist [concat [lrange $list 0 [expr {$index - 1}]] [lrange $list [expr {$index + 1}] [llength $list]]] X return [list $el $newlist] X} END_OF_FILE if test 995 -ne `wc -c <'src/random.tcl'`; then echo shar: \"'src/random.tcl'\" unpacked with wrong size! fi # end of 'src/random.tcl' fi if test -f 'src/start.tcl' -a "${1}" != "-c" ; then echo shar: Will not clobber existing file \"'src/start.tcl'\" else echo shar: Extracting \"'src/start.tcl'\" \(117 characters\) sed "s/^X//" >'src/start.tcl' <<'END_OF_FILE' Xif {$bugs} { X profile -commands on X} Xwm withdraw . Xtoplevel .w Xwm title .w Mines XmakeBoard .w $width $height $mines END_OF_FILE if test 117 -ne `wc -c <'src/start.tcl'`; then echo shar: \"'src/start.tcl'\" unpacked with wrong size! fi # end of 'src/start.tcl' fi if test -f 'src/util.tcl' -a "${1}" != "-c" ; then echo shar: Will not clobber existing file \"'src/util.tcl'\" else echo shar: Extracting \"'src/util.tcl'\" \(1049 characters\) sed "s/^X//" >'src/util.tcl' <<'END_OF_FILE' X# Convert float to int Xproc toint {num} { X return [format "%.0f" $num] X} X Xproc getNeighbors {f row col} { X global $f.width $f.height X X set w [set $f.width] X set h [set $f.height] X X if {$row >= $h} {return {}} X if {$col >= $w} {return {}} X X set nl {} X X # Above X if {$row > 0} { X set nr [expr {$row - 1}] X # Left X if {$col > 0} { X lappend nl [list $nr [expr {$col - 1}]] X } X # Middle X lappend nl [list $nr $col] X # Right X if {$col < [expr {$w - 1}]} { X lappend nl [list $nr [expr {$col + 1}]] X } X } X X # Below X if {$row < [expr {$h - 1}]} { X set nr [expr {$row + 1}] X # Left X if {$col > 0} { X lappend nl [list $nr [expr {$col - 1}]] X } X # Middle X lappend nl [list $nr $col] X # Right X if {$col < [expr {$w - 1}]} { X lappend nl [list $nr [expr {$col + 1}]] X } X } X X # Even X set nr $row X # Left X if {$col > 0} { X lappend nl [list $nr [expr {$col - 1}]] X } X # Right X if {$col < [expr {$w - 1}]} { X lappend nl [list $nr [expr {$col + 1}]] X } X return $nl X} END_OF_FILE if test 1049 -ne `wc -c <'src/util.tcl'`; then echo shar: \"'src/util.tcl'\" unpacked with wrong size! fi # end of 'src/util.tcl' fi echo shar: End of archive 1 \(of 1\). cp /dev/null ark1isdone MISSING="" for I in 1 ; do if test ! -f ark${I}isdone ; then MISSING="${MISSING} ${I}" fi done if test "${MISSING}" = "" ; then echo You have the archive. rm -f ark[1-9]isdone else echo You still need to unpack the following archives: echo " " ${MISSING} fi ## End of shell archive. exit 0