home *** CD-ROM | disk | FTP | other *** search
/ PCNET 2006 September - Disc 1 / PCNET_CD_2006_09.iso / linux / puppy-barebones-2.01r2.iso / pup_201.sfs / usr / local / bin / tkmines < prev    next >
Encoding:
Text File  |  2004-11-21  |  21.6 KB  |  782 lines
  1. #!/bin/sh -
  2. # the next line restarts using wish \
  3. exec wish "$0" "$@"
  4.  
  5. #####
  6. # The minesweeper game. ported to Tcl/Tk.
  7. # P Kern, pkern at utcc.utoronto.ca, 99/02/18
  8.  
  9. set usage "
  10.     -beginner       beginner level (8x8  40 mines).
  11.     -intermediate   medium level (16x16  60 mines).
  12.     -expert         expert level (30x16  99 mines).
  13.     -mammoth        huge board   (56x40 396 mines).
  14.     -x <val>        x dimension of board.
  15.     -y <val>        y dimension of board.
  16.     -mines <val>    number of mines.
  17.     -ratio <val>    ratio of mines to board squares.
  18.     -seed <val>     seed for random numbers."
  19.  
  20. #####
  21. # initial settings.
  22.  
  23. bind . <KeyPress-q> exit
  24.  
  25. # standard parameters.
  26. set modes(beg,ident) Beginner
  27. set modes(beg,XSize)   8
  28. set modes(beg,YSize)   8
  29. set modes(beg,Mines)  10
  30.  
  31. set modes(int,ident) Intermediate
  32. set modes(int,XSize)  16
  33. set modes(int,YSize)  16
  34. set modes(int,Mines)  40
  35.  
  36. set modes(exp,ident) Expert
  37. set modes(exp,XSize)  30
  38. set modes(exp,YSize)  16
  39. set modes(exp,Mines)  99
  40.  
  41. set modes(mam,ident) Mammoth
  42. set modes(mam,XSize)  56
  43. set modes(mam,YSize)  40
  44. set modes(mam,Mines) 396
  45.  
  46. # user-defined board uses intermediate values as default.
  47. set modes(usr,ident) Custom
  48. set modes(usr,XSize)  16
  49. set modes(usr,YSize)  16
  50. set modes(usr,Mines)  40
  51.  
  52. set board(Seed)   -1
  53. set board(ratio)  -1.0
  54. set board(custom)  0
  55.  
  56. proc setmode { mode } {
  57.     global board modes
  58.  
  59.     switch -glob -- $mode {
  60.         -beg*    -
  61.         -int*    -
  62.         -exp*    -
  63.         -mam*    -
  64.         -usr* {
  65.             set m [ string range $mode 1 3 ]
  66.             set board(XSize) $modes($m,XSize)
  67.             set board(YSize) $modes($m,YSize)
  68.             set board(Mines) $modes($m,Mines)
  69.         }
  70.         default { return 0 }
  71.     }
  72.     return 1
  73. }
  74.  
  75. # "intermediate" is default.
  76. setmode "-int"
  77.  
  78. # parse command-line arguments.
  79. set ac 0
  80. foreach arg $argv {
  81.     incr ac
  82.     if {[ setmode $arg ] != 0} { continue }
  83.     set field ""
  84.     switch -glob -- $arg {
  85.         -x    { set field XSize }
  86.         -y    { set field YSize }
  87.         -mines    { set field Mines }
  88.         -ratio    { set board(ratio) [ lindex $argv $ac] }
  89.         -seed    { set board(Seed) [ lindex $argv $ac] }
  90.         -*    { puts stderr "$argv0 options: $usage"; exit 0 }
  91.     }
  92.     if {$field != ""} {
  93.         set board($field) [ lindex $argv $ac ]
  94.         set board(custom) 1
  95.         
  96.     }
  97. }
  98. if {$board(custom) > 0} {
  99.     # save custom choices.
  100.     foreach field { XSize YSize Mines } {
  101.         set modes(usr,$field) $board($field)
  102.     }
  103. }
  104.  
  105. #####
  106. # define bitmaps.
  107.  
  108. #
  109. # smiley-face bitmaps: smiley, shades, croak.
  110. #
  111.  
  112. image create bitmap smiley -background yellow -data "
  113. #define smiley_width 26
  114. #define smiley_height 26
  115. static unsigned char smiley_bits[] = {
  116.    0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xfc, 0x01, 0x00,
  117.    0x00, 0x03, 0x06, 0x00, 0xc0, 0x00, 0x18, 0x00, 0x20, 0x00, 0x20, 0x00,
  118.    0x10, 0x00, 0x40, 0x00, 0x10, 0x00, 0x40, 0x00, 0x08, 0x00, 0x80, 0x00,
  119.    0x08, 0x06, 0x83, 0x00, 0x04, 0x06, 0x03, 0x01, 0x04, 0x00, 0x00, 0x01,
  120.    0x04, 0x00, 0x00, 0x01, 0x04, 0x00, 0x00, 0x01, 0x04, 0x00, 0x00, 0x01,
  121.    0x44, 0x00, 0x10, 0x01, 0x84, 0x00, 0x08, 0x01, 0x08, 0x03, 0x86, 0x00,
  122.    0x08, 0xfc, 0x81, 0x00, 0x10, 0x00, 0x40, 0x00, 0x10, 0x00, 0x40, 0x00,
  123.    0x20, 0x00, 0x20, 0x00, 0xc0, 0x00, 0x18, 0x00, 0x00, 0x03, 0x06, 0x00,
  124.    0x00, 0xfc, 0x01, 0x00, 0x00, 0x00, 0x00, 0x00};
  125. " -maskdata "
  126. #define smiley_width 26
  127. #define smiley_height 26
  128. static unsigned char smiley_bits[] = {
  129.    0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xfc, 0x01, 0x00,
  130.    0x00, 0xff, 0x07, 0x00, 0xc0, 0xff, 0x1f, 0x00, 0xe0, 0xff, 0x3f, 0x00,
  131.    0xf0, 0xff, 0x7f, 0x00, 0xf0, 0xff, 0x7f, 0x00, 0xf8, 0xff, 0xff, 0x00,
  132.    0xf8, 0xff, 0xff, 0x00, 0xfc, 0xff, 0xff, 0x01, 0xfc, 0xff, 0xff, 0x01,
  133.    0xfc, 0xff, 0xff, 0x01, 0xfc, 0xff, 0xff, 0x01, 0xfc, 0xff, 0xff, 0x01,
  134.    0xfc, 0xff, 0xff, 0x01, 0xfc, 0xff, 0xff, 0x01, 0xf8, 0xff, 0xff, 0x00,
  135.    0xf8, 0xff, 0xff, 0x00, 0xf0, 0xff, 0x7f, 0x00, 0xf0, 0xff, 0x7f, 0x00,
  136.    0xe0, 0xff, 0x3f, 0x00, 0xc0, 0xff, 0x1f, 0x00, 0x00, 0xff, 0x07, 0x00,
  137.    0x00, 0xfc, 0x01, 0x00, 0x00, 0x00, 0x00, 0x00};
  138. "
  139.  
  140. image create bitmap shades -background yellow -data "
  141. #define shades_width 26
  142. #define shades_height 26
  143. static unsigned char shades_bits[] = {
  144.    0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xfc, 0x01, 0x00,
  145.    0x00, 0x03, 0x06, 0x00, 0xc0, 0x00, 0x18, 0x00, 0x20, 0x00, 0x20, 0x00,
  146.    0x10, 0x00, 0x40, 0x00, 0x10, 0x00, 0x40, 0x00, 0x08, 0x00, 0x80, 0x00,
  147.    0xc8, 0xff, 0x9f, 0x00, 0xe4, 0xdf, 0x3f, 0x01, 0x94, 0x8f, 0x4f, 0x01,
  148.    0x0c, 0x07, 0x87, 0x01, 0x04, 0x00, 0x00, 0x01, 0x04, 0x00, 0x00, 0x01,
  149.    0x44, 0x00, 0x10, 0x01, 0x84, 0x00, 0x08, 0x01, 0x08, 0x03, 0x86, 0x00,
  150.    0x08, 0xfc, 0x81, 0x00, 0x10, 0x00, 0x40, 0x00, 0x10, 0x00, 0x40, 0x00,
  151.    0x20, 0x00, 0x20, 0x00, 0xc0, 0x00, 0x18, 0x00, 0x00, 0x03, 0x06, 0x00,
  152.    0x00, 0xfc, 0x01, 0x00, 0x00, 0x00, 0x00, 0x00};
  153. " -maskdata "
  154. #define smiley_width 26
  155. #define smiley_height 26
  156. static unsigned char smiley_bits[] = {
  157.    0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xfc, 0x01, 0x00,
  158.    0x00, 0xff, 0x07, 0x00, 0xc0, 0xff, 0x1f, 0x00, 0xe0, 0xff, 0x3f, 0x00,
  159.    0xf0, 0xff, 0x7f, 0x00, 0xf0, 0xff, 0x7f, 0x00, 0xf8, 0xff, 0xff, 0x00,
  160.    0xf8, 0xff, 0xff, 0x00, 0xfc, 0xff, 0xff, 0x01, 0xfc, 0xff, 0xff, 0x01,
  161.    0xfc, 0xff, 0xff, 0x01, 0xfc, 0xff, 0xff, 0x01, 0xfc, 0xff, 0xff, 0x01,
  162.    0xfc, 0xff, 0xff, 0x01, 0xfc, 0xff, 0xff, 0x01, 0xf8, 0xff, 0xff, 0x00,
  163.    0xf8, 0xff, 0xff, 0x00, 0xf0, 0xff, 0x7f, 0x00, 0xf0, 0xff, 0x7f, 0x00,
  164.    0xe0, 0xff, 0x3f, 0x00, 0xc0, 0xff, 0x1f, 0x00, 0x00, 0xff, 0x07, 0x00,
  165.    0x00, 0xfc, 0x01, 0x00, 0x00, 0x00, 0x00, 0x00};
  166. "
  167.  
  168. image create bitmap croak -background yellow -data "
  169. #define croak_width 26
  170. #define croak_height 26
  171. static unsigned char croak_bits[] = {
  172.    0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xfc, 0x01, 0x00,
  173.    0x00, 0x03, 0x06, 0x00, 0xc0, 0x00, 0x18, 0x00, 0x20, 0x00, 0x20, 0x00,
  174.    0x10, 0x00, 0x40, 0x00, 0x90, 0x88, 0x48, 0x00, 0x08, 0x05, 0x85, 0x00,
  175.    0x08, 0x02, 0x82, 0x00, 0x04, 0x05, 0x05, 0x01, 0x84, 0x88, 0x08, 0x01,
  176.    0x04, 0x00, 0x00, 0x01, 0x04, 0x00, 0x00, 0x01, 0x04, 0x00, 0x00, 0x01,
  177.    0x04, 0xfc, 0x01, 0x01, 0x04, 0xa3, 0x06, 0x01, 0x88, 0xa0, 0x8a, 0x00,
  178.    0x48, 0xa0, 0x92, 0x00, 0x10, 0x20, 0x42, 0x00, 0x10, 0xc0, 0x41, 0x00,
  179.    0x20, 0x00, 0x20, 0x00, 0xc0, 0x00, 0x18, 0x00, 0x00, 0x03, 0x06, 0x00,
  180.    0x00, 0xfc, 0x01, 0x00, 0x00, 0x00, 0x00, 0x00};
  181. " -maskdata "
  182. #define smiley_width 26
  183. #define smiley_height 26
  184. static unsigned char smiley_bits[] = {
  185.    0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xfc, 0x01, 0x00,
  186.    0x00, 0xff, 0x07, 0x00, 0xc0, 0xff, 0x1f, 0x00, 0xe0, 0xff, 0x3f, 0x00,
  187.    0xf0, 0xff, 0x7f, 0x00, 0xf0, 0xff, 0x7f, 0x00, 0xf8, 0xff, 0xff, 0x00,
  188.    0xf8, 0xff, 0xff, 0x00, 0xfc, 0xff, 0xff, 0x01, 0xfc, 0xff, 0xff, 0x01,
  189.    0xfc, 0xff, 0xff, 0x01, 0xfc, 0xff, 0xff, 0x01, 0xfc, 0xff, 0xff, 0x01,
  190.    0xfc, 0xff, 0xff, 0x01, 0xfc, 0xff, 0xff, 0x01, 0xf8, 0xff, 0xff, 0x00,
  191.    0xf8, 0xff, 0xff, 0x00, 0xf0, 0xff, 0x7f, 0x00, 0xf0, 0xff, 0x7f, 0x00,
  192.    0xe0, 0xff, 0x3f, 0x00, 0xc0, 0xff, 0x1f, 0x00, 0x00, 0xff, 0x07, 0x00,
  193.    0x00, 0xfc, 0x01, 0x00, 0x00, 0x00, 0x00, 0x00};
  194. "
  195.  
  196. #
  197. # flag bitmap.
  198. #
  199. image create bitmap flag -background red -data "
  200. #define flag_width 12
  201. #define flag_height 12
  202. static unsigned char flag_bits[] = {
  203.    0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
  204.    0x00, 0x00, 0x00, 0x00, 0xe0, 0x01, 0xe0, 0x01, 0xf8, 0x03, 0xf8, 0x03};
  205. " -maskdata "
  206. #define flag_width 12
  207. #define flag_height 12
  208. static unsigned char flag_bits[] = {
  209.    0x80, 0x00, 0xc0, 0x00, 0xf0, 0x00, 0xf8, 0x00, 0xf0, 0x00, 0xc0, 0x00,
  210.    0x80, 0x00, 0x80, 0x00, 0xe0, 0x01, 0xe0, 0x01, 0xf8, 0x03, 0xf8, 0x03};
  211. "
  212.  
  213. #
  214. # blank bitmap.
  215. #
  216. set blankxbm "
  217. #define blank_width 12
  218. #define blank_height 12
  219. static unsigned char blank_bits[] = {
  220.    0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
  221.    0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00};
  222. "
  223. image create bitmap blank -data $blankxbm
  224.  
  225. #
  226. # question mark bitmap.
  227. #
  228. image create bitmap qmark -foreground blue -data "
  229. #define huh_width 12
  230. #define huh_height 12
  231. static unsigned char huh_bits[] = {
  232.    0xf0, 0x00, 0xf8, 0x01, 0x0c, 0x03, 0x0c, 0x03, 0x80, 0x01, 0xc0, 0x00,
  233.    0x60, 0x00, 0x60, 0x00, 0x60, 0x00, 0x00, 0x00, 0x60, 0x00, 0x60, 0x00};
  234. "
  235.  
  236. #
  237. # mine bitmaps: mine, wrong.
  238. #
  239. image create bitmap mine -data "
  240. #define mine_width 12
  241. #define mine_height 12
  242. static unsigned char mine_bits[] = {
  243.    0x00, 0x00, 0x42, 0x08, 0xf4, 0x05, 0xf8, 0x03, 0xec, 0x07, 0xec, 0x07,
  244.    0xfe, 0x0f, 0xfc, 0x07, 0xfc, 0x07, 0xf8, 0x03, 0xf4, 0x05, 0x42, 0x08};
  245. "
  246.  
  247. image create bitmap wrong -background red -data "
  248. #define wrong_width 12
  249. #define wrong_height 12
  250. static unsigned char wrong_bits[] = {
  251.    0x00, 0x00, 0x40, 0x00, 0xf0, 0x01, 0xf0, 0x00, 0x64, 0x06, 0x0c, 0x07,
  252.    0x9e, 0x0f, 0x0c, 0x07, 0x64, 0x06, 0xf0, 0x00, 0xf0, 0x01, 0x40, 0x00};
  253. " -maskdata "
  254. #define wrong_width 12
  255. #define wrong_height 12
  256. static unsigned char wrong_bits[] = {
  257.    0x00, 0x00, 0x42, 0x0c, 0xf6, 0x07, 0xfc, 0x03, 0xec, 0x07, 0xfc, 0x07,
  258.    0xfe, 0x0f, 0xfc, 0x07, 0xfc, 0x07, 0xfc, 0x03, 0xf6, 0x07, 0x42, 0x0c};
  259. "
  260.  
  261. #
  262. # digit bitmaps: 0 thru 9.
  263. #
  264.  
  265. set numb(0) "
  266. #define 0_width 12
  267. #define 0_height 12
  268. static unsigned char 0_bits[] = {
  269.    0xf0, 0x01, 0xf8, 0x03, 0x18, 0x03, 0x18, 0x03, 0x18, 0x03, 0x18, 0x03,
  270.    0x18, 0x03, 0x18, 0x03, 0x18, 0x03, 0x18, 0x03, 0xf8, 0x03, 0xf0, 0x01};
  271. "
  272.  
  273. set numb(1) "
  274. #define 1_width 12
  275. #define 1_height 12
  276. static unsigned char 1_bits[] = {
  277.    0xe0, 0x00, 0xe0, 0x00, 0xc0, 0x00, 0xc0, 0x00, 0xc0, 0x00, 0xc0, 0x00,
  278.    0xc0, 0x00, 0xc0, 0x00, 0xc0, 0x00, 0xc0, 0x00, 0xf0, 0x03, 0xf0, 0x03};
  279. "
  280.  
  281. set numb(2) "
  282. #define 2_width 12
  283. #define 2_height 12
  284. static unsigned char 2_bits[] = {
  285.    0xf8, 0x03, 0xf8, 0x03, 0x18, 0x03, 0x18, 0x03, 0x00, 0x03, 0x80, 0x03,
  286.    0xc0, 0x01, 0xe0, 0x00, 0x70, 0x00, 0x38, 0x00, 0xf8, 0x03, 0xf8, 0x03};
  287. "
  288.  
  289. set numb(3) "
  290. #define 3_width 12
  291. #define 3_height 12
  292. static unsigned char 3_bits[] = {
  293.    0xf8, 0x03, 0xf8, 0x03, 0x00, 0x03, 0x00, 0x03, 0x00, 0x03, 0xf0, 0x03,
  294.    0xf0, 0x03, 0x00, 0x03, 0x00, 0x03, 0x00, 0x03, 0xf8, 0x03, 0xf8, 0x03};
  295. "
  296.  
  297. set numb(4) "
  298. #define 4_width 12
  299. #define 4_height 12
  300. static unsigned char 4_bits[] = {
  301.    0x18, 0x00, 0x18, 0x00, 0x98, 0x01, 0x98, 0x01, 0x98, 0x01, 0x98, 0x01,
  302.    0xf8, 0x03, 0xf8, 0x03, 0x80, 0x01, 0x80, 0x01, 0x80, 0x01, 0x80, 0x01};
  303. "
  304.  
  305. set numb(5) "
  306. #define 5_width 12
  307. #define 5_height 12
  308. static unsigned char 5_bits[] = {
  309.    0xf8, 0x03, 0xf8, 0x03, 0x18, 0x00, 0x18, 0x00, 0x18, 0x00, 0xf8, 0x01,
  310.    0xf0, 0x03, 0x00, 0x03, 0x00, 0x03, 0x00, 0x03, 0xf8, 0x03, 0xf8, 0x01};
  311. "
  312.  
  313. set numb(6) "
  314. #define 6_width 12
  315. #define 6_height 12
  316. static unsigned char 6_bits[] = {
  317.    0xf8, 0x03, 0xf8, 0x03, 0x18, 0x00, 0x18, 0x00, 0x18, 0x00, 0xf8, 0x03,
  318.    0xf8, 0x03, 0x18, 0x03, 0x18, 0x03, 0x18, 0x03, 0xf8, 0x03, 0xf8, 0x03};
  319. "
  320.  
  321. set numb(7) "
  322. #define 7_width 12
  323. #define 7_height 12
  324. static unsigned char 7_bits[] = {
  325.    0xf8, 0x03, 0xf8, 0x03, 0x00, 0x03, 0x00, 0x03, 0x00, 0x03, 0x80, 0x03,
  326.    0xc0, 0x01, 0xc0, 0x00, 0xc0, 0x00, 0xc0, 0x00, 0xc0, 0x00, 0xc0, 0x00};
  327. "
  328.  
  329. set numb(8) "
  330. #define 8_width 12
  331. #define 8_height 12
  332. static unsigned char 8_bits[] = {
  333.    0xf8, 0x03, 0xf8, 0x03, 0x18, 0x03, 0x18, 0x03, 0x18, 0x03, 0xf8, 0x03,
  334.    0xf8, 0x03, 0x18, 0x03, 0x18, 0x03, 0x18, 0x03, 0xf8, 0x03, 0xf8, 0x03};
  335. "
  336.  
  337. set numb(9) "
  338. #define 9_width 12
  339. #define 9_height 12
  340. static unsigned char 9_bits[] = {
  341.    0xf8, 0x03, 0xf8, 0x03, 0x18, 0x03, 0x18, 0x03, 0x18, 0x03, 0xf8, 0x03,
  342.    0xf8, 0x03, 0x00, 0x03, 0x00, 0x03, 0x00, 0x03, 0xf8, 0x03, 0xf8, 0x03};
  343. "
  344.  
  345. #
  346. # "register" the bitmaps.
  347. #
  348. image create bitmap 0 -data $blankxbm
  349. #image create bitmap 0 -data $numb(0) -foreground #646464
  350. image create bitmap 1 -data $numb(1) -foreground #0000ff
  351. image create bitmap 2 -data $numb(2) -foreground #00c850
  352. image create bitmap 3 -data $numb(3) -foreground #ff0000
  353. image create bitmap 4 -data $numb(4) -foreground #0000af
  354. image create bitmap 5 -data $numb(5) -foreground #ff00ff
  355. image create bitmap 6 -data $numb(6) -foreground #00c8c8
  356. image create bitmap 7 -data $numb(7) -foreground #b400b4
  357. image create bitmap 8 -data $numb(8) -foreground #000000
  358.  
  359.  
  360. # show all mines.
  361. proc reveal {} {
  362.     global board Map
  363.  
  364.     foreach coord $Map(Coords) {
  365.         set j [ lindex $coord 0 ]
  366.         set i [ lindex $coord 1 ]
  367.         .game.field.y$j.x$i configure -relief flat -image $board(type,$j,$i)
  368.         set f [ lsearch $Map(Flags) $coord ]
  369.         if { $f > -1 } {
  370.             set Map(Flags) [ lreplace $Map(Flags) $f $f ]
  371.         }
  372.     }
  373.  
  374.     # show mistakes.
  375.     foreach coord $Map(Flags) {
  376.         set j [ lindex $coord 0 ]
  377.         set i [ lindex $coord 1 ]
  378.         .game.field.y$j.x$i configure -relief flat -image wrong
  379.     }
  380. }
  381.  
  382. # finished. show results.
  383. proc done { type } {
  384.     after cancel timer
  385.     .game.status.butn configure -image $type
  386.     reveal
  387. }
  388.  
  389. # step on a square.
  390. proc step { x y } {
  391.     global board
  392.  
  393.     # disable buttonclicks.
  394.     bind .game.field.y$y.x$x <Button> ""
  395.  
  396.     set type $board(type,$y,$x)
  397.     if { $type == "seen" } { return $type }
  398.     if { $type == "mine" } {
  399.         # stepped on a mine! game over.
  400.         .game.field.y$y.x$x configure -background red
  401.         .game.field.y$y.x$x configure -activebackground red
  402.  
  403.         done croak
  404.  
  405.         return $type
  406.     }
  407.     .game.field.y$y.x$x configure -relief flat -image $board(type,$y,$x)
  408.     set board(type,$y,$x) seen
  409.     return $type
  410. }
  411.  
  412. # update the status displays.
  413. proc updatestatus {} {
  414.     global player status
  415.  
  416.     set status(count) [ format "%3d" $player(count) ]
  417.     set status(scnds) [ format "%3d" $player(elapsed) ]
  418. }
  419.  
  420. # game clock.
  421. set timing 0
  422. proc timer {} {
  423.     global player
  424.     
  425.     incr player(elapsed)
  426.     after 1000 timer
  427.     updatestatus
  428. }
  429.  
  430. # examine a square.
  431. proc look { x y } {
  432.     global board timing
  433.  
  434.     if { $timing == 0 } {
  435.         # start the game clock.
  436.         incr timing
  437.         after 1000 timer
  438.     }
  439.  
  440.     # "step" on it to see what's there.
  441.     set type [ step $x $y ]
  442.     if { $type == "mine" } { return }
  443.     if { $type == "seen" } { return }
  444.     if { $type > 0 } { return }
  445.  
  446.     # no mine(s) near by. check out neighbouring squares.
  447.     set ylist [list [expr $y - 1] $y [expr $y + 1]] 
  448.     set xlist [list [expr $x - 1] $x [expr $x + 1]] 
  449.  
  450.     foreach j $ylist {
  451.         if { $j < 0 || $j >= $board(YSize) } { continue }
  452.         foreach i $xlist {
  453.             if { $i < 0 || $i >= $board(XSize) } { continue }
  454.             if { $j != $y || $i != $x } { look $i $j }
  455.         }
  456.     }
  457. }
  458.  
  459. # mark a square.
  460. proc mark { x y } {
  461.     global player Map board
  462.  
  463.     set coord [ list $y $x ]
  464.  
  465.     # cycle: blank -> flag -> qmark -> blank
  466.     set bm [ .game.field.y$y.x$x cget -image ]
  467.     switch -- $bm {
  468.         blank    {
  469.             set bm flag
  470.             incr player(count) -1
  471.             lappend Map(Flags) $coord
  472.             if { $board(type,$y,$x) == "mine" } {
  473.                 incr board(Mines,left) -1
  474.             }
  475.         }
  476.         flag    {
  477.             set bm qmark
  478.             incr player(count)
  479.             set f [ lsearch $Map(Flags) $coord ]
  480.             if { $f > -1 } {
  481.                 set Map(Flags) [ lreplace $Map(Flags) $f $f ]
  482.             }
  483.             if { $board(type,$y,$x) == "mine" } {
  484.                 incr board(Mines,left)
  485.             }
  486.         }
  487.         qmark    { set bm blank }
  488.     }
  489.     .game.field.y$y.x$x configure -image $bm
  490.  
  491.     updatestatus
  492.     if { $board(Mines,left) <= 0 } { done shades }
  493. }
  494.  
  495. #####
  496. #
  497. # random generator. lifted from netbsd's rand().
  498. #
  499. set next 1 ; set randmax 0x7fffffff
  500. proc rand {} {
  501.     global next randmax
  502.  
  503.     set next [ expr $next * 1103515245 ]
  504.     incr next 12345
  505.     return [ expr $next % $randmax ]
  506. }
  507.  
  508. proc srand { seed } {
  509.     global next
  510.     set next $seed
  511. }
  512. #####
  513.  
  514. proc getrandom { range } {
  515.  
  516.     set val [ expr [ rand ] / 2147483647.0 ]
  517.     set val [ expr $val * double($range) + 0.5 ]
  518.     set x [ expr int($val) ]
  519.  
  520.     if { $x == $range } { set x 0 }
  521.     return $x
  522. }
  523.  
  524. # build the minefield. initialize settings.
  525. proc initboard {} {
  526.     global board Map timing player
  527.  
  528.     for { set y -1 } { $y <= $board(YSize) } { incr y } {
  529.         for { set x -1 } { $x <= $board(XSize) } { incr x } {
  530.             set board(type,$y,$x) 0
  531.         }
  532.     }
  533.  
  534.     if {$board(Seed) < 0} {
  535.         srand [ clock clicks ]
  536.     } else {
  537.         srand $board(Seed)
  538.     }
  539.     if {$board(ratio) > 0.0} {
  540.         set v [ expr $board(ratio) * $board(XSize) * $board(YSize) + 0.5 ]
  541.         set board(Mines) [ expr int($v) ]
  542.     }
  543.  
  544.     set mines $board(Mines)
  545.     set limit [ expr 50 * $mines ]
  546.     set count 0
  547.  
  548.     set Map(Coords) {}
  549.     set Map(Flags) {}
  550.     while { $mines > 0 } {
  551.         set x [ getrandom $board(XSize) ]
  552.         set y [ getrandom $board(YSize) ]
  553.  
  554.         if { $board(type,$y,$x) != "mine" } {
  555.             set board(type,$y,$x) mine
  556.             incr mines -1
  557.             lappend Map(Coords) [ list $y $x ]
  558.  
  559.             set ylist [list [expr $y - 1] $y [expr $y + 1]]
  560.             set xlist [list [expr $x - 1] $x [expr $x + 1]]
  561.  
  562.             # increment neighbour's counts.
  563.             foreach j $ylist {
  564.                 foreach i $xlist {
  565.                     if { $board(type,$j,$i) != "mine" } {
  566.                         incr board(type,$j,$i)
  567.                     }
  568.                 }
  569.             }
  570.         }
  571.         incr count
  572.         if { $count > $limit } {
  573.             puts "Unable to initialize board"
  574.             exit 0
  575.         }
  576.     }
  577.  
  578.     set player(count) $board(Mines)
  579.     set board(Mines,left) $board(Mines)
  580.  
  581.     set win .game.field
  582.     catch { destroy $win }
  583.     frame $win -relief ridge -bd 8
  584.     for { set y 0 } { $y < $board(YSize) } { incr y } {
  585.         frame $win.y$y
  586.         for { set x 0 } { $x < $board(XSize) } { incr x } {
  587.             button $win.y$y.x$x -bd 3 -highlightthickness 0 -image blank
  588.             set bgnd [ $win.y$y.x$x cget -background ]
  589.             $win.y$y.x$x configure -activebackground $bgnd
  590.             bind $win.y$y.x$x <Button-1> "look $x $y"
  591.             bind $win.y$y.x$x <Button-3> "mark $x $y"
  592.             pack $win.y$y.x$x -side left
  593.         }
  594.         pack $win.y$y
  595.     }
  596.     pack $win -side bottom
  597.  
  598.     after cancel timer
  599.     set player(elapsed) 0
  600.     set timing 0
  601.     updatestatus
  602.  
  603.     .game.status.butn configure -image smiley
  604.     bind .game.status.butn <Button> initboard
  605. }
  606.  
  607. # choose another mode and restart (invoked by the "Mode" menu).
  608. proc newmode { type } {
  609.     setmode "-$type"
  610.     initboard
  611. }
  612.  
  613. # display help information (invoked by the "Help" menu).
  614. proc help {} {
  615.     global usage
  616.  
  617.     set msgtxt "
  618. Minesweeper
  619. ===========
  620.  
  621.  
  622. Operation
  623. ---------
  624. Click on mouseButton1 to ``step'' on a square.
  625.   If there's a number showing, then that's the number of mines
  626.   bordering on that square.  If you ``step'' on a square where
  627.   there's a mine, then the mine explodes and you've lost the game.
  628.  
  629. Click on mouseButton3 to mark a square with a flag.  Click again
  630. with mouseButton3 to change the mark from a flag to question mark.
  631. Clicking a third time with mouseButton3 will change the square
  632. back to being unmarked.
  633.  
  634. You win the game by marking all the unexploded mines with flags.
  635.  
  636. Click on the smiley face to start a fresh game.
  637.  
  638. Press ``q'' to quit the game.
  639.  
  640.  
  641. Command-line options
  642. -------------------- $usage
  643. "
  644.  
  645.     append msglen [ string length $msgtxt ] "c"
  646.  
  647.     set win ".help"
  648.     toplevel $win -relief raised -height 40m
  649.     bind $win <KeyPress-q> "destroy $win"
  650.     bind $win <KeyPress-space> "destroy $win"
  651.     bind $win <KeyPress-Escape> "destroy $win"
  652.     message $win.msg -pady 4m -text "$msgtxt" -width $msglen \
  653.         -foreground blue -background yellow
  654.     pack $win.msg -expand 1 -fill both
  655. }
  656.  
  657. # a little blurb (invoked by the "Help" menu).
  658. proc myreadme {} {
  659.     set msgtxt "
  660.  
  661. This is a Tcl/Tk port of Greg Lesher's XMine.
  662.  
  663. It was done as an exercise to try to become more familiar with Tk.
  664. Not all of XMine's original features have been included but the
  665. important ones should be there.  It seems to work Ok although
  666. it can take some time to generate the mammoth board  (And no wonder.
  667. 56x40 = 2240 buttons!!!  There's probably a more efficient way to port
  668. this game but button widgets just seemed to be an obvious choice).
  669.  
  670. All feedback is welcome.
  671.  
  672. P. Kern,  pkern at utcc.utoronto.ca  99/02/18
  673. "
  674.  
  675.     append msglen [ string length $msgtxt ] "c"
  676.  
  677.     set win ".readme"
  678.     toplevel $win -relief raised -height 40m
  679.     bind $win <KeyPress-q> "destroy $win"
  680.     bind $win <KeyPress-space> "destroy $win"
  681.     bind $win <KeyPress-Escape> "destroy $win"
  682.     message $win.msg -pady 4m -text "$msgtxt" -width $msglen \
  683.         -foreground blue
  684.     pack $win.msg -expand 1 -fill both
  685. }
  686.  
  687. # display XMine's README contents (invoked by the "Help" menu).
  688. proc original {} {
  689.     set msgtxt "
  690.  
  691. { The original XMine's README file: }
  692.  
  693.     AUTHOR:
  694.         Greg Lesher 1/93
  695.         lesher@cns.bu.edu
  696.  
  697.     DESCRIPTION:
  698.         Color/BW version of Microsoft minesweeper
  699.  
  700.     COMMENTS:
  701.         About the same graphics-wise as the comp.sources.x game ``demineur''
  702.         but supports BW, has more run-time options, and what little
  703.         documentation there is, is not in French.
  704.  
  705.     BUGS:
  706.         Smiley covers digits at beginner level
  707.         Sunglassed smiley appears if you blow up on the last bomb
  708.         
  709.     DISCLAIMER:
  710.         I never heard of the program
  711.         I never heard of you
  712.  
  713. { Yeah. A wise guy. }
  714. "
  715.  
  716.     append msglen [ string length $msgtxt ] "c"
  717.  
  718.     set win ".original"
  719.     toplevel $win -relief raised -height 40m
  720.     bind $win <KeyPress-q> "destroy $win"
  721.     bind $win <KeyPress-space> "destroy $win"
  722.     bind $win <KeyPress-Escape> "destroy $win"
  723.     message $win.msg -pady 4m -text "$msgtxt" -width $msglen \
  724.         -foreground blue
  725.     pack $win.msg -expand 1 -fill both
  726. }
  727.  
  728. #####
  729. # set up the menus.
  730.  
  731. frame .game
  732.  
  733. set win .game.menubar
  734. frame $win -relief ridge -bd 8
  735. menubutton $win.file -text File -menu $win.file.menu -relief raised -bd 3
  736. menubutton $win.mode -text Mode -menu $win.mode.menu -relief raised -bd 3
  737. menubutton $win.help -text Help -menu $win.help.menu -relief raised -bd 3
  738. menu $win.file.menu
  739. $win.file.menu add separator
  740. $win.file.menu add command -label Quit -command exit
  741. menu $win.mode.menu
  742. set mlist { beg int exp mam }
  743. if {$board(custom) > 0} { lappend mlist usr }
  744. foreach mn $mlist {
  745.     $win.mode.menu add command -command "newmode $mn" -label \
  746.         $modes($mn,ident)
  747. #        [ format "%s %dx%d, %d mines" $modes($mn,ident) \
  748. #        $modes($mn,XSize) $modes($mn,YSize) $modes($mn,Mines) ]
  749. }
  750. menu $win.help.menu
  751. $win.help.menu add command -command help -label "Help"
  752. $win.help.menu add command -command original -label "about the original XMine"
  753. $win.help.menu add command -command myreadme -label "about this version"
  754.  
  755. pack $win.file $win.mode -side left
  756. pack $win.help -side right
  757. pack $win -side top -fill both
  758.  
  759. #####
  760. # set up the status display.
  761.  
  762. set win .game.status
  763. frame $win -relief ridge -bd 8
  764. button $win.butn -bd 3 -image smiley
  765. label $win.minesleft -textvariable status(count) \
  766.     -relief sunken -foreground red -background black -font 12x24
  767. label $win.seconds -textvariable status(scnds) \
  768.     -relief sunken -foreground red -background black -font 12x24
  769. pack $win.minesleft -side left
  770. pack $win.seconds -side right
  771. pack $win.butn -before $win.minesleft
  772. pack $win -side top -fill both
  773.  
  774. #####
  775. # get started.
  776.  
  777. initboard
  778.  
  779. pack .game
  780.  
  781. # end of script.
  782.