home *** CD-ROM | disk | FTP | other *** search
/ Source Code 1994 March / Source_Code_CD-ROM_Walnut_Creek_March_1994.iso / compsrcs / games / volume17 / tkmines / part01 < prev    next >
Encoding:
Internet Message Format  |  1993-04-17  |  55.9 KB

  1. Path: uunet!news.tek.com!master!saab!billr
  2. From: billr@saab.CNA.TEK.COM (Bill Randle)
  3. Newsgroups: comp.sources.games
  4. Subject: v17i075:  tkmines - minefield game in Tcl and Wish, Part01/01
  5. Message-ID: <4927@master.CNA.TEK.COM>
  6. Date: 19 Apr 93 02:26:31 GMT
  7. Sender: news@master.CNA.TEK.COM
  8. Reply-To: joel@cs.berkeley.edu
  9. Lines: 1896
  10. Approved: billr@saab.CNA.TEK.COM
  11. Xref: uunet comp.sources.games:1754
  12.  
  13. Submitted-by: Joel A. Fine <joel@postgres.berkeley.edu>
  14. Posting-number: Volume 17, Issue 75
  15. Archive-name: tkmines/Part01
  16. Environment: WISH, Extended Tcl
  17.  
  18.     [I don't have a copy of WISH, so I haven't tested this.... -br]
  19.  
  20. #! /bin/sh
  21. # This is a shell archive.  Remove anything before this line, then unpack
  22. # it by saving it into a file and typing "sh file".  To overwrite existing
  23. # files, type "sh file -c".  You can also feed this as standard input via
  24. # unshar, or by typing "sh <file", e.g..  If this archive is complete, you
  25. # will see the following message at the end:
  26. #        "End of archive 1 (of 1)."
  27. # Contents:  README MANIFEST Changes Hdr Make.config Makefile ToDo
  28. #   bitmaps bitmaps/0 bitmaps/1 bitmaps/2 bitmaps/3 bitmaps/4
  29. #   bitmaps/5 bitmaps/6 bitmaps/7 bitmaps/8 bitmaps/empty
  30. #   bitmaps/grey.25 bitmaps/grey.5 bitmaps/mark bitmaps/mine
  31. #   bitmaps/unfoundMine bitmaps/wrongMine help src/gripe.tcl
  32. #   src/high.tcl src/init.tcl src/load.tcl src/mines.tcl src/misc.tcl
  33. #   src/parseArgs.tcl src/random.tcl src/start.tcl src/util.tcl
  34. # Wrapped by billr@saab on Sun Apr 18 19:23:11 1993
  35. PATH=/bin:/usr/bin:/usr/ucb ; export PATH
  36. if test -f 'README' -a "${1}" != "-c" ; then 
  37.   echo shar: Will not clobber existing file \"'README'\"
  38. else
  39. echo shar: Extracting \"'README'\" \(824 characters\)
  40. sed "s/^X//" >'README' <<'END_OF_FILE'
  41. XWelcome to tkmines! This program requires wish and extended Tcl,
  42. Xavailable from sprite.berkeley.edu.
  43. X
  44. XFeel free to send this to your friends. If you like it, please let me
  45. Xknow. If you hate it, please let me know. Please leave my name
  46. Xattached somewhere if you pass it along.
  47. X
  48. XTo run:
  49. X
  50. Xedit the file "Make.config" to point to your copy of (EXTENDED) wish,
  51. Xand to indicate where you want tkmines installed.
  52. X
  53. XThen, just run the program:
  54. X> tkmines
  55. X
  56. XSee the file "help" in this directory for instructions.
  57. X
  58. XJoel Fine
  59. Xjoel@cs.berkeley.edu
  60. X
  61. X-----------------------------------------------------------------------
  62. XIF YOU DO NOT HAVE WISH AND EXTENDED TCL:
  63. XAnonymous ftp from sprite.berkeley.edu, directory "tcl": get
  64. Xtk3.2.tar.Z, tcl6.7.tar.Z, tclX6.5c.tar.Z. Uncomress, untar, and
  65. Xfollow the instructions in the README's therein.
  66. END_OF_FILE
  67. if test 824 -ne `wc -c <'README'`; then
  68.     echo shar: \"'README'\" unpacked with wrong size!
  69. fi
  70. # end of 'README'
  71. fi
  72. if test -f 'MANIFEST' -a "${1}" != "-c" ; then 
  73.   echo shar: Will not clobber existing file \"'MANIFEST'\"
  74. else
  75. echo shar: Extracting \"'MANIFEST'\" \(1199 characters\)
  76. sed "s/^X//" >'MANIFEST' <<'END_OF_FILE'
  77. X   File Name        Archive #    Description
  78. X-----------------------------------------------------------
  79. X Changes                    1    
  80. X Hdr                        1    
  81. X MANIFEST                   1    This shipping list
  82. X Make.config                1    
  83. X Makefile                   1    
  84. X README                     1    
  85. X ToDo                       1    
  86. X bitmaps                    1    
  87. X bitmaps/0                  1    
  88. X bitmaps/1                  1    
  89. X bitmaps/2                  1    
  90. X bitmaps/3                  1    
  91. X bitmaps/4                  1    
  92. X bitmaps/5                  1    
  93. X bitmaps/6                  1    
  94. X bitmaps/7                  1    
  95. X bitmaps/8                  1    
  96. X bitmaps/empty              1    
  97. X bitmaps/grey.25            1    
  98. X bitmaps/grey.5             1    
  99. X bitmaps/mark               1    
  100. X bitmaps/mine               1    
  101. X bitmaps/unfoundMine        1    
  102. X bitmaps/wrongMine          1    
  103. X help                       1    
  104. X src/gripe.tcl              1    
  105. X src/high.tcl               1    
  106. X src/init.tcl               1    
  107. X src/load.tcl               1    
  108. X src/mines.tcl              1    
  109. X src/misc.tcl               1    
  110. X src/parseArgs.tcl          1    
  111. X src/random.tcl             1    
  112. X src/start.tcl              1    
  113. X src/util.tcl               1    
  114. END_OF_FILE
  115. if test 1199 -ne `wc -c <'MANIFEST'`; then
  116.     echo shar: \"'MANIFEST'\" unpacked with wrong size!
  117. fi
  118. # end of 'MANIFEST'
  119. fi
  120. if test -f 'Changes' -a "${1}" != "-c" ; then 
  121.   echo shar: Will not clobber existing file \"'Changes'\"
  122. else
  123. echo shar: Extracting \"'Changes'\" \(548 characters\)
  124. sed "s/^X//" >'Changes' <<'END_OF_FILE'
  125. XNew in Release 1.2:
  126. X-------------------
  127. XHigh score list
  128. X
  129. XRedone "custom" board size intfce
  130. X
  131. X
  132. XNew in Release 1.1:
  133. X-------------------
  134. XFaster resizing & board creation
  135. X
  136. XLazy evaluation of neighbor counts (gradually counts mines at neighbor
  137. Xsquares, unless immediate evaluation is called for)
  138. X
  139. XGripe facility
  140. X
  141. XDebugging facilities for performance profiling
  142. X
  143. XTest for extended TCL before assuming it's there
  144. X
  145. XBetter arg-parsing: width, height, mines
  146. X
  147. XMonochrome support
  148. X
  149. XMax board-size: fills the screen
  150. X
  151. XAccurate message in README as to tclX location
  152. END_OF_FILE
  153. if test 548 -ne `wc -c <'Changes'`; then
  154.     echo shar: \"'Changes'\" unpacked with wrong size!
  155. fi
  156. # end of 'Changes'
  157. fi
  158. if test -f 'Hdr' -a "${1}" != "-c" ; then 
  159.   echo shar: Will not clobber existing file \"'Hdr'\"
  160. else
  161. echo shar: Extracting \"'Hdr'\" \(926 characters\)
  162. sed "s/^X//" >'Hdr' <<'END_OF_FILE'
  163. XFrom joel@postgres.Berkeley.EDU Wed Apr 14 15:51:58 1993
  164. XReceived: from master.CNA.TEK.COM by saab.CNA.TEK.COM (4.1/6.24)
  165. X    id AA04535; Wed, 14 Apr 93 15:51:55 PDT
  166. XReceived: from tektronix.TEK.COM by master.CNA.TEK.COM (4.1/7.1)
  167. X    id AA16281; Wed, 14 Apr 93 15:51:34 PDT
  168. XReceived: from saffron.CS.Berkeley.EDU ([128.32.150.4]) by tektronix.TEK.COM (4.1/8.0)
  169. X    id AA11020; Wed, 14 Apr 93 15:51:51 PDT
  170. XReceived: by saffron.CS.Berkeley.EDU (5.57/Ultrix3.0-C) id AA08856; Wed, 14 Apr 93 15:53:25 -0700
  171. XDate: Wed, 14 Apr 93 15:53:25 -0700
  172. XFrom: Joel A. Fine <joel@postgres.berkeley.edu>
  173. XMessage-Id: <9304142253.AA08856@saffron.CS.Berkeley.EDU>
  174. XTo: billr@saab.CNA.TEK.COM (Bill Randle)
  175. XSubject: Re: Game submission
  176. XReferences: <9304142229.AA08483@saffron.CS.Berkeley.EDU>
  177. X    <joel@postgres.berkeley.edu>
  178. X    <9304141543.ZM4528@saab>
  179. XReply-To: joel@cs.berkeley.edu
  180. XStatus: OR
  181. X
  182. XOK, here it is. I just posted it to comp.lang.tcl, by the way.
  183. X
  184. END_OF_FILE
  185. if test 926 -ne `wc -c <'Hdr'`; then
  186.     echo shar: \"'Hdr'\" unpacked with wrong size!
  187. fi
  188. # end of 'Hdr'
  189. fi
  190. if test -f 'Make.config' -a "${1}" != "-c" ; then 
  191.   echo shar: Will not clobber existing file \"'Make.config'\"
  192. else
  193. echo shar: Extracting \"'Make.config'\" \(318 characters\)
  194. sed "s/^X//" >'Make.config' <<'END_OF_FILE'
  195. X# WISH is the location of your Extended tcl wish binary
  196. XWISH        = /usr/sww/X11/bin/wishX
  197. X
  198. X# LIB_DIR is the directory where you would like the source code installed
  199. XLIB_DIR        = /home/sequoia/joel/local/lib/tkmines
  200. X
  201. X# BIN_DIR is the directory where you would like the executable installed
  202. XBIN_DIR        = /home/sequoia/joel/bin
  203. END_OF_FILE
  204. if test 318 -ne `wc -c <'Make.config'`; then
  205.     echo shar: \"'Make.config'\" unpacked with wrong size!
  206. fi
  207. # end of 'Make.config'
  208. fi
  209. if test -f 'Makefile' -a "${1}" != "-c" ; then 
  210.   echo shar: Will not clobber existing file \"'Makefile'\"
  211. else
  212. echo shar: Extracting \"'Makefile'\" \(871 characters\)
  213. sed "s/^X//" >'Makefile' <<'END_OF_FILE'
  214. X# Don't even THINK about changing this file. 8^)
  215. Xinclude Make.config
  216. X
  217. XVERSION        = 1.2
  218. X
  219. XSOURCE_DIR    = $(LIB_DIR)/src
  220. XSCORE_FILE    = $(LIB_DIR)/scores
  221. XHELP_FILE    = $(LIB_DIR)/help
  222. XLOAD_FILE    = $(SOURCE_DIR)/load.tcl"
  223. X
  224. Xinstall: tkmines
  225. X    - mkdir $(LIB_DIR)
  226. X    cp -p tkmines $(BIN_DIR)
  227. X    cp -rp src $(LIB_DIR)/src
  228. X    cp -rp bitmaps $(LIB_DIR)/bitmaps
  229. X    cp -rp help $(LIB_DIR)/help
  230. X    touch $(SCORE_FILE)
  231. X    chmod 777 $(SCORE_FILE)
  232. X    @echo tkmines is now installed.
  233. X
  234. Xtkmines:
  235. X    @echo >  $@ "#! $(WISH) -f"
  236. X    @echo >> $@ "set version $(VERSION)"
  237. X    @echo >> $@ "set libDir "$(LIB_DIR)"
  238. X    @echo >> $@ "set sourceDir $(SOURCE_DIR)"
  239. X    @echo >> $@ "set scoreFile $(SCORE_FILE)"
  240. X    @echo >> $@ "set helpFile $(HELP_FILE)"
  241. X    @echo >> $@ "source $(LOAD_FILE)"
  242. X    chmod +x $@
  243. X    
  244. Xclean:
  245. X    rm -rf $(LIB_DIR) tkmines $(BIN_DIR)/tkmines
  246. X
  247. Xtidy:
  248. X    rm -rf *~ */*~ tkmines
  249. X
  250. Xshar: tidy
  251. X    shar -v . > ../tkmines.$(VERSION).shar
  252. END_OF_FILE
  253. if test 871 -ne `wc -c <'Makefile'`; then
  254.     echo shar: \"'Makefile'\" unpacked with wrong size!
  255. fi
  256. # end of 'Makefile'
  257. fi
  258. if test -f 'ToDo' -a "${1}" != "-c" ; then 
  259.   echo shar: Will not clobber existing file \"'ToDo'\"
  260. else
  261. echo shar: Extracting \"'ToDo'\" \(19 characters\)
  262. sed "s/^X//" >'ToDo' <<'END_OF_FILE'
  263. XReset high scores?
  264. END_OF_FILE
  265. if test 19 -ne `wc -c <'ToDo'`; then
  266.     echo shar: \"'ToDo'\" unpacked with wrong size!
  267. fi
  268. # end of 'ToDo'
  269. fi
  270. if test ! -d 'bitmaps' ; then
  271.     echo shar: Creating directory \"'bitmaps'\"
  272.     mkdir 'bitmaps'
  273. fi
  274. if test -f 'bitmaps/0' -a "${1}" != "-c" ; then 
  275.   echo shar: Will not clobber existing file \"'bitmaps/0'\"
  276. else
  277. echo shar: Extracting \"'bitmaps/0'\" \(266 characters\)
  278. sed "s/^X//" >'bitmaps/0' <<'END_OF_FILE'
  279. X#define 0_width 16
  280. X#define 0_height 16
  281. Xstatic char 0_bits[] = {
  282. X   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
  283. X   0x00, 0x00, 0x80, 0x01, 0x80, 0x01, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
  284. X   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00};
  285. END_OF_FILE
  286. if test 266 -ne `wc -c <'bitmaps/0'`; then
  287.     echo shar: \"'bitmaps/0'\" unpacked with wrong size!
  288. fi
  289. # end of 'bitmaps/0'
  290. fi
  291. if test -f 'bitmaps/1' -a "${1}" != "-c" ; then 
  292.   echo shar: Will not clobber existing file \"'bitmaps/1'\"
  293. else
  294. echo shar: Extracting \"'bitmaps/1'\" \(266 characters\)
  295. sed "s/^X//" >'bitmaps/1' <<'END_OF_FILE'
  296. X#define 1_width 16
  297. X#define 1_height 16
  298. Xstatic char 1_bits[] = {
  299. X   0x00, 0x00, 0x80, 0x01, 0x80, 0x01, 0x80, 0x01, 0x80, 0x01, 0x80, 0x01,
  300. X   0x80, 0x01, 0x80, 0x01, 0x80, 0x01, 0x80, 0x01, 0x80, 0x01, 0x80, 0x01,
  301. X   0x80, 0x01, 0x80, 0x01, 0x80, 0x01, 0x00, 0x00};
  302. END_OF_FILE
  303. if test 266 -ne `wc -c <'bitmaps/1'`; then
  304.     echo shar: \"'bitmaps/1'\" unpacked with wrong size!
  305. fi
  306. # end of 'bitmaps/1'
  307. fi
  308. if test -f 'bitmaps/2' -a "${1}" != "-c" ; then 
  309.   echo shar: Will not clobber existing file \"'bitmaps/2'\"
  310. else
  311. echo shar: Extracting \"'bitmaps/2'\" \(266 characters\)
  312. sed "s/^X//" >'bitmaps/2' <<'END_OF_FILE'
  313. X#define 2_width 16
  314. X#define 2_height 16
  315. Xstatic char 2_bits[] = {
  316. X   0x00, 0x00, 0xfc, 0x3f, 0xfc, 0x3f, 0x00, 0x30, 0x00, 0x30, 0x00, 0x30,
  317. X   0x00, 0x30, 0xfc, 0x3f, 0xfc, 0x3f, 0x0c, 0x00, 0x0c, 0x00, 0x0c, 0x00,
  318. X   0x0c, 0x00, 0xfc, 0x3f, 0xfc, 0x3f, 0x00, 0x00};
  319. END_OF_FILE
  320. if test 266 -ne `wc -c <'bitmaps/2'`; then
  321.     echo shar: \"'bitmaps/2'\" unpacked with wrong size!
  322. fi
  323. # end of 'bitmaps/2'
  324. fi
  325. if test -f 'bitmaps/3' -a "${1}" != "-c" ; then 
  326.   echo shar: Will not clobber existing file \"'bitmaps/3'\"
  327. else
  328. echo shar: Extracting \"'bitmaps/3'\" \(266 characters\)
  329. sed "s/^X//" >'bitmaps/3' <<'END_OF_FILE'
  330. X#define 3_width 16
  331. X#define 3_height 16
  332. Xstatic char 3_bits[] = {
  333. X   0x00, 0x00, 0xfc, 0x3f, 0xfc, 0x3f, 0x00, 0x30, 0x00, 0x30, 0x00, 0x30,
  334. X   0x00, 0x30, 0xfc, 0x3f, 0xfc, 0x3f, 0x00, 0x30, 0x00, 0x30, 0x00, 0x30,
  335. X   0x00, 0x30, 0xfc, 0x3f, 0xfc, 0x3f, 0x00, 0x00};
  336. END_OF_FILE
  337. if test 266 -ne `wc -c <'bitmaps/3'`; then
  338.     echo shar: \"'bitmaps/3'\" unpacked with wrong size!
  339. fi
  340. # end of 'bitmaps/3'
  341. fi
  342. if test -f 'bitmaps/4' -a "${1}" != "-c" ; then 
  343.   echo shar: Will not clobber existing file \"'bitmaps/4'\"
  344. else
  345. echo shar: Extracting \"'bitmaps/4'\" \(266 characters\)
  346. sed "s/^X//" >'bitmaps/4' <<'END_OF_FILE'
  347. X#define 4_width 16
  348. X#define 4_height 16
  349. Xstatic char 4_bits[] = {
  350. X   0x00, 0x00, 0x0c, 0x30, 0x0c, 0x30, 0x0c, 0x30, 0x0c, 0x30, 0x0c, 0x30,
  351. X   0x0c, 0x30, 0xfc, 0x3f, 0xfc, 0x3f, 0x00, 0x30, 0x00, 0x30, 0x00, 0x30,
  352. X   0x00, 0x30, 0x00, 0x30, 0x00, 0x30, 0x00, 0x00};
  353. END_OF_FILE
  354. if test 266 -ne `wc -c <'bitmaps/4'`; then
  355.     echo shar: \"'bitmaps/4'\" unpacked with wrong size!
  356. fi
  357. # end of 'bitmaps/4'
  358. fi
  359. if test -f 'bitmaps/5' -a "${1}" != "-c" ; then 
  360.   echo shar: Will not clobber existing file \"'bitmaps/5'\"
  361. else
  362. echo shar: Extracting \"'bitmaps/5'\" \(266 characters\)
  363. sed "s/^X//" >'bitmaps/5' <<'END_OF_FILE'
  364. X#define 5_width 16
  365. X#define 5_height 16
  366. Xstatic char 5_bits[] = {
  367. X   0x00, 0x00, 0xfc, 0x3f, 0xfc, 0x3f, 0x0c, 0x00, 0x0c, 0x00, 0x0c, 0x00,
  368. X   0x0c, 0x00, 0xfc, 0x3f, 0xfc, 0x3f, 0x00, 0x30, 0x00, 0x30, 0x00, 0x30,
  369. X   0x00, 0x30, 0xfc, 0x3f, 0xfc, 0x3f, 0x00, 0x00};
  370. END_OF_FILE
  371. if test 266 -ne `wc -c <'bitmaps/5'`; then
  372.     echo shar: \"'bitmaps/5'\" unpacked with wrong size!
  373. fi
  374. # end of 'bitmaps/5'
  375. fi
  376. if test -f 'bitmaps/6' -a "${1}" != "-c" ; then 
  377.   echo shar: Will not clobber existing file \"'bitmaps/6'\"
  378. else
  379. echo shar: Extracting \"'bitmaps/6'\" \(266 characters\)
  380. sed "s/^X//" >'bitmaps/6' <<'END_OF_FILE'
  381. X#define 6_width 16
  382. X#define 6_height 16
  383. Xstatic char 6_bits[] = {
  384. X   0x00, 0x00, 0xfc, 0x3f, 0xfc, 0x3f, 0x0c, 0x00, 0x0c, 0x00, 0x0c, 0x00,
  385. X   0x0c, 0x00, 0xfc, 0x3f, 0xfc, 0x3f, 0x0c, 0x30, 0x0c, 0x30, 0x0c, 0x30,
  386. X   0x0c, 0x30, 0xfc, 0x3f, 0xfc, 0x3f, 0x00, 0x00};
  387. END_OF_FILE
  388. if test 266 -ne `wc -c <'bitmaps/6'`; then
  389.     echo shar: \"'bitmaps/6'\" unpacked with wrong size!
  390. fi
  391. # end of 'bitmaps/6'
  392. fi
  393. if test -f 'bitmaps/7' -a "${1}" != "-c" ; then 
  394.   echo shar: Will not clobber existing file \"'bitmaps/7'\"
  395. else
  396. echo shar: Extracting \"'bitmaps/7'\" \(266 characters\)
  397. sed "s/^X//" >'bitmaps/7' <<'END_OF_FILE'
  398. X#define 7_width 16
  399. X#define 7_height 16
  400. Xstatic char 7_bits[] = {
  401. X   0x00, 0x00, 0xfc, 0x3f, 0xfc, 0x3f, 0x00, 0x30, 0x00, 0x30, 0x00, 0x30,
  402. X   0x00, 0x30, 0x00, 0x30, 0x00, 0x30, 0x00, 0x30, 0x00, 0x30, 0x00, 0x30,
  403. X   0x00, 0x30, 0x00, 0x30, 0x00, 0x30, 0x00, 0x00};
  404. END_OF_FILE
  405. if test 266 -ne `wc -c <'bitmaps/7'`; then
  406.     echo shar: \"'bitmaps/7'\" unpacked with wrong size!
  407. fi
  408. # end of 'bitmaps/7'
  409. fi
  410. if test -f 'bitmaps/8' -a "${1}" != "-c" ; then 
  411.   echo shar: Will not clobber existing file \"'bitmaps/8'\"
  412. else
  413. echo shar: Extracting \"'bitmaps/8'\" \(266 characters\)
  414. sed "s/^X//" >'bitmaps/8' <<'END_OF_FILE'
  415. X#define 8_width 16
  416. X#define 8_height 16
  417. Xstatic char 8_bits[] = {
  418. X   0x00, 0x00, 0xfc, 0x3f, 0xfc, 0x3f, 0x0c, 0x30, 0x0c, 0x30, 0x0c, 0x30,
  419. X   0x0c, 0x30, 0xfc, 0x3f, 0xfc, 0x3f, 0x0c, 0x30, 0x0c, 0x30, 0x0c, 0x30,
  420. X   0x0c, 0x30, 0xfc, 0x3f, 0xfc, 0x3f, 0x00, 0x00};
  421. END_OF_FILE
  422. if test 266 -ne `wc -c <'bitmaps/8'`; then
  423.     echo shar: \"'bitmaps/8'\" unpacked with wrong size!
  424. fi
  425. # end of 'bitmaps/8'
  426. fi
  427. if test -f 'bitmaps/empty' -a "${1}" != "-c" ; then 
  428.   echo shar: Will not clobber existing file \"'bitmaps/empty'\"
  429. else
  430. echo shar: Extracting \"'bitmaps/empty'\" \(278 characters\)
  431. sed "s/^X//" >'bitmaps/empty' <<'END_OF_FILE'
  432. X#define empty_width 16
  433. X#define empty_height 16
  434. Xstatic char empty_bits[] = {
  435. X   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
  436. X   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
  437. X   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00};
  438. END_OF_FILE
  439. if test 278 -ne `wc -c <'bitmaps/empty'`; then
  440.     echo shar: \"'bitmaps/empty'\" unpacked with wrong size!
  441. fi
  442. # end of 'bitmaps/empty'
  443. fi
  444. if test -f 'bitmaps/grey.25' -a "${1}" != "-c" ; then 
  445.   echo shar: Will not clobber existing file \"'bitmaps/grey.25'\"
  446. else
  447. echo shar: Extracting \"'bitmaps/grey.25'\" \(275 characters\)
  448. sed "s/^X//" >'bitmaps/grey.25' <<'END_OF_FILE'
  449. X#define grey_width 16
  450. X#define grey_height 16
  451. Xstatic char grey_bits[] = {
  452. X   0x11, 0x11, 0x44, 0x44, 0x11, 0x11, 0x44, 0x44, 0x11, 0x11, 0x44, 0x44,
  453. X   0x11, 0x11, 0x44, 0x44, 0x11, 0x11, 0x44, 0x44, 0x11, 0x11, 0x44, 0x44,
  454. X   0x11, 0x11, 0x44, 0x44, 0x11, 0x11, 0x44, 0x44};
  455. END_OF_FILE
  456. if test 275 -ne `wc -c <'bitmaps/grey.25'`; then
  457.     echo shar: \"'bitmaps/grey.25'\" unpacked with wrong size!
  458. fi
  459. # end of 'bitmaps/grey.25'
  460. fi
  461. if test -f 'bitmaps/grey.5' -a "${1}" != "-c" ; then 
  462.   echo shar: Will not clobber existing file \"'bitmaps/grey.5'\"
  463. else
  464. echo shar: Extracting \"'bitmaps/grey.5'\" \(275 characters\)
  465. sed "s/^X//" >'bitmaps/grey.5' <<'END_OF_FILE'
  466. X#define grey_width 16
  467. X#define grey_height 16
  468. Xstatic char grey_bits[] = {
  469. X   0x55, 0x55, 0xaa, 0xaa, 0x55, 0x55, 0xaa, 0xaa, 0x55, 0x55, 0xaa, 0xaa,
  470. X   0x55, 0x55, 0xaa, 0xaa, 0x55, 0x55, 0xaa, 0xaa, 0x55, 0x55, 0xaa, 0xaa,
  471. X   0x55, 0x55, 0xaa, 0xaa, 0x55, 0x55, 0xaa, 0xaa};
  472. END_OF_FILE
  473. if test 275 -ne `wc -c <'bitmaps/grey.5'`; then
  474.     echo shar: \"'bitmaps/grey.5'\" unpacked with wrong size!
  475. fi
  476. # end of 'bitmaps/grey.5'
  477. fi
  478. if test -f 'bitmaps/mark' -a "${1}" != "-c" ; then 
  479.   echo shar: Will not clobber existing file \"'bitmaps/mark'\"
  480. else
  481. echo shar: Extracting \"'bitmaps/mark'\" \(275 characters\)
  482. sed "s/^X//" >'bitmaps/mark' <<'END_OF_FILE'
  483. X#define mark_width 16
  484. X#define mark_height 16
  485. Xstatic char mark_bits[] = {
  486. X   0x00, 0x00, 0xfc, 0x3f, 0xfc, 0x3f, 0x00, 0x30, 0x00, 0x30, 0x00, 0x30,
  487. X   0x00, 0x30, 0x80, 0x3f, 0x80, 0x3f, 0x80, 0x01, 0x80, 0x01, 0x00, 0x00,
  488. X   0x00, 0x00, 0x80, 0x01, 0x80, 0x01, 0x00, 0x00};
  489. END_OF_FILE
  490. if test 275 -ne `wc -c <'bitmaps/mark'`; then
  491.     echo shar: \"'bitmaps/mark'\" unpacked with wrong size!
  492. fi
  493. # end of 'bitmaps/mark'
  494. fi
  495. if test -f 'bitmaps/mine' -a "${1}" != "-c" ; then 
  496.   echo shar: Will not clobber existing file \"'bitmaps/mine'\"
  497. else
  498. echo shar: Extracting \"'bitmaps/mine'\" \(275 characters\)
  499. sed "s/^X//" >'bitmaps/mine' <<'END_OF_FILE'
  500. X#define mine_width 16
  501. X#define mine_height 16
  502. Xstatic char mine_bits[] = {
  503. X   0x00, 0x00, 0x00, 0x38, 0x00, 0x3e, 0x00, 0x33, 0xc0, 0x31, 0x60, 0x30,
  504. X   0x60, 0x30, 0xc0, 0x31, 0x00, 0x33, 0x00, 0x3e, 0x00, 0x38, 0x00, 0x30,
  505. X   0x00, 0x30, 0x00, 0x30, 0x00, 0x30, 0x00, 0x00};
  506. END_OF_FILE
  507. if test 275 -ne `wc -c <'bitmaps/mine'`; then
  508.     echo shar: \"'bitmaps/mine'\" unpacked with wrong size!
  509. fi
  510. # end of 'bitmaps/mine'
  511. fi
  512. if test -f 'bitmaps/unfoundMine' -a "${1}" != "-c" ; then 
  513.   echo shar: Will not clobber existing file \"'bitmaps/unfoundMine'\"
  514. else
  515. echo shar: Extracting \"'bitmaps/unfoundMine'\" \(296 characters\)
  516. sed "s/^X//" >'bitmaps/unfoundMine' <<'END_OF_FILE'
  517. X#define unfoundMine_width 16
  518. X#define unfoundMine_height 16
  519. Xstatic char unfoundMine_bits[] = {
  520. X   0x00, 0x00, 0x00, 0x03, 0x80, 0x01, 0xe0, 0x03, 0x98, 0x0c, 0x84, 0x10,
  521. X   0x04, 0x10, 0x02, 0x20, 0x02, 0x20, 0x02, 0x20, 0x02, 0x20, 0x02, 0x20,
  522. X   0x04, 0x10, 0x04, 0x10, 0x18, 0x0c, 0xe0, 0x03};
  523. END_OF_FILE
  524. if test 296 -ne `wc -c <'bitmaps/unfoundMine'`; then
  525.     echo shar: \"'bitmaps/unfoundMine'\" unpacked with wrong size!
  526. fi
  527. # end of 'bitmaps/unfoundMine'
  528. fi
  529. if test -f 'bitmaps/wrongMine' -a "${1}" != "-c" ; then 
  530.   echo shar: Will not clobber existing file \"'bitmaps/wrongMine'\"
  531. else
  532. echo shar: Extracting \"'bitmaps/wrongMine'\" \(290 characters\)
  533. sed "s/^X//" >'bitmaps/wrongMine' <<'END_OF_FILE'
  534. X#define wrongMine_width 16
  535. X#define wrongMine_height 16
  536. Xstatic char wrongMine_bits[] = {
  537. X   0x03, 0xc0, 0x07, 0xf8, 0x0e, 0x7e, 0x1c, 0x3b, 0xd8, 0x39, 0x60, 0x34,
  538. X   0x60, 0x32, 0xc0, 0x31, 0x80, 0x33, 0x40, 0x3e, 0x20, 0x3c, 0x18, 0x38,
  539. X   0x1c, 0x38, 0x0e, 0x70, 0x07, 0xf0, 0x03, 0xc0};
  540. END_OF_FILE
  541. if test 290 -ne `wc -c <'bitmaps/wrongMine'`; then
  542.     echo shar: \"'bitmaps/wrongMine'\" unpacked with wrong size!
  543. fi
  544. # end of 'bitmaps/wrongMine'
  545. fi
  546. if test -f 'help' -a "${1}" != "-c" ; then 
  547.   echo shar: Will not clobber existing file \"'help'\"
  548. else
  549. echo shar: Extracting \"'help'\" \(1842 characters\)
  550. sed "s/^X//" >'help' <<'END_OF_FILE'
  551. XWelcome to tkmines! In this game, you are a minefield inspector,
  552. Xtrying to identify the unsafe spots on a large grid. If you step on
  553. Xa square with a bomb underneath, you lose the game. If, on the other
  554. Xhand, the square you step on has no bomb beneath it, the number of
  555. Xneighboring squares that DO have bombs is etched in the square.
  556. X
  557. XYou must identify all of the unmined squares in order to escape the
  558. Xminefield. You can step on any unknown square at any time.
  559. X
  560. XPress the left mouse button over a square to step on it. Use the
  561. Xinformation revealed as you step on non-mined squares to deduce which
  562. Xother squares have do have mines. If you believe that a particular
  563. Xsquare has a mine, press the right mouse button over it to mark it
  564. X"mined." You are then safe from accidentally stepping on the square.
  565. XOf course, there is no guarantee that your guess is right!
  566. X
  567. XYou have an assistant who will help you step on several squares at
  568. Xonce, but he is very cautious. If you point out a "known" square (one
  569. Xthat you have already stepped on) to him, he will step on all of the
  570. X"non-mined" squares adjacent to the square you show him, under one
  571. Xcondition: that you have marked enough squares "mined" that you can
  572. Xreasonably believe that none of the other neighbor squares are also
  573. Xmined. You can ask him to do this by pressing the middle-mouse button
  574. Xover any known square.
  575. X
  576. XFor example, if you middle-mouse over a square with a "1" in it, and
  577. Xyou have marked one of its neighbors with a mine-flag, your assistant
  578. Xwill step on all of the other squares around the "1." If your flag is
  579. Xmisplaced, though, then your assistant will probably blow you both up!
  580. X
  581. XYou can also mark a square with a "?" by pressing the right-mouse
  582. Xbutton an extra time. The "?" has no effect, other than to help you
  583. Xmark a square as a memory aid.
  584. X
  585. XGood luck, and tread lightly.
  586. X
  587. X
  588. END_OF_FILE
  589. if test 1842 -ne `wc -c <'help'`; then
  590.     echo shar: \"'help'\" unpacked with wrong size!
  591. fi
  592. # end of 'help'
  593. fi
  594. if test -f 'src/gripe.tcl' -a "${1}" != "-c" ; then 
  595.   echo shar: Will not clobber existing file \"'src/gripe.tcl'\"
  596. else
  597. echo shar: Extracting \"'src/gripe.tcl'\" \(828 characters\)
  598. sed "s/^X//" >'src/gripe.tcl' <<'END_OF_FILE'
  599. Xproc gripe {sub} {
  600. X  set w [genName .gripe]
  601. X  toplevel $w
  602. X  wm title $w "Gripe to the author"
  603. X  label $w.l -text "Send a message to the author"
  604. X  frame $w.h
  605. X  frame $w.t -relief sunken -bd 2
  606. X  text $w.t.txt -wrap word
  607. X  pack append $w.t $w.t.txt top
  608. X
  609. X  frameMultChoice $w.b "" [list [list "Send" "sendGripe $w.t.txt $sub; destroy $w"] [list "Cancel" "destroy $w"]] Send
  610. X
  611. X  pack append $w $w.l {top expand fillx} $w.h {top expand fillx} $w.t {top pady 10} $w.b {top pady 20}
  612. X
  613. X  label $w.h.to -text "To: joel@cs.berkeley.edu"
  614. X  label $w.h.sub -text "Subject: $sub"
  615. X  pack append $w.h $w.h.to {top frame w} $w.h.sub {top frame w}
  616. X}
  617. X
  618. Xproc sendGripe {t sub} {
  619. X  global version
  620. X  sendMail "joel@cs.berkeley.edu" "$sub $version gripe!" [$t get 1.0 end]
  621. X}
  622. X
  623. Xproc sendMail {to subject text} {
  624. X  exec echo $text | mail -s $subject $to &
  625. X}
  626. END_OF_FILE
  627. if test 828 -ne `wc -c <'src/gripe.tcl'`; then
  628.     echo shar: \"'src/gripe.tcl'\" unpacked with wrong size!
  629. fi
  630. # end of 'src/gripe.tcl'
  631. fi
  632. if test -f 'src/high.tcl' -a "${1}" != "-c" ; then 
  633.   echo shar: Will not clobber existing file \"'src/high.tcl'\"
  634. else
  635. echo shar: Extracting \"'src/high.tcl'\" \(3963 characters\)
  636. sed "s/^X//" >'src/high.tcl' <<'END_OF_FILE'
  637. X# For debugging
  638. Xproc addRandomHighScore {f} {
  639. X  set type [lindex {small medium big} [random 3]]
  640. X  set time [random 5]:[random 60]
  641. X  echo Adding high score: $type $time
  642. X  addHighScore $time $type
  643. X}
  644. X
  645. X# highlight: which score to highlight?
  646. Xproc showHighScoresReset {f file {highlight {}} {msg {High Score List}}} {
  647. X  readHighScores $file
  648. X  set w [toplevel [genName .scores]]
  649. X  wm title $w "High scores"
  650. X  label $w.title -text $msg
  651. X  pack append $w $w.title top
  652. X  frameHighScore $w.s $highlight
  653. X  pack append $w $w.s top
  654. X  frameMultChoice $w.ok "" [list [list "OK" "destroy $w"] [list "Reset Board" "destroy $w;resetBoard $f"] [list "Quit" "destroy [winfo parent $f]"]] "Reset Board"
  655. X  pack append $w $w.ok top
  656. X}
  657. X
  658. X# highlight: which score to highlight?
  659. Xproc showHighScores {file {highlight {}} {msg {High Score List}}} {
  660. X  readHighScores $file
  661. X  set w [toplevel [genName .scores]]
  662. X  wm title $w "High scores"
  663. X  label $w.title -text $msg
  664. X  pack append $w $w.title top
  665. X  frameHighScore $w.s $highlight
  666. X  pack append $w $w.s top
  667. X  frameMultChoice $w.ok "" [list [list Dismiss "destroy $w"]] Dismiss
  668. X  pack append $w $w.ok top
  669. X}
  670. X
  671. Xproc frameHighScore {f {highlight {}}} {
  672. X  global scores
  673. X  frame $f
  674. X  foreach type {small medium big} {
  675. X    set index 0
  676. X    frame $f.$type -relief raised -bd 2
  677. X    pack append $f $f.$type {left filly expand}
  678. X    label $f.$type.title -text $type
  679. X    pack append $f.$type $f.$type.title top
  680. X    frame $f.$type.name
  681. X    frame $f.$type.time
  682. X    frame $f.$type.date
  683. X    pack append $f.$type $f.$type.name {left filly expand} $f.$type.time {left filly expand} $f.$type.date {left filly expand}
  684. X    label $f.$type.name.title -text "Name"
  685. X    label $f.$type.time.title -text "Time"
  686. X    label $f.$type.date.title -text "Date"
  687. X    pack append $f.$type.name $f.$type.name.title top
  688. X    pack append $f.$type.time $f.$type.time.title top
  689. X    pack append $f.$type.date $f.$type.date.title top
  690. X    foreach scoreLine $scores($type) {
  691. X      label $f.$type.name.$index -text [lindex $scoreLine 1]
  692. X      label $f.$type.time.$index -text [fmtTime [lindex $scoreLine 0]]
  693. X      label $f.$type.date.$index -text [fmtclock [lindex $scoreLine 2] "%D"]
  694. X      pack append $f.$type.name $f.$type.name.$index top
  695. X      pack append $f.$type.time $f.$type.time.$index top
  696. X      pack append $f.$type.date $f.$type.date.$index top
  697. X      incr index
  698. X    }
  699. X  }
  700. X  if {$highlight != {}} {
  701. X    set htype [lindex $highlight 0]
  702. X    set hindex [lindex $highlight 1]
  703. X    $f.$htype.name.$hindex config -relief raised
  704. X    $f.$htype.time.$hindex config -relief raised
  705. X    $f.$htype.date.$hindex config -relief raised
  706. X  }
  707. X}
  708. X
  709. Xproc readHighScores {file} {
  710. X  global scores
  711. X  if {! [file exists $file]} {
  712. X    exec touch $file
  713. X  }
  714. X  set id [open $file r]
  715. X  set scoreList [read $id]
  716. X  set scores(small) [lindex $scoreList 0]
  717. X  set scores(medium) [lindex $scoreList 1]
  718. X  set scores(big) [lindex $scoreList 2]
  719. X  close $id
  720. X}
  721. X
  722. Xproc writeHighScores {file} {
  723. X  global scores
  724. X  write_file $file [list $scores(small) $scores(medium) $scores(big)]
  725. X  catch "chmod 0777 $file"
  726. X}
  727. X
  728. Xproc addHighScore {time boardType} {
  729. X  global scores scoreFile
  730. X
  731. X  # Gotta be an appropriate type of board
  732. X  if {[lsearch {small medium big} $boardType] == -1} {return -1}
  733. X
  734. X  readHighScores $scoreFile
  735. X
  736. X  set score [str2scr $time]
  737. X  set index 0
  738. X  while {$score >= [getScore [lindex $scores($boardType) $index]]} {
  739. X    incr index
  740. X  }
  741. X  set scores($boardType) [linsert $scores($boardType) $index [makeScoreLine $score]]
  742. X
  743. X  set scores($boardType) [lrange $scores($boardType) 0 9]
  744. X
  745. X  writeHighScores $scoreFile
  746. X
  747. X  if {$index < 10} {
  748. X  }
  749. X  return $index
  750. X}
  751. X
  752. Xproc getScore {scoreLine} {
  753. X  if {$scoreLine == {} } {
  754. X    return 99999
  755. X  }
  756. X  return [lindex $scoreLine 0]
  757. X}
  758. X
  759. Xproc makeScoreLine {score} {
  760. X  return [list $score [id user] [getclock]]
  761. X}
  762. X
  763. Xproc str2scr {str} {
  764. X  scan $str "%d:%d" min sec
  765. X  return [expr {60 * $min + $sec}]
  766. X}
  767. X
  768. Xproc scr2str {scr} {
  769. X  set min [expr {$scr / 60}]
  770. X  set sec [expr {$scr % 60}]
  771. X  return "$min:$sec"
  772. X}
  773. END_OF_FILE
  774. if test 3963 -ne `wc -c <'src/high.tcl'`; then
  775.     echo shar: \"'src/high.tcl'\" unpacked with wrong size!
  776. fi
  777. # end of 'src/high.tcl'
  778. fi
  779. if test -f 'src/init.tcl' -a "${1}" != "-c" ; then 
  780.   echo shar: Will not clobber existing file \"'src/init.tcl'\"
  781. else
  782. echo shar: Extracting \"'src/init.tcl'\" \(773 characters\)
  783. sed "s/^X//" >'src/init.tcl' <<'END_OF_FILE'
  784. Xset width 10
  785. Xset height 10
  786. Xset mines 0
  787. Xset bugs 0
  788. Xset buttonWidth 24
  789. Xset buttonHeight 24
  790. X
  791. Xproc minwidth {} {
  792. X  return 3
  793. X}
  794. X
  795. Xproc minheight {} {
  796. X  return 3
  797. X}
  798. X
  799. Xproc maxwidth {} {
  800. X  global buttonWidth
  801. X  set rslt [expr {[winfo screenwidth .] / $buttonWidth}]
  802. X  return $rslt
  803. X}
  804. X
  805. Xproc maxheight {} {
  806. X  global buttonHeight
  807. X  set rslt [expr {[winfo screenheight .] / $buttonHeight - 3}]
  808. X  return $rslt
  809. X}
  810. X
  811. Xproc stdmines {width height} {
  812. X  set std [toint [expr {($width * $height) * .15}]]
  813. X  if {$std < [minmines $width $height]} {
  814. X    set std [minmines $width $height]
  815. X  }
  816. X  return $std
  817. X}
  818. X
  819. Xproc minmines {width height} {
  820. X  return 2
  821. X}
  822. X
  823. Xproc maxmines {width height} {
  824. X  return [expr {$width * $height - 2}]
  825. X}
  826. X
  827. Xproc getBitmap {name} {
  828. X  global libDir
  829. X  return "@$libDir/bitmaps/$name"
  830. X}
  831. END_OF_FILE
  832. if test 773 -ne `wc -c <'src/init.tcl'`; then
  833.     echo shar: \"'src/init.tcl'\" unpacked with wrong size!
  834. fi
  835. # end of 'src/init.tcl'
  836. fi
  837. if test -f 'src/load.tcl' -a "${1}" != "-c" ; then 
  838.   echo shar: Will not clobber existing file \"'src/load.tcl'\"
  839. else
  840. echo shar: Extracting \"'src/load.tcl'\" \(539 characters\)
  841. sed "s/^X//" >'src/load.tcl' <<'END_OF_FILE'
  842. X# exit on ^C
  843. Xsignal default SIGINT
  844. X
  845. X# Check for Extended TCL
  846. Xif { ! [info exists TCLINIT] } {
  847. X  puts stdout "You need Extended TCL to run tkmines. You can get that from"
  848. X  puts stdout "sprite.berkeley.edu, anonymous ftp, directory tcl, file tclX6.4c.tar.Z."
  849. X  exit
  850. X}
  851. X
  852. Xsource "$sourceDir/init.tcl"
  853. Xsource "$sourceDir/mines.tcl"
  854. Xsource "$sourceDir/misc.tcl"
  855. Xsource "$sourceDir/random.tcl"
  856. Xsource "$sourceDir/util.tcl"
  857. Xsource "$sourceDir/gripe.tcl"
  858. Xsource "$sourceDir/high.tcl"
  859. Xsource "$sourceDir/parseArgs.tcl"
  860. Xsource "$sourceDir/start.tcl"
  861. END_OF_FILE
  862. if test 539 -ne `wc -c <'src/load.tcl'`; then
  863.     echo shar: \"'src/load.tcl'\" unpacked with wrong size!
  864. fi
  865. # end of 'src/load.tcl'
  866. fi
  867. if test -f 'src/mines.tcl' -a "${1}" != "-c" ; then 
  868.   echo shar: Will not clobber existing file \"'src/mines.tcl'\"
  869. else
  870. echo shar: Extracting \"'src/mines.tcl'\" \(17523 characters\)
  871. sed "s/^X//" >'src/mines.tcl' <<'END_OF_FILE'
  872. X# $f is frame/top window (already created)
  873. X# $w is width
  874. X# $h is height
  875. X# $m is number of mines
  876. Xproc makeBoard {f w h m} {
  877. X  global bugs scoreFile $f.width $f.height $f.mines $f.area $f.squareList
  878. X  set $f.width $w
  879. X  set $f.height $h
  880. X  set $f.mines $m
  881. X  set $f.area [expr {$w * $h}]
  882. X  set $f.squareList {}
  883. X
  884. X  # Le menu
  885. X  frame $f.m
  886. X  menubutton $f.m.mb -text "Options" -menu $f.m.m -relief raised
  887. X  button $f.m.help -text "Help" -command "helpMines"
  888. X  pack append $f.m $f.m.mb {left frame w} $f.m.help {right frame e}
  889. X
  890. X  menu $f.m.m
  891. X  $f.m.m add command -label "Play Again" -command "askResetBoard $f"
  892. X  $f.m.m add cascade -label "Resize" -menu $f.m.mr
  893. X  $f.m.m add command -label "Give Up" -command "askShowAll $f"
  894. X  $f.m.m add command -label "About..." -command "aboutMines"
  895. X  $f.m.m add command -label "Gripe..." -command "gripe tkmines"
  896. X  $f.m.m add command -label "High Scores..." -command "showHighScores $scoreFile"
  897. X  $f.m.m add command -label "Quit" -command "quit Mines"
  898. X  if {$bugs} {
  899. X    $f.m.m add command -label "Profile" -command "printProfile"
  900. X  }
  901. X
  902. X  menu $f.m.mr
  903. X  $f.m.mr add command -label "Small" -command "askResizeBoard $f small"
  904. X  $f.m.mr add command -label "Medium" -command "askResizeBoard $f medium"
  905. X  $f.m.mr add command -label "Big" -command "askResizeBoard $f big"
  906. X  $f.m.mr add command -label "Max" -command "askResizeBoard $f max"
  907. X  $f.m.mr add command -label "Custom..." -command "askResizeBoard $f custom"
  908. X
  909. X  # Status stuff
  910. X  frame $f.st
  911. X
  912. X  frame $f.st.m
  913. X  frame $f.st.t
  914. X  pack append $f.st $f.st.m {left frame w padx 20} $f.st.t {left frame e padx 20}
  915. X
  916. X  # Mine counts
  917. X  frame $f.st.m.l
  918. X  frame $f.st.m.n
  919. X  pack append $f.st.m $f.st.m.l {left fillx} $f.st.m.n {left fillx}
  920. X
  921. X  label $f.st.m.l.found -text "Mines found:"
  922. X  label $f.st.m.l.mines -text "Mines:"
  923. X  pack append $f.st.m.l $f.st.m.l.found {top frame w} $f.st.m.l.mines {top frame w}
  924. X
  925. X  label $f.st.m.n.found -relief sunken -width 3
  926. X  label $f.st.m.n.mines -relief sunken -width 3
  927. X  pack append $f.st.m.n $f.st.m.n.found {top frame e} $f.st.m.n.mines {top frame e}
  928. X
  929. X  # Time
  930. X  label $f.st.t.l -text "Time:"
  931. X  label $f.st.t.n -relief sunken -width 4
  932. X  pack append $f.st.t $f.st.t.l {left frame w} $f.st.t.n {left frame e}
  933. X
  934. X  # Buttons
  935. X  frame $f.b
  936. X
  937. X  pack append $f $f.m {top fillx} $f.st {top pady 20} $f.b top
  938. X
  939. X  for {set row 0} {$row < $h} {incr row} {
  940. X    frame $f.b.$row
  941. X    pack append $f.b $f.b.$row top
  942. X    for {set col 0} {$col < $w} {incr col} {
  943. X      button $f.b.$row.$col
  944. X      pack append $f.b.$row $f.b.$row.$col left
  945. X      lappend $f.squareList "$row $col"
  946. X      $f.b.$row.$col config -command "showSquare $f $row $col"
  947. X      bind $f.b.$row.$col <3> {eval markSquare [getSquare %W]}
  948. X      bind $f.b.$row.$col <2> {
  949. X        set testSquare [getSquare %W]
  950. X        eval sinkNeighbors $testSquare
  951. X      }
  952. X      bind $f.b.$row.$col <ButtonRelease-2> {
  953. X        if {$testSquare != {}} {
  954. X          eval testSquare $testSquare
  955. X        }
  956. X      }
  957. X      bind $f.b.$row.$col <B2-Leave> {
  958. X        eval raiseNeighbors [getSquare %W]
  959. X        set testSquare {}
  960. X      }
  961. X      #bind $f.b.$row.$col <Any-B2-Enter> {eval sinkNeighbors [getSquare %W]}
  962. X    }
  963. X  }
  964. X  resetBoard $f
  965. X}
  966. X
  967. Xproc getSquare {w} {
  968. X  set l [split $w .]
  969. X  set len [llength $l]
  970. X  set f [join [lrange $l 0 [expr {$len - 4}]] .]
  971. X  set r [lindex $l [expr {$len - 2}]]
  972. X  set c [lindex $l [expr {$len - 1}]]
  973. X  return [list $f $r $c]
  974. X}
  975. X
  976. Xproc resetBoard {f} {
  977. X  global $f.height $f.width $f.mines $f.minesguessed $f.squaresknown
  978. X  global $f.done $f.started $f.lRow $f.lCol $f.visited
  979. X  set h [set $f.height]
  980. X  set w [set $f.width]
  981. X  set m [set $f.mines]
  982. X  for {set row 0} {$row < $h} {incr row} {
  983. X    for {set col 0} {$col < $w} {incr col} {
  984. X      initSquare $f $row $col
  985. X    }
  986. X  }
  987. X  set $f.minesguessed 0
  988. X  set $f.squaresknown 0
  989. X  set $f.done 0
  990. X  set $f.started 0
  991. X  set $f.visited {}
  992. X  $f.st.m.n.mines config -text "$m"
  993. X  updateMinesguessed $f
  994. X  resetTime $f
  995. X  updateTime $f
  996. X  setMines $f $m
  997. X  set $f.lRow 0
  998. X  set $f.lCol 0
  999. X  lazyUpdate $f
  1000. X  #hashMines $f
  1001. X}
  1002. X
  1003. Xproc askResetBoard {f} {
  1004. X  global $f.done
  1005. X  if {[set $f.done]} {
  1006. X    resetBoard $f
  1007. X    return
  1008. X  }
  1009. X  yesNo "Reset Mines Board" "Are you sure you want to reset the board?" "resetBoard $f" "noop" No
  1010. X}
  1011. X
  1012. Xproc askResizeBoard {f type} {
  1013. X  global $f.done $f.started
  1014. X  set done [set $f.done]
  1015. X  set started [set $f.started]
  1016. X  case $type {
  1017. X    "small" {
  1018. X      set width 10
  1019. X      set height 10
  1020. X    }
  1021. X    "medium" {
  1022. X      set width 20
  1023. X      set height 10
  1024. X    }
  1025. X    "big" {
  1026. X      set width 40
  1027. X      set height 20
  1028. X    }
  1029. X    "max" {
  1030. X      set width [maxwidth]
  1031. X      set height [maxheight]
  1032. X    }
  1033. X    "custom" {
  1034. X      customResize $f
  1035. X      return
  1036. X    }
  1037. X  }
  1038. X  set mines [stdmines $width $height]
  1039. X  if {$done || ! $started} {
  1040. X    resizeBoard $f $width $height $mines
  1041. X    return
  1042. X  }
  1043. 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
  1044. X}
  1045. X
  1046. Xproc askShowAll {f} {
  1047. X  global $f.done
  1048. X  if {[set $f.done]} {
  1049. X    inform "You can't give up; the game is already over!"
  1050. X  } else {
  1051. X    yesNo "Give Up Mines" "Are you sure you want to give up the game?" "showAll $f" "noop" No
  1052. X  }
  1053. X}
  1054. X
  1055. Xproc aboutMines {} {
  1056. X  global version
  1057. X  inform "tkmines version $version, by Joel A. Fine"
  1058. X}
  1059. X
  1060. Xproc helpMines {} {
  1061. X  global helpFile
  1062. X  set id [open "$helpFile" r]
  1063. X  set msg [read $id]
  1064. X  inform $msg
  1065. X}
  1066. X
  1067. Xproc showAll {f} {
  1068. X  global $f.width $f.height $f.done
  1069. X  set w [set $f.width]
  1070. X  set h [set $f.height]
  1071. X  set $f.done 1
  1072. X  for {set row 0} {$row < $h} {incr row} {
  1073. X    for {set col 0} {$col < $w} {incr col} {
  1074. X      set guess [getGuess $f $row $col]
  1075. X      setGuess $f $row $col known
  1076. X      if {$guess == "known"} {
  1077. X        continue
  1078. X      }
  1079. X      global $f.$row.$col.mined
  1080. X      # We don't know for sure what this is
  1081. X      if {$guess == "mine"} {
  1082. X        # We think it's a mine
  1083. X        if {[set $f.$row.$col.mined]} {
  1084. X          continue
  1085. X        }
  1086. X        # Wrong!
  1087. X        $f.b.$row.$col config -bitmap [getBitmap wrongMine]
  1088. X        continue
  1089. X      }
  1090. X      if {[set $f.$row.$col.mined]} {
  1091. X        $f.b.$row.$col config -bitmap [getBitmap unfoundMine]
  1092. X      }
  1093. X    }
  1094. X    update
  1095. X  }
  1096. X}
  1097. X
  1098. Xproc customResize {f} {
  1099. X  global $f.width $f.height $f.mines
  1100. X  set w [genName .customResetSize]
  1101. X  toplevel $w
  1102. X  wm title $w "Custom Board Size"
  1103. X
  1104. X  frame $w.m
  1105. X  label $w.m.l -text "Mine Count:"
  1106. X  radiobutton $w.m.std -text "Standard" -variable useStdMineCount -value 1 -command "$w.m.scale config -state disabled"
  1107. X  label $w.m.stdl -relief sunken -width 3
  1108. X  radiobutton $w.m.custom -text "Custom" -variable useStdMineCount -value 0 -command "$w.m.scale config -state normal"
  1109. X  scale $w.m.scale -orient horizontal -length 200
  1110. X
  1111. X  $w.m.scale set [set $f.mines]
  1112. X  $w.m.std invoke
  1113. X
  1114. 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
  1115. X
  1116. X  scale $w.w -label "Width:" -orient horizontal -length 200 -from [minwidth] -to [maxwidth]
  1117. X  scale $w.h -label "Height:" -orient horizontal -length 200 -from [minheight] -to [maxheight]
  1118. X
  1119. X  $w.w config -command "customMineScale $w"
  1120. X  $w.h config -command "customMineScale $w"
  1121. X
  1122. X  $w.w set [set $f.width]
  1123. X  $w.h set [set $f.height]
  1124. X
  1125. X  pack append $w $w.w top $w.h top $w.m top
  1126. X
  1127. X  frameMultChoice $w.yesNo "" [list [list "Resize Board" "resizeBoardCustom $f $w"] [list "Cancel" "destroy $w"]] Cancel
  1128. X  pack append $w $w.yesNo {top fillx}
  1129. X}
  1130. X
  1131. Xproc customMineScale {w num} {
  1132. X  set min [minmines [$w.w get] [$w.h get]]
  1133. X  set max [maxmines [$w.w get] [$w.h get]]
  1134. X  set std [stdmines [$w.w get] [$w.h get]]
  1135. X  $w.m.scale config -from $min
  1136. X  $w.m.scale config -to   $max
  1137. X  $w.m.scale config -tickinterval [expr {$max - $min}]
  1138. X  $w.m.stdl config -text $std
  1139. X}
  1140. X
  1141. Xproc resizeBoardCustom {f win} {
  1142. X  global useStdMineCount
  1143. X  set w [$win.w get]
  1144. X  set h [$win.h get]
  1145. X  if {$useStdMineCount} {
  1146. X    set m [stdmines $w $h]
  1147. X  } else {
  1148. X    set m [$win.m.scale get]
  1149. X  }
  1150. X  if {$w > [maxwidth] || $w < [minwidth]} {
  1151. X    warn "Width must be between [minwidth] and [maxwidth]."
  1152. X    return
  1153. X  }
  1154. X  if {$h > [maxheight] || $h < [minheight]} {
  1155. X    warn "Height must be between [minheight] and [maxheight]."
  1156. X    return
  1157. X  }
  1158. X  if {$m > [maxmines $w $h] || $m < [minmines $w $h]} {
  1159. X    warn "Number of mines must be between [minmines $w $h] and [maxmines $w $h] for a board this size"
  1160. X    return
  1161. X  }
  1162. X  resizeBoard $f $w $h $m
  1163. X  destroy $win
  1164. X}
  1165. X
  1166. Xproc resizeBoard {f w h m} {
  1167. X  if {! [ctype digit $w]} {
  1168. X    warn "$w is not a valid width."
  1169. X    return
  1170. X  }
  1171. X  if {! [ctype digit $h]} {
  1172. X    warn "$w is not a valid height."
  1173. X    return
  1174. X  }
  1175. X  if {! [ctype digit $m]} {
  1176. X    warn "$w is not a valid number of mines."
  1177. X    return
  1178. X  }
  1179. X  if {$w > [maxwidth] || $h > [maxheight]} {
  1180. X    warn "That board is too big! It wouldn't fit on the screen."
  1181. X    return
  1182. X  }
  1183. X  set win [inform "Resizing board. Please stand by."]
  1184. X  destroy $f
  1185. X  toplevel $f
  1186. X  wm title $f Mines
  1187. X  makeBoard $f $w $h $m
  1188. X  destroy $win
  1189. X}
  1190. X
  1191. X# $f is frame/top window
  1192. X# $m is number of mines
  1193. Xproc setMines {f m} {
  1194. X  global $f.squareList
  1195. X  global $f.mineList
  1196. X  set squareList [set $f.squareList]
  1197. X  set $f.mineList [choose $m $squareList]
  1198. X  foreach square [set $f.mineList] {
  1199. X    makeMined $f [lindex $square 0] [lindex $square 1]
  1200. X  }
  1201. X}
  1202. X
  1203. Xproc initSquare {f row col} {
  1204. X  global $f.$row.$col.nbrguessed $f.$row.$col.value
  1205. X  if {[info exists $f.$row.$col.value]} {
  1206. X    unset $f.$row.$col.value
  1207. X  }
  1208. X  set $f.$row.$col.nbrguessed 0
  1209. X  setGuess $f $row $col empty
  1210. X  makeEmpty $f $row $col
  1211. X  $f.b.$row.$col config -background lightgrey -activebackground grey -relief raised
  1212. X}
  1213. X
  1214. Xproc resetTime {f} {
  1215. X  global $f.time
  1216. X  set $f.time [getclock]
  1217. X}
  1218. X
  1219. Xproc updateTime {f} {
  1220. X  global $f.done
  1221. X  $f.st.t.n config -text [getTime $f]
  1222. X  if {[set $f.done]} {return}
  1223. X  after 1000 updateTime $f
  1224. X}
  1225. X
  1226. Xproc updateSquaresknown {f} {
  1227. X  global $f.squaresknown
  1228. X  #echo known: [set $f.squaresknown]
  1229. X  checkWin $f
  1230. X}
  1231. X
  1232. Xproc updateMinesguessed {f} {
  1233. X  global $f.minesguessed
  1234. X  $f.st.m.n.found config -text [set $f.minesguessed]
  1235. X}
  1236. X
  1237. Xproc checkWin {f} {
  1238. X  global $f.squaresknown $f.area $f.mines
  1239. X  set squaresknown [set $f.squaresknown]
  1240. X  set area [set $f.area]
  1241. X  set mines [set $f.mines]
  1242. X  if {[expr {$squaresknown + $mines}] == $area} {
  1243. X    winGame $f [getTime $f]
  1244. X  }
  1245. X}
  1246. X
  1247. Xproc getTime {f} {
  1248. X  global $f.time $f.started
  1249. X  if {! [set $f.started]} {
  1250. X    resetTime $f
  1251. X  }
  1252. X  set start [set $f.time]
  1253. X  set now [getclock]
  1254. X  set diff [expr {$now - $start}]
  1255. X  return [fmtTime $diff]
  1256. X}
  1257. X
  1258. Xproc fmtTime {time} {
  1259. X  set min [expr {$time / 60}]
  1260. X  set sec [expr {$time % 60}]
  1261. X  # Format the time
  1262. X  if {$sec == 0} {return "$min:00"}
  1263. X  if {$sec < 10} {return "$min:0$sec"}
  1264. X  return "$min:$sec"
  1265. X}
  1266. X
  1267. Xproc makeMined {f row col} {
  1268. X  global $f.$row.$col.mined
  1269. X  set $f.$row.$col.mined 1
  1270. X  # For debugging
  1271. X  # $f.b.$row.$col config -foreground red
  1272. X}
  1273. X
  1274. Xproc makeEmpty {f row col} {
  1275. X  global $f.$row.$col.mined
  1276. X  set $f.$row.$col.mined 0
  1277. X}
  1278. X
  1279. X# Every so often, count up the neighbor-mines of another square.
  1280. Xproc lazyUpdate {f} {
  1281. X  global $f.width $f.height $f.lRow $f.lCol
  1282. X  set row [set $f.lRow]
  1283. X  set col [set $f.lCol]
  1284. X  global $f.$row.$col.value
  1285. X  #if {[info exists $f.$row.$col.value]} {return}
  1286. X  set $f.$row.$col.value [countNeighborMines $f $row $col]
  1287. X  incr col
  1288. X  if {$col == [set $f.width]} {
  1289. X    set col 0
  1290. X    incr row
  1291. X  }
  1292. X  set $f.lRow $row
  1293. X  set $f.lCol $col
  1294. X  if {$row != [set $f.height]} {
  1295. X    after 50 lazyUpdate $f
  1296. X  }
  1297. X}
  1298. X
  1299. X# How many neighbors are mines?
  1300. Xproc countNeighborMines {f row col} {
  1301. X  global $f.$row.$col.value
  1302. X  # Just in case I've computed it already
  1303. X  if {[info exists $f.$row.$col.value]} {
  1304. X    return [set $f.$row.$col.value]
  1305. X  }
  1306. X  set count 0
  1307. X  foreach square [getNeighbors $f $row $col] {
  1308. X    set nr [lindex $square 0]
  1309. X    set nc [lindex $square 1]
  1310. X    global $f.$nr.$nc.mined
  1311. X    incr count [set $f.$nr.$nc.mined]
  1312. X  }
  1313. X
  1314. X  return $count
  1315. X}
  1316. X
  1317. Xproc visitSquare {f row col} {
  1318. X  global $f.$row.$col.mined $f.squaresknown $f.started
  1319. X  if {[getGuess $f $row $col] == "known"} {
  1320. X    return
  1321. X  }
  1322. X  if {[getGuess $f $row $col] == "mine"} {
  1323. X    return
  1324. X  }
  1325. X  if {[set $f.$row.$col.mined]} {
  1326. X    $f.b.$row.$col config -background red -activeforeground red
  1327. X    loseGame $f [getTime $f]
  1328. X    return
  1329. X  }
  1330. X  if {! [set $f.started]} {
  1331. X    set $f.started 1
  1332. X  }
  1333. X  set count [countNeighborMines $f $row $col]
  1334. X  setGuess $f $row $col known
  1335. X  incr $f.squaresknown
  1336. X  updateSquaresknown $f
  1337. X  $f.b.$row.$col config -bitmap [getBitmap $count]
  1338. X  $f.b.$row.$col config -foreground [getForeground $count] -activeforeground [getForeground $count] -activebackground lightgrey
  1339. X  $f.b.$row.$col config -relief sunken
  1340. X  update
  1341. X}
  1342. X
  1343. Xproc showSquare {f row col} {
  1344. X  global $f.visited
  1345. X  visitSquare $f $row $col
  1346. X  set count [countNeighborMines $f $row $col]
  1347. X  if {$count == 0} {
  1348. X    #set $f.visited {}
  1349. X    set zero {}
  1350. X    while 1 {
  1351. X      foreach square [getNeighbors $f $row $col] {
  1352. X        set nr [lindex $square 0]
  1353. X        set nc [lindex $square 1]
  1354. X        visitSquare $f $nr $nc
  1355. X        if ![countNeighborMines $f $nr $nc] {
  1356. X          if {[lsearch [set $f.visited] $square] < 0} {lappend zero $square}
  1357. X        }
  1358. X        if {[lsearch [set $f.visited] $square] < 0} {lappend $f.visited $square}
  1359. X      }
  1360. X      if {[llength $zero] != 0} {
  1361. X        set row [lindex [lindex $zero 0] 0]
  1362. X        set col [lindex [lindex $zero 0] 1]
  1363. X        set zero [lrange $zero 1 end]
  1364. X      } else {
  1365. X        return
  1366. X      }
  1367. X    }
  1368. X  }
  1369. X}
  1370. X
  1371. Xproc markSquare {f row col} {
  1372. X  set guess [getGuess $f $row $col]
  1373. X  if {$guess == "known"} {return}
  1374. X  case $guess {
  1375. X    "empty" {
  1376. X      set guess mine
  1377. X      set incr 1
  1378. X    }
  1379. X    "mine" {
  1380. X      set guess mark
  1381. X      set incr -1
  1382. X    }
  1383. X    "mark" {
  1384. X      set guess empty
  1385. X      set incr 0
  1386. X    }
  1387. X  }
  1388. X  setGuess $f $row $col $guess
  1389. X  foreach square [getNeighbors $f $row $col] {
  1390. X    set nr [lindex $square 0]
  1391. X    set nc [lindex $square 1]
  1392. X    global $f.$nr.$nc.nbrguessed
  1393. X    incr $f.$nr.$nc.nbrguessed $incr
  1394. X  }
  1395. X  global $f.minesguessed
  1396. X  incr $f.minesguessed $incr
  1397. X  updateMinesguessed $f
  1398. X}
  1399. X
  1400. Xproc setGuess {f row col guess} {
  1401. X  global $f.$row.$col.guess
  1402. X  set $f.$row.$col.guess $guess
  1403. X  if {$guess != "known"} {
  1404. X    $f.b.$row.$col config -bitmap [getBitmap $guess]
  1405. X    $f.b.$row.$col config -foreground [getForeground $guess]
  1406. X    $f.b.$row.$col config -activeforeground [getActiveForeground $guess]
  1407. X  }
  1408. X}
  1409. X
  1410. Xproc getGuess {f row col} {
  1411. X  getParam $f $row $col guess
  1412. X}
  1413. X
  1414. Xproc getParam {f row col param} {
  1415. X  global $f.$row.$col.$param
  1416. X  return [set $f.$row.$col.$param]
  1417. X}
  1418. X
  1419. Xproc getActiveForeground {value} {
  1420. X  if {[winfo screendepth .] <= 1} {
  1421. X    return black
  1422. X  }
  1423. X  case $value {
  1424. X    "mine" {return red}
  1425. X    "mark" {return black}
  1426. X    "empty" {return black}
  1427. X  }
  1428. X}
  1429. X
  1430. Xproc getForeground {value} {
  1431. X  if {[winfo screendepth .] <= 1} {
  1432. X    return black
  1433. X  }
  1434. X  case $value {
  1435. X    "mine" {return red}
  1436. X    "mark" {return black}
  1437. X    "empty" {return black}
  1438. X    "0" {return lightgrey}
  1439. X    "1" {return blue}
  1440. X    "2" {return seagreen}
  1441. X    "3" {return red}
  1442. X    "4" {return white}
  1443. X    "5" {return black}
  1444. X    "6" {return yellow}
  1445. X    "7" {return limegreen}
  1446. X    "8" {return limegreen}
  1447. X  }
  1448. X}
  1449. X
  1450. Xproc sinkNeighbors {f row col} {
  1451. X  global $f.done
  1452. X  if {[set $f.done]} {return}
  1453. X  foreach square [getNeighbors $f $row $col] {
  1454. X    set nr [lindex $square 0]
  1455. X    set nc [lindex $square 1]
  1456. X    set guess [getGuess $f $nr $nc]
  1457. X    if {$guess != "mine"} {
  1458. X      $f.b.$nr.$nc config -relief sunken
  1459. X    }
  1460. X  }
  1461. X  $f.b.$row.$col config -relief sunken
  1462. X}
  1463. X
  1464. Xproc raiseNeighbors {f row col} {
  1465. X  foreach square [getNeighbors $f $row $col] {
  1466. X    set nr [lindex $square 0]
  1467. X    set nc [lindex $square 1]
  1468. X    set guess [getGuess $f $nr $nc]
  1469. X    if {$guess != "known"} {
  1470. X      $f.b.$nr.$nc config -relief raised
  1471. X    }
  1472. X  }
  1473. X  if {[getGuess $f $row $col] != "known"} {
  1474. X    $f.b.$row.$col config -relief raised
  1475. X  }
  1476. X}
  1477. X
  1478. X
  1479. X# $f.$row.$col.nbrguessed = number of neighbors guessed to be bombs.
  1480. X
  1481. X# If I already know the value of this button, and I've already marked
  1482. X# that many mines around it, expose the rest of its neighbors.
  1483. Xproc testSquare {f row col} {
  1484. X  global $f.$row.$col.nbrguessed
  1485. X  raiseNeighbors $f $row $col
  1486. X  # If the square isn't known, testSquare does nothing.
  1487. X  if {[getGuess $f $row $col] != "known"} {
  1488. X    return
  1489. X  }
  1490. X  set value [countNeighborMines $f $row $col]
  1491. X  set nbrguessed [set $f.$row.$col.nbrguessed]
  1492. X  if {$value <= $nbrguessed} {
  1493. X    foreach square [getNeighbors $f $row $col] {
  1494. X      set nr [lindex $square 0]
  1495. X      set nc [lindex $square 1]
  1496. X      if {[getGuess $f $nr $nc] != "mine"} {
  1497. X        showSquare $f $nr $nc
  1498. X      }
  1499. X    }
  1500. X  }
  1501. X}
  1502. X
  1503. Xproc loseGame {f time} {
  1504. X  showAll $f
  1505. X  multChoice "Loser!" "You lost, in only $time!" [list {OK noop} [list "Play Again" "resetBoard $f"] [list "Quit" "quit Mines 0"]] "Play Again"
  1506. X}
  1507. X
  1508. Xproc winGame {f time} {
  1509. X  global scoreFile
  1510. X  showAll $f
  1511. X  set boardType [boardType $f]
  1512. X  set index [addHighScore $time $boardType ]
  1513. X  if { $index < 10 && $index > -1 } {
  1514. X    # Made the high score list
  1515. X    showHighScoresReset $f $scoreFile [list $boardType $index] "Congratulations, you made the high score list!"
  1516. X  } else {
  1517. X    multChoice "Winner!" "You won, in only $time!" [list {OK noop} [list "Play Again" "resetBoard $f"] [list "Quit" "quit Mines 0"]] "Play Again"
  1518. X  }
  1519. X}
  1520. X
  1521. Xproc printProfile {} {
  1522. X  # Profiling should already be turned on by the time this procedure
  1523. X  # is called
  1524. X  profile off pro
  1525. X  profrep pro cpu 3
  1526. X  profile -commands on
  1527. X}
  1528. X
  1529. Xproc boardType {f} {
  1530. X  global $f.width $f.height $f.mines
  1531. X  set w [set $f.width]
  1532. X  set h [set $f.height]
  1533. X  set m [set $f.mines]
  1534. X  if {$w == 10 && $h == 10 && $m == 15} {
  1535. X    return "small"
  1536. X  }
  1537. X  if {$w == 20 && $h == 10 && $m == 30} {
  1538. X    return "medium"
  1539. X  }
  1540. X  if {$w == 40 && $h == 20 && $m == 120} {
  1541. X    return "big"
  1542. X  }
  1543. X}
  1544. END_OF_FILE
  1545. if test 17523 -ne `wc -c <'src/mines.tcl'`; then
  1546.     echo shar: \"'src/mines.tcl'\" unpacked with wrong size!
  1547. fi
  1548. # end of 'src/mines.tcl'
  1549. fi
  1550. if test -f 'src/misc.tcl' -a "${1}" != "-c" ; then 
  1551.   echo shar: Will not clobber existing file \"'src/misc.tcl'\"
  1552. else
  1553. echo shar: Extracting \"'src/misc.tcl'\" \(3363 characters\)
  1554. sed "s/^X//" >'src/misc.tcl' <<'END_OF_FILE'
  1555. Xproc waitFor {w} {
  1556. X  global $w.iHaveBeenExposed
  1557. X  set $w.iHaveBeenExposed 0
  1558. X  bind $w <Expose> "set $w.iHaveBeenExposed 1"
  1559. X  #tkwait variable $w.iHaveBeenExposed
  1560. X  bind $w <Expose> ""
  1561. X  update
  1562. X}
  1563. X
  1564. Xproc inform { msg {aspect 1000}} {
  1565. X  set w [genName .info]
  1566. X  toplevel $w
  1567. X  wm title $w "Information"
  1568. X  frame $w.m
  1569. X  pack append $w $w.m {top expand fill}
  1570. X
  1571. X  message $w.m.l -text "$msg" -aspect $aspect
  1572. X  button $w.m.b -command "destroy $w" -text "Dismiss"
  1573. X
  1574. X  pack append $w.m $w.m.l top $w.m.b top
  1575. X  waitFor $w
  1576. X  grab $w
  1577. X  return $w
  1578. X}
  1579. X
  1580. Xproc warn { msg {aspect 1000}} {
  1581. X  set w [genName .warn]
  1582. X  toplevel $w
  1583. X  wm title $w "Warning!"
  1584. X  frame $w.m
  1585. X  pack append $w $w.m {top expand fill}
  1586. X
  1587. X  message $w.m.l -text "Warning: $msg" -aspect $aspect
  1588. X  button $w.m.b -command "destroy $w" -text "OK"
  1589. X
  1590. X  pack append $w.m $w.m.l top $w.m.b top
  1591. X  waitFor $w
  1592. X  grab $w
  1593. X  return $w
  1594. X}
  1595. X
  1596. Xproc genName {{var var}} {
  1597. X  global nameCount
  1598. X  if [info exists nameCount($var)] {
  1599. X    incr nameCount($var)
  1600. X  } else {
  1601. X    set nameCount($var) 0
  1602. X  }
  1603. X  return "$var$nameCount($var)"
  1604. X}
  1605. X
  1606. Xproc frameMultChoice {frame msg choices default} {
  1607. X  frame $frame
  1608. X  subMultChoice $frame $msg $choices $default
  1609. X}
  1610. X
  1611. Xproc multChoice {title msg choices default} {
  1612. X  set w [genName .mult]
  1613. X  toplevel $w
  1614. X  wm title $w $title
  1615. X  subMultChoice $w $msg $choices $default
  1616. X  grab $w
  1617. X}
  1618. X
  1619. Xproc subMultChoice {w msg choices default} {
  1620. X  set var [genName]
  1621. X  frame $w.m -relief raised -border 1
  1622. X  frame $w.b -relief raised -border 1
  1623. X  set style {top fill expand}
  1624. X  if {$msg != ""} {
  1625. X    pack append $w $w.m $style
  1626. X  }
  1627. X  pack append $w $w.b $style
  1628. X  label $w.m.l -text $msg
  1629. X  pack append $w.m $w.m.l top
  1630. X  foreach i $choices {
  1631. X    set text [lindex $i 0]
  1632. X    set command [lindex $i 1]
  1633. X    set style1 {left expand padx 40 pady 20}
  1634. X    if {$text == $default} {
  1635. X      set style2 {expand padx 5 pady 5}
  1636. X      set button default
  1637. X    } {
  1638. X      set style2 {expand}
  1639. X      set button [genName button]
  1640. X    }
  1641. X    frame $w.b.$button -relief sunken -border 1
  1642. X    pack append $w.b $w.b.$button $style1
  1643. X    button $w.b.$button.b -text $text -command "destroy $w; $command"
  1644. X    pack append $w.b.$button $w.b.$button.b $style2
  1645. X    bind $w.b.$button <Enter> "$w.b.$button.b activate"
  1646. X    bind $w.b.$button <Leave> "$w.b.$button.b deactivate"
  1647. X    bind $w.b.$button <Return> "$w.b.$button.b invoke"
  1648. X    bind $w.b.$button.b <Return> "$w.b.$button.b invoke"
  1649. X  }
  1650. X  bind $w.m <Enter>    "$w.b.default.b activate"
  1651. X  bind $w.m.l <Enter>    "$w.b.default.b activate"
  1652. X  bind $w.b <Enter>    "$w.b.default.b activate"
  1653. X  bind $w.m <Leave>    "$w.b.default.b deactivate"
  1654. X  bind $w.m.l <Leave>    "$w.b.default.b deactivate"
  1655. X  bind $w.b <Leave>    "$w.b.default.b deactivate"
  1656. X  bind $w.m <Return>    "$w.b.default.b invoke"
  1657. X  bind $w.m.l <Return>    "$w.b.default.b invoke"
  1658. X  bind $w.b <Return>    "$w.b.default.b invoke"
  1659. X  eval [list proc $w.invoke_default {} [list $w.b.default.b invoke]]
  1660. X}
  1661. X
  1662. Xproc yesNo { title msg yesAction noAction default} {
  1663. X  multChoice $title $msg [list "Yes [list $yesAction]" "No [list $noAction]"] $default
  1664. X}
  1665. X
  1666. Xproc quit { prog {confirm 1}} {
  1667. X  if $confirm {
  1668. X    yesNo "Quit" "Are you sure you want to quit $prog?" "quit $prog 0" "noop" No
  1669. X  } else {
  1670. X    destroy .
  1671. X    exit
  1672. X  }
  1673. X}
  1674. X
  1675. Xproc noop {} {
  1676. X}  
  1677. X
  1678. Xproc toggle {var} {
  1679. X  global $var
  1680. X  if [info exists $var] {
  1681. X    if [set $var] {
  1682. X      set $var 0
  1683. X    } else {
  1684. X      set $var 1
  1685. X    }
  1686. X  } else {
  1687. X    set $var 1
  1688. X  }
  1689. X}
  1690. END_OF_FILE
  1691. if test 3363 -ne `wc -c <'src/misc.tcl'`; then
  1692.     echo shar: \"'src/misc.tcl'\" unpacked with wrong size!
  1693. fi
  1694. # end of 'src/misc.tcl'
  1695. fi
  1696. if test -f 'src/parseArgs.tcl' -a "${1}" != "-c" ; then 
  1697.   echo shar: Will not clobber existing file \"'src/parseArgs.tcl'\"
  1698. else
  1699. echo shar: Extracting \"'src/parseArgs.tcl'\" \(1289 characters\)
  1700. sed "s/^X//" >'src/parseArgs.tcl' <<'END_OF_FILE'
  1701. Xproc parseArgs {argc argv} {
  1702. X  global width height mines
  1703. X  set minesSpecified 0
  1704. X  for {set i 0} {$i < $argc} {incr i} {
  1705. X    set arg [lindex $argv $i]
  1706. X    case $arg {
  1707. X      -help    printHelp
  1708. X      -bugs {
  1709. X         # Turn on debugging
  1710. X         global bugs
  1711. X         set bugs 1
  1712. X      }
  1713. X      -v {
  1714. X        global version
  1715. X        echo "tkmines, version $version. By Joel A. Fine"
  1716. X        exit
  1717. X      }
  1718. X      -width    {
  1719. X        incr i
  1720. X        set width [lindex $argv $i]
  1721. X      }
  1722. X      -height    {
  1723. X        incr i
  1724. X        set height [lindex $argv $i]
  1725. X      }
  1726. X      -mines    {
  1727. X        incr i
  1728. X        set mines [lindex $argv $i]
  1729. X        set minesSpecified 1
  1730. X      }
  1731. X      default    printHelp
  1732. X    }
  1733. X  }
  1734. X  if {$width > [maxwidth] || $width < [minwidth]} {printHelp}
  1735. X  if {$height > [maxheight] || $height < [minheight]} {printHelp}
  1736. X
  1737. X  if {! $minesSpecified} {
  1738. X    set mines [stdmines $width $height]
  1739. X  }
  1740. X  if {$mines > [maxmines $width $height] || $mines < [minmines $width $height]} {printHelp}
  1741. X}
  1742. X
  1743. Xproc printHelp {} {
  1744. X  global width height mines
  1745. X  echo {tkmines -width [width] -height [height] -mines [mines]}
  1746. X  echo width must be less than [maxwidth], height must be less than
  1747. X  echo [maxheight], and mines must be between [minmines $width $height] and [maxmines $width $height]
  1748. X  exit
  1749. X}
  1750. X
  1751. XparseArgs $argc $argv
  1752. END_OF_FILE
  1753. if test 1289 -ne `wc -c <'src/parseArgs.tcl'`; then
  1754.     echo shar: \"'src/parseArgs.tcl'\" unpacked with wrong size!
  1755. fi
  1756. # end of 'src/parseArgs.tcl'
  1757. fi
  1758. if test -f 'src/random.tcl' -a "${1}" != "-c" ; then 
  1759.   echo shar: Will not clobber existing file \"'src/random.tcl'\"
  1760. else
  1761. echo shar: Extracting \"'src/random.tcl'\" \(995 characters\)
  1762. sed "s/^X//" >'src/random.tcl' <<'END_OF_FILE'
  1763. X# Choose $num elements at random from $l
  1764. Xproc choose {num l} {
  1765. X  random seed
  1766. X  set nl {}
  1767. X  for {set i 1} {$i <= $num} {incr i} {
  1768. X    set index [random [llength $l]]
  1769. X    lappend nl [lindex $l $index]
  1770. X    set l [concat [lrange $l 0 [expr {$index - 1}]] [lrange $l [expr {$index + 1}] [llength $l]]]
  1771. X  }
  1772. X  return $nl
  1773. X}
  1774. X
  1775. Xproc chooseOld {num l} {
  1776. X  lrange [randOrder $l] 0 [expr {$num - 1}]
  1777. X}
  1778. X
  1779. X# Put $l (a list) into random order
  1780. Xproc randOrder {l} {
  1781. X  set newlist {}
  1782. X  while {! [lempty $l]} {
  1783. X    set x [extractRandomElement $l]
  1784. X    lappend newlist [lindex $x 0]
  1785. X    set l [lindex $x 1]
  1786. X  }
  1787. X  return $newlist
  1788. X}
  1789. X
  1790. X# Extract a single element from $l at random. Return the element, followed
  1791. X# by the list, extracting the element from the list.
  1792. Xproc extractRandomElement {list} {
  1793. X  random seed
  1794. X  set index [random [llength $list]]
  1795. X  set el [lindex $list $index]
  1796. X  set newlist [concat [lrange $list 0 [expr {$index - 1}]] [lrange $list [expr {$index + 1}] [llength $list]]]
  1797. X  return [list $el $newlist]
  1798. X}
  1799. END_OF_FILE
  1800. if test 995 -ne `wc -c <'src/random.tcl'`; then
  1801.     echo shar: \"'src/random.tcl'\" unpacked with wrong size!
  1802. fi
  1803. # end of 'src/random.tcl'
  1804. fi
  1805. if test -f 'src/start.tcl' -a "${1}" != "-c" ; then 
  1806.   echo shar: Will not clobber existing file \"'src/start.tcl'\"
  1807. else
  1808. echo shar: Extracting \"'src/start.tcl'\" \(117 characters\)
  1809. sed "s/^X//" >'src/start.tcl' <<'END_OF_FILE'
  1810. Xif {$bugs} {
  1811. X  profile -commands on
  1812. X}
  1813. Xwm withdraw .
  1814. Xtoplevel .w
  1815. Xwm title .w Mines
  1816. XmakeBoard .w $width $height $mines
  1817. END_OF_FILE
  1818. if test 117 -ne `wc -c <'src/start.tcl'`; then
  1819.     echo shar: \"'src/start.tcl'\" unpacked with wrong size!
  1820. fi
  1821. # end of 'src/start.tcl'
  1822. fi
  1823. if test -f 'src/util.tcl' -a "${1}" != "-c" ; then 
  1824.   echo shar: Will not clobber existing file \"'src/util.tcl'\"
  1825. else
  1826. echo shar: Extracting \"'src/util.tcl'\" \(1049 characters\)
  1827. sed "s/^X//" >'src/util.tcl' <<'END_OF_FILE'
  1828. X# Convert float to int
  1829. Xproc toint {num} {
  1830. X  return [format "%.0f" $num]
  1831. X}
  1832. X
  1833. Xproc getNeighbors {f row col} {
  1834. X  global $f.width $f.height
  1835. X
  1836. X  set w [set $f.width]
  1837. X  set h [set $f.height]
  1838. X
  1839. X  if {$row >= $h} {return {}}
  1840. X  if {$col >= $w} {return {}}
  1841. X
  1842. X  set nl {}
  1843. X
  1844. X  # Above
  1845. X  if {$row > 0} {
  1846. X    set nr [expr {$row - 1}]
  1847. X    # Left
  1848. X    if {$col > 0} {
  1849. X      lappend nl [list $nr [expr {$col - 1}]]
  1850. X    }
  1851. X    # Middle
  1852. X    lappend nl [list $nr $col]
  1853. X    # Right
  1854. X    if {$col < [expr {$w - 1}]} {
  1855. X      lappend nl [list $nr [expr {$col + 1}]]
  1856. X    }
  1857. X  }
  1858. X
  1859. X  # Below
  1860. X  if {$row < [expr {$h - 1}]} {
  1861. X    set nr [expr {$row + 1}]
  1862. X    # Left
  1863. X    if {$col > 0} {
  1864. X      lappend nl [list $nr [expr {$col - 1}]]
  1865. X    }
  1866. X    # Middle
  1867. X    lappend nl [list $nr $col]
  1868. X    # Right
  1869. X    if {$col < [expr {$w - 1}]} {
  1870. X      lappend nl [list $nr [expr {$col + 1}]]
  1871. X    }
  1872. X  }
  1873. X
  1874. X  # Even
  1875. X  set nr $row
  1876. X  # Left
  1877. X  if {$col > 0} {
  1878. X    lappend nl [list $nr [expr {$col - 1}]]
  1879. X  }
  1880. X  # Right
  1881. X  if {$col < [expr {$w - 1}]} {
  1882. X    lappend nl [list $nr [expr {$col + 1}]]
  1883. X  }
  1884. X  return $nl
  1885. X}
  1886. END_OF_FILE
  1887. if test 1049 -ne `wc -c <'src/util.tcl'`; then
  1888.     echo shar: \"'src/util.tcl'\" unpacked with wrong size!
  1889. fi
  1890. # end of 'src/util.tcl'
  1891. fi
  1892. echo shar: End of archive 1 \(of 1\).
  1893. cp /dev/null ark1isdone
  1894. MISSING=""
  1895. for I in 1 ; do
  1896.     if test ! -f ark${I}isdone ; then
  1897.     MISSING="${MISSING} ${I}"
  1898.     fi
  1899. done
  1900. if test "${MISSING}" = "" ; then
  1901.     echo You have the archive.
  1902.     rm -f ark[1-9]isdone
  1903. else
  1904.     echo You still need to unpack the following archives:
  1905.     echo "        " ${MISSING}
  1906. fi
  1907. ##  End of shell archive.
  1908. exit 0
  1909.