Quick Minesweeper

[bplus]

A quick game of Minesweeper:

Code: QB64: [Select]

1. OPTION _EXPLICIT 'Bplus 2019-08-01
2. DEFINT A-Z '      9 squares 60 x 60 pixels = 540 x 540 screen
3. CONST xmax = 540, ymax = 540, sq = 60, arrD = 9, mines = 13
4. _TITLE STR$(mines) + " Mine-sweeper: left click cell to reveal, right click to mark mine (red)"
5. SCREEN _NEWIMAGE(xmax, ymax, 32)
6. _SCREENMOVE 300, 10
7. RANDOMIZE TIMER
8. TYPE boardType
9.     id AS INTEGER '0 to 8 neighbor mines
10.     reveal AS INTEGER ' 1 for marked, 0 hidden, -1 for revealed
11.     mine AS INTEGER '0 or -1
12. END TYPE
13. REDIM SHARED b(0 TO arrD + 1, 0 TO arrD + 1) AS boardType 'oversize the board to make it easy to count mines
14. DIM SHARED restart
15. DIM gameOver, cc, cr, mbN, c, r
16. restart = 1
17. WHILE 1
18.     gameOver = 0
19.     WHILE gameOver = 0
20.         IF restart THEN initialize
21.         mbN = 0
22.         getCell cc, cr, mbN
23.         'LOCATE 1, 1: PRINT cc, cr, mbN
24.         IF mbN = 1 AND b(cc, cr).reveal = 0 THEN
25.             IF b(cc, cr).mine THEN 'ka boom
26.                 FOR r = 1 TO arrD 'show all mines
27.                     FOR c = 1 TO arrD
28.                         IF b(c, r).mine THEN b(c, r).reveal = -1: showCell c, r
29.                     NEXT
30.                 NEXT
31.                 cText xmax / 2, ymax / 2, 72, &HFF000000, "KA - BOOOMMMM!"
32.                 cText xmax / 2 - 4, ymax / 2 - 4, 64, &HFFFF0000, "KA - BOOOMMMM!"
33.                 cText xmax / 2 - 8, ymax / 2 - 8, 56, &HFFFFFF00, "KA - BOOOMMMM!"
34.                 gameOver = -1
35.                 _DELAY 7
36.             ELSE
37.                 b(cc, cr).reveal = -1: showCell cc, cr
38.                 IF b(cc, cr).id = 0 THEN sweepZeros cc, cr
39.             END IF
40.         ELSEIF mbN = 2 THEN
41.             IF b(cc, cr).reveal = 1 THEN
42.                 b(cc, cr).reveal = 0: showCell cc, cr
43.             ELSE
44.                 IF b(cc, cr).reveal = 0 THEN b(cc, cr).reveal = 1: showCell cc, cr
45.             END IF
46.         END IF
47.         IF TFwin THEN
48.             cText xmax / 2, ymax / 2, 30, &HFF001144, "You found all the free cells!"
49.             cText xmax / 2 - 1, ymax / 2 - 2, 30, &HFF3399BB, "You found all the free cells!"
50.             _DELAY 5
51.             gameOver = -1
52.         END IF
53.         _LIMIT 60
54.     WEND
55.     restart = 1
56. WEND
57.  
58. SUB initialize ()
59.     DIM minesPlaced, rx, ry, x, y, nMines
60.     restart = 0
61.     REDIM b(0 TO arrD + 1, 0 TO arrD + 1) AS boardType
62.     minesPlaced = 0
63.     WHILE minesPlaced < mines
64.         rx = INT(RND * arrD) + 1: ry = INT(RND * arrD) + 1
65.         IF b(rx, ry).mine = 0 THEN
66.             b(rx, ry).mine = -1: minesPlaced = minesPlaced + 1
67.         END IF
68.     WEND
69.     'count mines amoung the neighbors
70.     FOR y = 1 TO arrD
71.         FOR x = 1 TO arrD
72.             IF b(x, y).mine <> -1 THEN 'not already a mine
73.                 nMines = b(x - 1, y - 1).mine + b(x - 1, y).mine + b(x - 1, y + 1).mine
74.                 nMines = nMines + b(x, y - 1).mine + b(x, y + 1).mine
75.                 nMines = nMines + b(x + 1, y - 1).mine + b(x + 1, y).mine + b(x + 1, y + 1).mine
76.                 b(x, y).id = -nMines
77.             ELSE
78.                 b(x, y).id = 0
79.             END IF
80.             b(x, y).reveal = 0
81.             showCell x, y
82.         NEXT
83.     NEXT
84. END SUB
85.  
86. SUB showCell (c, r)
87.     DIM x, y, clr AS _UNSIGNED LONG
88.     x = (c - 1) * sq: y = (r - 1) * sq
89.     SELECT CASE b(c, r).reveal
90.         CASE -1: IF b(c, r).mine THEN clr = &HFF883300 ELSE clr = &HFFFFFFFF 'revealed  white with number of mine neighbors
91.         CASE 0: clr = &HFF008800 'hidden green
92.         CASE 1: clr = &HFFFF0000 'marked red
93.     END SELECT
94.     LINE (x, y)-STEP(sq - 1, sq - 1), clr, BF
95.     LINE (x, y)-STEP(sq - 1, sq - 1), &HFF000000, B
96.     IF b(c, r).reveal = -1 THEN
97.         IF b(c, r).id > 0 THEN cText x + 30, y + 30, 50, &HFF000000, _TRIM$(STR$(b(c, r).id))
98.         IF b(c, r).mine = -1 THEN cText x + 30, y + 30, 50, &HFFFFFFFF, "*"
99.     END IF
100. END SUB
101.  
102. FUNCTION TFwin
103.     DIM c, x, y
104.     FOR y = 1 TO arrD
105.         FOR x = 1 TO arrD
106.             IF b(x, y).reveal = -1 AND b(x, y).mine = 0 THEN c = c + 1
107.         NEXT
108.     NEXT
109.     IF c = arrD * arrD - mines THEN TFwin = -1
110. END FUNCTION
111.  
112. SUB getCell (returnCol AS INTEGER, returnRow AS INTEGER, mbNum AS INTEGER)
113.     DIM m, mx, my, mb1, mb2
114.     WHILE _MOUSEINPUT: WEND
115.     mb1 = _MOUSEBUTTON(1): mb2 = _MOUSEBUTTON(2)
116.     IF mb1 THEN mbNum = 1
117.     IF mb2 THEN mbNum = 2
118.     IF mb1 OR mb2 THEN '                      get last place mouse button was down
119.         WHILE mb1 OR mb2 '                    wait for mouse button release as a "click"
120.             m = _MOUSEINPUT: mb1 = _MOUSEBUTTON(1): mb2 = _MOUSEBUTTON(2)
121.             mx = _MOUSEX: my = _MOUSEY
122.         WEND
123.         returnCol = INT(mx / sq) + 1: returnRow = INT(my / sq) + 1
124.     END IF
125. END SUB
126.  
127. SUB sweepZeros (col, row) ' recursive sweep with Rod's limits set
128.     DIM c, r, cMin, cMax, rMin, rMax, x, y, id
129.     c = col: r = row 'get copies for recursive sub
130.     IF c > 2 THEN cMin = c - 1 ELSE cMin = 1
131.     IF c < arrD - 1 THEN cMax = c + 1 ELSE cMax = arrD
132.     IF r > 2 THEN rMin = r - 1 ELSE rMin = 1
133.     IF r < arrD - 1 THEN rMax = r + 1 ELSE rMax = arrD
134.     FOR y = rMin TO rMax
135.         FOR x = cMin TO cMax
136.             IF b(x, y).reveal = 0 THEN
137.                 id = b(x, y).id
138.                 IF b(x, y).mine = 0 AND id = 0 THEN
139.                     b(x, y).reveal = -1 'mark played
140.                     showCell x, y
141.                     sweepZeros x, y
142.                 ELSE
143.                     IF b(x, y).mine = 0 AND id >= 1 AND id <= 8 THEN
144.                         b(x, y).reveal = -1
145.                         showCell x, y
146.                     END IF
147.                 END IF
148.             END IF
149.         NEXT
150.     NEXT
151. END SUB
152.  
153. 'center the text around (x, y) point, needs a graphics screen!
154. SUB cText (x, y, textHeight, K AS _UNSIGNED LONG, txt$)
155.     DIM fg AS _UNSIGNED LONG, cur&, I&, mult, xlen
156.     fg = _DEFAULTCOLOR
157.     'screen snapshot
158.     cur& = _DEST
159.     I& = _NEWIMAGE(8 * LEN(txt$), 16, 32)
160.     _DEST I&
161.     COLOR K, _RGBA32(0, 0, 0, 0)
162.     _PRINTSTRING (0, 0), txt$
163.     mult = textHeight / 16
164.     xlen = LEN(txt$) * 8 * mult
165.     _PUTIMAGE (x - .5 * xlen, y - .5 * textHeight)-STEP(xlen, textHeight), I&, cur&
166.     COLOR fg
167.     _FREEIMAGE I&
168. END SUB
169.  
170.  

2019-08-02 Update: _title change line number location and reflects mines set.

[Pete]

Rigged! I played 5 times, and it never took more than 2 moves for me to blow my ascii up!

Pete :O

[bplus]

Ha! It does have a shade more than std 15% mines. 14/81 = 17.28.. %

[SierraKen]

LOL awesome game!

[bplus]

Thanks, I am pretty sure Pete knows how to hack this game to play nicer :D

OK I will mine my own business now...

[bplus]

Update: A tiny change to _title to reflect the amount of mines you are playing.

[TempodiBasic]

Very cool!

In this kind of games I have not so much luck!
At first attempt I got a 1 in the middle of the green land ... so at the second click I got the mine :-))) LOL

[bplus]

Thanks TempodiBasic!

Maybe this will change everyone's luck, design you own minefield: screen size, cells, cell sizes, and mines.
Here I am using your text editor to fill out a spec form.

Code: QB64: [Select]

1. OPTION _EXPLICIT 'Bplus started 2019-08-01
2. ' update 2019-08-02 _title change line number so can reflect changes to mines constant.
3. ' 2019-08-03 Minesweeper Custom Field.bas creates a file: "Custom Field Specs.txt"
4. ' that you edit with your text editor, if you select that option in the opening screen menu.
5.  
6. DEFINT A-Z
7. DIM SHARED xmax, ymax, Xsq, Ysq, Xarrd, Yarrd, mines, Xmargin, Ymargin 'set all this in customField sub
8. _TITLE "Minesweeper: Custom Field"
9. customField
10. _TITLE STR$(mines) + " Minesweeper: left click reveals, right marks red"
11. SCREEN _NEWIMAGE(xmax, ymax, 32)
12. _SCREENMOVE (1280 - xmax) / 2, (760 - ymax) / 2
13. RANDOMIZE TIMER
14. TYPE boardType
15.     id AS INTEGER '0 to 8 neighbor mines
16.     reveal AS INTEGER ' 1 for marked, 0 hidden, -1 for revealed
17.     mine AS INTEGER '0 or -1
18. END TYPE
19. REDIM SHARED b(0 TO Xarrd + 1, 0 TO Yarrd + 1) AS boardType 'oversize the board to make it easy to count mines
20. DIM SHARED restart
21. DIM gameOver, cc, cr, mbN, c, r, s$, sz!
22. restart = 1
23. WHILE 1
24.     gameOver = 0
25.     WHILE gameOver = 0
26.         IF restart THEN initialize
27.         mbN = 0
28.         getCell cc, cr, mbN
29.         'LOCATE 1, 1: PRINT cc, cr, mbN
30.         IF mbN = 1 AND b(cc, cr).reveal = 0 THEN
31.             IF b(cc, cr).mine THEN 'ka boom
32.                 FOR r = 1 TO Yarrd 'show all mines
33.                     FOR c = 1 TO Xarrd
34.                         IF b(c, r).mine THEN b(c, r).reveal = -1: showCell c, r
35.                     NEXT
36.                 NEXT
37.                 s$ = "KA - BOOOMMMM!"
38.                 sz! = 1.2 * xmax / LEN(s$)
39.                 cText xmax / 2, ymax / 2, sz!, &HFF000000, s$
40.                 cText xmax / 2 - 4, ymax / 2 - 4, sz!, &HFFFF0000, s$
41.                 cText xmax / 2 - 8, ymax / 2 - 8, sz!, &HFFFFFF00, s$
42.                 gameOver = -1
43.                 _DELAY 7
44.             ELSE
45.                 b(cc, cr).reveal = -1: showCell cc, cr
46.                 IF b(cc, cr).id = 0 THEN sweepZeros cc, cr
47.             END IF
48.         ELSEIF mbN = 2 THEN
49.             IF b(cc, cr).reveal = 1 THEN
50.                 b(cc, cr).reveal = 0: showCell cc, cr
51.             ELSE
52.                 IF b(cc, cr).reveal = 0 THEN b(cc, cr).reveal = 1: showCell cc, cr
53.             END IF
54.         END IF
55.         IF TFwin THEN
56.             s$ = "Good Job!"
57.             sz! = 1.2 * xmax / LEN(s$)
58.             cText xmax / 2, ymax / 2, sz!, &HFF000000, s$
59.             cText xmax / 2 - 1, ymax / 2 - 2, sz!, &HFF000055, s$
60.             _DELAY 5
61.             gameOver = -1
62.         END IF
63.         _LIMIT 60
64.     WEND
65.     restart = 1
66. WEND
67.  
68. 'set all this 'DIM SHARED xmax, ymax, Xsq, Ysq, XarrD, YarrD, mines, Xmargin, Ymargin
69. SUB customField
70.     DIM fName$, fe, fLine$, p, inCnt, beenHere, w$, allow$, choice$
71.  
72.     fName$ = "Custom Field Specs.txt"
73.     IF _FILEEXISTS(fName$) THEN fe = -1 ELSE fe = 0
74.     allow$ = "12" + CHR$(27)
75.     PRINT
76.     PRINT "     Minesweeper options:"
77.     PRINT
78.     PRINT "  1. Use mine field settings: 800 x 600 screen with 9 X 9 cells and 10 mines."
79.     PRINT "  2. Customize your own field settings."
80.     IF fe THEN PRINT "  3. Use the last customized mine field settings.": allow$ = allow$ + "3"
81.     PRINT
82.     PRINT "     or press esc to quit."
83.     choice$ = getChar$(allow$)
84.     SELECT CASE choice$
85.         CASE "1": GOTO default
86.         CASE "2": GOSUB editCustom
87.         CASE "3": GOSUB loadCustom
88.         CASE ELSE: SYSTEM
89.     END SELECT
90.     EXIT SUB
91.  
92.     editCustom:
93.     OPEN fName$ FOR OUTPUT AS #1
94.     PRINT #1, " "
95.     PRINT #1, "     Custom Field Specs For Your Minesweeper Game"
96.     PRINT #1, " "
97.     PRINT #1, " Please fill out the right side of all Equal signs."
98.     PRINT #1, " "
99.     PRINT #1, "   X dimensions across the screen:"
100.     PRINT #1, "                  Screen Width (pixels) = "
101.     PRINT #1, "      Number of Horizontal Cells Across = "
102.     PRINT #1, "          Cell Width (12 - 100? pixels) = "
103.     PRINT #1, " "
104.     PRINT #1, "   Y dimensions going down:"
105.     PRINT #1, "                 Screen Height (pixels) = "
106.     PRINT #1, "                   Number of Cells Down = "
107.     PRINT #1, "          Cell Height (24 - 80? pixels) = "
108.     PRINT #1, " "
109.     PRINT #1, "The percent of mines (8 easy - 15 hard) = "
110.     PRINT #1, " "
111.     PRINT #1, "    To finish, Save the file and then close the editor."
112.     CLOSE #1
113.     ' I picked up this shortcut from Ken, normally I would call a text editor that I don't know if you have!
114.     SHELL fName$
115.     GOSUB loadCustom
116.     RETURN
117.  
118.     loadCustom:
119.     beenHere = beenHere + 1 'we'll give it 5 tries
120.     IF beenHere > 5 THEN
121.         PRINT "OK we tried 5 times, going with default settings..."
122.         GOTO default 'exit from there
123.     END IF
124.     inCnt = 0
125.     OPEN fName$ FOR INPUT AS #1
126.     WHILE EOF(1) = 0 ' look to get 7 values from 7 = signs
127.         LINE INPUT #1, fLine$
128.         'PRINT fLine$
129.         p = INSTR(fLine$, "=")
130.         IF p > 0 THEN
131.             inCnt = inCnt + 1
132.             SELECT CASE inCnt
133.                 CASE 1: xmax = VAL(rightOf$(fLine$, "="))
134.                 CASE 2: Xarrd = VAL(rightOf$(fLine$, "="))
135.                 CASE 3: Xsq = VAL(rightOf$(fLine$, "="))
136.                 CASE 4: ymax = VAL(rightOf$(fLine$, "="))
137.                 CASE 5: Yarrd = VAL(rightOf$(fLine$, "="))
138.                 CASE 6: Ysq = VAL(rightOf$(fLine$, "="))
139.                 CASE 7: mines = VAL(rightOf$(fLine$, "=")) * Xarrd * Yarrd / 100
140.             END SELECT
141.             IF inCnt = 7 THEN EXIT WHILE
142.         END IF
143.     WEND
144.     CLOSE #1
145.     IF inCnt = 7 THEN
146.         IF Xsq >= 12 THEN
147.             IF Ysq >= 24 THEN
148.                 IF xmax >= Xarrd * Xsq THEN
149.                     IF ymax >= Yarrd * Ysq THEN 'all good
150.                         GOSUB calcMargins: EXIT SUB
151.                     ELSE
152.                         PRINT "Opps, Screen height is not big enough for Y cells * pixels down."
153.                     END IF
154.                 ELSE
155.                     PRINT "Opps, Screen width is not big enough for X cells * pixels across."
156.                 END IF
157.             ELSE
158.                 PRINT "Y Cell pixels down probably not enough."
159.             END IF
160.         ELSE
161.             PRINT "X Cell pixels across probably not enough."
162.         END IF
163.     ELSE
164.         PRINT "We did not get everything filled out by = signs."
165.     END IF
166.     PRINT: PRINT "Press any to continue.. "
167.     SLEEP
168.     SHELL fName$
169.     GOTO loadCustom
170.     RETURN
171.  
172.     calcMargins:
173.     Xmargin = (xmax - Xarrd * Xsq) / 2: Ymargin = (ymax - Yarrd * Ysq) / 2
174.     RETURN
175.  
176.     default:
177.     xmax = 800: ymax = 600: Xarrd = 9: Yarrd = 9: Xsq = 60: Ysq = 60: mines = 10: GOSUB calcMargins
178. END SUB
179.  
180. SUB initialize ()
181.     DIM minesPlaced, rx, ry, x, y, nMines
182.     restart = 0
183.     REDIM b(0 TO Xarrd + 1, 0 TO Yarrd + 1) AS boardType
184.     minesPlaced = 0
185.     WHILE minesPlaced < mines
186.         rx = INT(RND * Xarrd) + 1: ry = INT(RND * Yarrd) + 1
187.         IF b(rx, ry).mine = 0 THEN
188.             b(rx, ry).mine = -1: minesPlaced = minesPlaced + 1
189.         END IF
190.     WEND
191.     'count mines amoung the neighbors
192.     FOR y = 1 TO Yarrd
193.         FOR x = 1 TO Xarrd
194.             IF b(x, y).mine <> -1 THEN 'not already a mine
195.                 nMines = b(x - 1, y - 1).mine + b(x - 1, y).mine + b(x - 1, y + 1).mine
196.                 nMines = nMines + b(x, y - 1).mine + b(x, y + 1).mine
197.                 nMines = nMines + b(x + 1, y - 1).mine + b(x + 1, y).mine + b(x + 1, y + 1).mine
198.                 b(x, y).id = -nMines
199.             ELSE
200.                 b(x, y).id = 0
201.             END IF
202.             b(x, y).reveal = 0
203.             showCell x, y
204.         NEXT
205.     NEXT
206. END SUB
207.  
208. SUB showCell (c, r)
209.     DIM x, y, clr AS _UNSIGNED LONG, sz
210.     x = (c - 1) * Xsq + Xmargin: y = (r - 1) * Ysq + Ymargin
211.     SELECT CASE b(c, r).reveal
212.         CASE -1: IF b(c, r).mine THEN clr = &HFF883300 ELSE clr = &HFFFFFFFF 'revealed  white with number of mine neighbors
213.         CASE 0: clr = &HFF008800 'hidden green
214.         CASE 1: clr = &HFFFF0000 'marked red
215.     END SELECT
216.     LINE (x, y)-STEP(Xsq - 1, Ysq - 1), clr, BF
217.     LINE (x, y)-STEP(Xsq - 1, Ysq - 1), &HFF000000, B
218.     IF Xsq < Ysq THEN sz = .8 * Xsq ELSE sz = .8 * Ysq
219.     IF b(c, r).reveal = -1 THEN
220.         IF b(c, r).id > 0 THEN cText x + Xsq / 2, y + Ysq / 2, sz, &HFF000000, _TRIM$(STR$(b(c, r).id))
221.         IF b(c, r).mine = -1 THEN cText x + Xsq / 2, y + Ysq / 2, sz, &HFFFFFFFF, "*"
222.     END IF
223. END SUB
224.  
225. FUNCTION TFwin
226.     DIM c, x, y
227.     FOR y = 1 TO Yarrd
228.         FOR x = 1 TO Xarrd
229.             IF b(x, y).reveal = -1 AND b(x, y).mine = 0 THEN c = c + 1
230.         NEXT
231.     NEXT
232.     IF c = Xarrd * Yarrd - mines THEN TFwin = -1
233. END FUNCTION
234.  
235. SUB getCell (returnCol AS INTEGER, returnRow AS INTEGER, mbNum AS INTEGER)
236.     DIM m, mx, my, mb1, mb2
237.     WHILE _MOUSEINPUT: WEND
238.     mb1 = _MOUSEBUTTON(1): mb2 = _MOUSEBUTTON(2)
239.     IF mb1 THEN mbNum = 1
240.     IF mb2 THEN mbNum = 2
241.     IF mb1 OR mb2 THEN '                      get last place mouse button was down
242.         WHILE mb1 OR mb2 '                    wait for mouse button release as a "click"
243.             m = _MOUSEINPUT: mb1 = _MOUSEBUTTON(1): mb2 = _MOUSEBUTTON(2)
244.             mx = _MOUSEX: my = _MOUSEY
245.         WEND
246.         returnCol = INT((mx - Xmargin) / Xsq) + 1: returnRow = INT((my - Ymargin) / Ysq) + 1
247.         IF returnCol < 1 OR returnCol > Xarrd OR returnRow < 1 OR returnRow > Yarrd THEN mbNum = 0
248.     END IF
249. END SUB
250.  
251. SUB sweepZeros (col, row) ' recursive sweep with Rod's limits set
252.     DIM c, r, cMin, cMax, rMin, rMax, x, y, id
253.     c = col: r = row 'get copies for recursive sub
254.     IF c > 2 THEN cMin = c - 1 ELSE cMin = 1
255.     IF c < Xarrd - 1 THEN cMax = c + 1 ELSE cMax = Xarrd
256.     IF r > 2 THEN rMin = r - 1 ELSE rMin = 1
257.     IF r < Yarrd - 1 THEN rMax = r + 1 ELSE rMax = Yarrd
258.     FOR y = rMin TO rMax
259.         FOR x = cMin TO cMax
260.             IF b(x, y).reveal = 0 THEN
261.                 id = b(x, y).id
262.                 IF b(x, y).mine = 0 AND id = 0 THEN
263.                     b(x, y).reveal = -1 'mark played
264.                     showCell x, y
265.                     sweepZeros x, y
266.                 ELSE
267.                     IF b(x, y).mine = 0 AND id >= 1 AND id <= 8 THEN
268.                         b(x, y).reveal = -1
269.                         showCell x, y
270.                     END IF
271.                 END IF
272.             END IF
273.         NEXT
274.     NEXT
275. END SUB
276.  
277. 'center the text around (x, y) point, needs a graphics screen!
278. SUB cText (x, y, textHeight AS SINGLE, K AS _UNSIGNED LONG, txt$)
279.     DIM fg AS _UNSIGNED LONG, cur&, I&, mult!, xlen
280.     fg = _DEFAULTCOLOR
281.     'screen snapshot
282.     cur& = _DEST
283.     I& = _NEWIMAGE(8 * LEN(txt$), 16, 32)
284.     _DEST I&
285.     COLOR K, _RGBA32(0, 0, 0, 0)
286.     _PRINTSTRING (0, 0), txt$
287.     mult! = textHeight / 16
288.     xlen = LEN(txt$) * 8 * mult!
289.     _PUTIMAGE (x - .5 * xlen, y - .5 * textHeight)-STEP(xlen, textHeight), I&, cur&
290.     COLOR fg
291.     _FREEIMAGE I&
292. END SUB
293.  
294. FUNCTION rightOf$ (source$, of$)
295.     IF INSTR(source$, of$) > 0 THEN rightOf$ = MID$(source$, INSTR(source$, of$) + LEN(of$))
296. END FUNCTION
297.  
298. FUNCTION getChar$ (fromStr$)
299.     DIM OK AS INTEGER, k$
300.     WHILE OK = 0
301.         k$ = INKEY$
302.         IF LEN(k$) THEN
303.             IF INSTR(fromStr$, k$) <> 0 THEN OK = -1
304.         END IF
305.         _LIMIT 200
306.     WEND
307.     _KEYCLEAR
308.     getChar$ = k$
309. END SUB
310.  
311.  

EDIT: shorten 2nd _TITLE for smaller screens

[TempodiBasic]

and fine also customizable version.

[bplus]

Thanks TempodiBasic,

I am putting together sound effects and maybe images for next round of customization's.

[bplus]

And here is Minesweeper you may customize and with sound effects added:

Code: QB64: [Select]

1. OPTION _EXPLICIT 'Bplus started 2019-08-01
2. ' update 2019-08-02 _title change line number so can reflect changes to mines constant.
3. ' 2019-08-03 Minesweeper Custom Field.bas creates a file: "Custom Field Specs.txt"
4. ' that you edit with your text editor, if you select that option in the opening screen menu.
5.  
6. ' 2019-08-04 add assets can use to the customize file, also if the file exits don't rewrite a blank one.
7. ' Thanks to SoundBible for sounds dowmloaded under License Attribution 3.0
8. ' http://soundbible.com
9. ' https://creativecommons.org/licenses/by/3.0/us/
10.  
11. DEFINT A-Z
12. DIM SHARED xmax, ymax, Xsq, Ysq, Xarrd, Yarrd, mines, Xmargin, Ymargin 'set all this in customField sub
13. DIM SHARED ToggleSnd AS LONG, BombSnd AS LONG, ApplauseSnd AS LONG, ButtonSnd AS LONG, AhhSnd AS LONG, ShipBellSnd AS LONG
14. DIM SHARED SwooshSnd AS LONG
15. _TITLE "Minesweeper Custom wAssets"
16. customField
17. ToggleSnd = _SNDOPEN("Toggle.wav") '
18. BombSnd = _SNDOPEN("BigBomb.wav") '
19. ApplauseSnd = _SNDOPEN("Applause.wav") '
20. ButtonSnd = _SNDOPEN("Button.wav") '
21. ShipBellSnd = _SNDOPEN("Ships bell.wav") '
22. SwooshSnd = _SNDOPEN("Swoosh.wav")
23. DIM SHARED rndSnd(9) AS LONG
24. rndSnd(0) = _SNDOPEN("Ahhh.wav") '
25. rndSnd(1) = _SNDOPEN("BuzzFade.wav") '
26. rndSnd(2) = _SNDOPEN("Carpet Ripping.wav") '
27. rndSnd(3) = _SNDOPEN("DrumRoll.wav") '
28. rndSnd(4) = _SNDOPEN("DyingNeon.wav") '
29. rndSnd(5) = _SNDOPEN("ElectricMotor.wav") '
30. rndSnd(6) = _SNDOPEN("Slime.wav")
31. rndSnd(7) = _SNDOPEN("Gaffy.wav") '
32. rndSnd(8) = _SNDOPEN("Monkey.wav") '
33. rndSnd(9) = _SNDOPEN("Rooster.wav") '
34. 'DIM i    'test load and sounds
35. 'FOR i = 6 TO 6
36. '    _SNDPLAY (rndSnd(i))
37. '    PRINT i;
38. '    IF rndSnd(i) = 0 THEN PRINT i; " not loaded." ELSE PRINT
39. '    _DELAY 3
40. 'NEXT
41.  
42. IF ButtonSnd = 0 THEN PRINT "No Button snd": END
43. _TITLE STR$(mines) + " Minesweeper: left click cell to reveal, right click to mark mine (red)"
44. SCREEN _NEWIMAGE(xmax, ymax, 32)
45. _SCREENMOVE (1280 - xmax) / 2 + 60, (760 - ymax) / 2
46. RANDOMIZE TIMER
47. TYPE boardType
48.     id AS INTEGER '0 to 8 neighbor mines
49.     reveal AS INTEGER ' 1 for marked, 0 hidden, -1 for revealed
50.     mine AS INTEGER '0 or -1
51. END TYPE
52. REDIM SHARED b(0 TO Xarrd + 1, 0 TO Yarrd + 1) AS boardType 'oversize the board to make it easy to count mines
53. DIM SHARED restart
54. DIM gameOver, cc, cr, mbN, c, r, s$, sz!
55. restart = 1
56. WHILE 1
57.     gameOver = 0
58.     WHILE gameOver = 0
59.         IF restart THEN initialize
60.         mbN = 0
61.         getCell cc, cr, mbN
62.         'LOCATE 1, 1: PRINT cc, cr, mbN
63.         IF mbN = 1 AND b(cc, cr).reveal = 0 THEN
64.             IF b(cc, cr).mine THEN 'ka boom
65.                 _SNDPLAY BombSnd
66.                 FOR r = 1 TO Yarrd 'show all mines
67.                     FOR c = 1 TO Xarrd
68.                         IF b(c, r).mine THEN b(c, r).reveal = -1: showCell c, r
69.                     NEXT
70.                 NEXT
71.                 s$ = "KA - BOOOMMMM!"
72.                 sz! = 1.2 * xmax / LEN(s$)
73.                 cText xmax / 2, ymax / 2, sz!, &HFF000000, s$
74.                 cText xmax / 2 - 4, ymax / 2 - 4, sz!, &HFFFF0000, s$
75.                 cText xmax / 2 - 8, ymax / 2 - 8, sz!, &HFFFFFF00, s$
76.                 gameOver = -1
77.                 _DELAY 7
78.             ELSE
79.                 IF b(cc, cr).reveal = 0 THEN
80.                     IF RND < .75 THEN _SNDPLAY ButtonSnd ELSE _SNDPLAY rndSnd(INT(RND * 10))
81.                     b(cc, cr).reveal = -1: showCell cc, cr
82.                     IF b(cc, cr).id = 0 THEN sweepZeros cc, cr
83.                 END IF
84.             END IF
85.         ELSEIF mbN = 2 THEN
86.             _SNDPLAY ToggleSnd
87.             IF b(cc, cr).reveal = 1 THEN
88.                 b(cc, cr).reveal = 0: showCell cc, cr
89.             ELSE
90.                 IF b(cc, cr).reveal = 0 THEN b(cc, cr).reveal = 1: showCell cc, cr
91.             END IF
92.         END IF
93.         IF TFwin THEN
94.             _SNDPLAY ApplauseSnd
95.             s$ = "Good Job!"
96.             sz! = 1.2 * xmax / LEN(s$)
97.             cText xmax / 2, ymax / 2, sz!, &HFF000000, s$
98.             cText xmax / 2 - 1, ymax / 2 - 2, sz!, &HFF000055, s$
99.             _DELAY 5
100.             gameOver = -1
101.         END IF
102.         _LIMIT 60
103.     WEND
104.     restart = 1
105. WEND
106.  
107. 'set all this 'DIM SHARED xmax, ymax, Xsq, Ysq, XarrD, YarrD, mines, Xmargin, Ymargin
108. SUB customField
109.     DIM fName$, fe, fLine$, p, inCnt, beenHere, w$, allow$, choice$
110.  
111.     fName$ = "Custom Field Specs.txt"
112.     IF _FILEEXISTS(fName$) THEN fe = -1 ELSE fe = 0
113.     allow$ = "12" + CHR$(27)
114.     PRINT
115.     PRINT "     Minesweeper options:"
116.     PRINT
117.     PRINT "  1. Use mine field settings: 800 x 600 screen with 9 X 9 cells and 10 mines."
118.     PRINT "  2. Customize your own field settings."
119.     IF fe THEN PRINT "  3. Use the last customized mine field settings.": allow$ = allow$ + "3"
120.     PRINT
121.     PRINT "     or press esc to quit."
122.     choice$ = getChar$(allow$)
123.     SELECT CASE choice$
124.         CASE "1": GOTO default
125.         CASE "2": GOSUB editCustom
126.         CASE "3": GOSUB loadCustom
127.         CASE ELSE: SYSTEM
128.     END SELECT
129.     EXIT SUB
130.  
131.     editCustom:
132.     IF fe = 0 THEN 'need to start the file, otherwise just edit what's there
133.         OPEN fName$ FOR OUTPUT AS #1
134.         PRINT #1, " "
135.         PRINT #1, "     Custom Field Specs for your Minesweeper Game"
136.         PRINT #1, " "
137.         PRINT #1, " Please fill out the right side of all Equal signs."
138.         PRINT #1, " "
139.         PRINT #1, "   X dimensions across the screen:"
140.         PRINT #1, "                  Screen Width (pixels) = "
141.         PRINT #1, "      Number of Horizontal Cells Across = "
142.         PRINT #1, "          Cell Width (12 - 100? pixels) = "
143.         PRINT #1, " "
144.         PRINT #1, "   Y dimensions going down:"
145.         PRINT #1, "                 Screen Height (pixels) = "
146.         PRINT #1, "                   Number of Cells Down = "
147.         PRINT #1, "          Cell Height (24 - 80? pixels) = "
148.         PRINT #1, " "
149.         PRINT #1, "The percent of mines (8 easy - 15 hard) = "
150.         PRINT #1, " "
151.         PRINT #1, "    To finish, Save the file and then close the editor."
152.         CLOSE #1
153.     END IF
154.     ' I picked up this shortcut from Ken, normally I would call a text editor that I don't know if you have!
155.     SHELL fName$
156.     GOSUB loadCustom
157.     RETURN
158.  
159.     loadCustom:
160.     beenHere = beenHere + 1 'we'll give it 5 tries
161.     IF beenHere > 5 THEN
162.         PRINT "OK we tried 5 times, going with default settings..."
163.         GOTO default 'exit from there
164.     END IF
165.     inCnt = 0
166.     OPEN fName$ FOR INPUT AS #1
167.     WHILE EOF(1) = 0 ' look to get 7 values from 7 = signs
168.         LINE INPUT #1, fLine$
169.         'PRINT fLine$
170.         p = INSTR(fLine$, "=")
171.         IF p > 0 THEN
172.             inCnt = inCnt + 1
173.             SELECT CASE inCnt
174.                 CASE 1: xmax = VAL(rightOf$(fLine$, "="))
175.                 CASE 2: Xarrd = VAL(rightOf$(fLine$, "="))
176.                 CASE 3: Xsq = VAL(rightOf$(fLine$, "="))
177.                 CASE 4: ymax = VAL(rightOf$(fLine$, "="))
178.                 CASE 5: Yarrd = VAL(rightOf$(fLine$, "="))
179.                 CASE 6: Ysq = VAL(rightOf$(fLine$, "="))
180.                 CASE 7: mines = VAL(rightOf$(fLine$, "=")) * Xarrd * Yarrd / 100
181.             END SELECT
182.             IF inCnt = 7 THEN EXIT WHILE
183.         END IF
184.     WEND
185.     CLOSE #1
186.  
187.     'debug....................
188.     'PRINT "xmax = "; xmax, "ymax = "; ymax, "Xarrd = "; Xarrd, "Yarrd = "; Yarrd
189.     'PRINT "Xsq = "; Xsq, "Ysq = "; Ysq, "Mines = "; mines
190.     'INPUT "OK... enter "; w$
191.  
192.     IF inCnt = 7 THEN
193.         IF Xsq >= 12 THEN
194.             IF Ysq >= 24 THEN
195.                 IF xmax >= Xarrd * Xsq THEN
196.                     IF ymax >= Yarrd * Ysq THEN 'all good
197.                         GOSUB calcMargins: EXIT SUB
198.                     ELSE
199.                         PRINT "Opps, Screen height is not big enough for Y cells * pixels down. "
200.                     END IF
201.                 ELSE
202.                     PRINT "Opps, Screen width is not big enough for X cells * pixels across. "
203.                 END IF
204.             ELSE
205.                 PRINT "Y Cell pixels down probably not enough. "
206.             END IF
207.         ELSE
208.             PRINT "X Cell pixels across probably not enough. "
209.         END IF
210.     ELSE
211.         PRINT "We did not get everything filled out by = signs."
212.     END IF
213.     PRINT: PRINT "Press any to continue.. "
214.     SLEEP
215.     SHELL fName$
216.     GOTO loadCustom
217.     RETURN
218.  
219.     calcMargins:
220.     Xmargin = (xmax - Xarrd * Xsq) / 2: Ymargin = (ymax - Yarrd * Ysq) / 2
221.     RETURN
222.  
223.     default:
224.     xmax = 800: ymax = 600: Xarrd = 9: Yarrd = 9: Xsq = 60: Ysq = 60: mines = 10: GOSUB calcMargins
225.  
226. END SUB
227.  
228. SUB initialize ()
229.     DIM minesPlaced, rx, ry, x, y, nMines
230.     restart = 0
231.     _SNDPLAY ShipBellSnd
232.     REDIM b(0 TO Xarrd + 1, 0 TO Yarrd + 1) AS boardType
233.     minesPlaced = 0
234.     WHILE minesPlaced < mines
235.         rx = INT(RND * Xarrd) + 1: ry = INT(RND * Yarrd) + 1
236.         IF b(rx, ry).mine = 0 THEN
237.             b(rx, ry).mine = -1: minesPlaced = minesPlaced + 1
238.         END IF
239.     WEND
240.     'count mines amoung the neighbors
241.     FOR y = 1 TO Yarrd
242.         FOR x = 1 TO Xarrd
243.             IF b(x, y).mine <> -1 THEN 'not already a mine
244.                 nMines = b(x - 1, y - 1).mine + b(x - 1, y).mine + b(x - 1, y + 1).mine
245.                 nMines = nMines + b(x, y - 1).mine + b(x, y + 1).mine
246.                 nMines = nMines + b(x + 1, y - 1).mine + b(x + 1, y).mine + b(x + 1, y + 1).mine
247.                 b(x, y).id = -nMines
248.             ELSE
249.                 b(x, y).id = 0
250.             END IF
251.             b(x, y).reveal = 0
252.             showCell x, y
253.         NEXT
254.     NEXT
255. END SUB
256.  
257. SUB showCell (c, r)
258.     DIM x, y, clr AS _UNSIGNED LONG, sz
259.     x = (c - 1) * Xsq + Xmargin: y = (r - 1) * Ysq + Ymargin
260.     SELECT CASE b(c, r).reveal
261.         CASE -1: IF b(c, r).mine THEN clr = &HFF883300 ELSE clr = &HFFFFFFFF 'revealed  white with number of mine neighbors
262.         CASE 0: clr = &HFF008800 'hidden green
263.         CASE 1: clr = &HFFFF0000 'marked red
264.     END SELECT
265.     LINE (x, y)-STEP(Xsq - 1, Ysq - 1), clr, BF
266.     LINE (x, y)-STEP(Xsq - 1, Ysq - 1), &HFF000000, B
267.     IF Xsq < Ysq THEN sz = .8 * Xsq ELSE sz = .8 * Ysq
268.     IF b(c, r).reveal = -1 THEN
269.         IF b(c, r).id > 0 THEN cText x + Xsq / 2, y + Ysq / 2, sz, &HFF000000, _TRIM$(STR$(b(c, r).id))
270.         IF b(c, r).mine = -1 THEN cText x + Xsq / 2, y + Ysq / 2, sz, &HFFFFFFFF, "*"
271.     END IF
272. END SUB
273.  
274. FUNCTION TFwin
275.     DIM c, x, y
276.     FOR y = 1 TO Yarrd
277.         FOR x = 1 TO Xarrd
278.             IF b(x, y).reveal = -1 AND b(x, y).mine = 0 THEN c = c + 1
279.         NEXT
280.     NEXT
281.     IF c = Xarrd * Yarrd - mines THEN TFwin = -1
282. END FUNCTION
283.  
284. SUB getCell (returnCol AS INTEGER, returnRow AS INTEGER, mbNum AS INTEGER)
285.     DIM m, mx, my, mb1, mb2
286.     WHILE _MOUSEINPUT: WEND
287.     mb1 = _MOUSEBUTTON(1): mb2 = _MOUSEBUTTON(2)
288.     IF mb1 THEN mbNum = 1
289.     IF mb2 THEN mbNum = 2
290.     IF mb1 OR mb2 THEN '                      get last place mouse button was down
291.         WHILE mb1 OR mb2 '                    wait for mouse button release as a "click"
292.             m = _MOUSEINPUT: mb1 = _MOUSEBUTTON(1): mb2 = _MOUSEBUTTON(2)
293.             mx = _MOUSEX: my = _MOUSEY
294.         WEND
295.         returnCol = INT((mx - Xmargin) / Xsq) + 1: returnRow = INT((my - Ymargin) / Ysq) + 1
296.         IF returnCol < 1 OR returnCol > Xarrd OR returnRow < 1 OR returnRow > Yarrd THEN mbNum = 0
297.     END IF
298. END SUB
299.  
300. SUB sweepZeros (col, row) ' recursive sweep with Rod's limits set
301.     DIM c, r, cMin, cMax, rMin, rMax, x, y, id
302.     _SNDPLAY SwooshSnd
303.     c = col: r = row 'get copies for recursive sub
304.     IF c > 2 THEN cMin = c - 1 ELSE cMin = 1
305.     IF c < Xarrd - 1 THEN cMax = c + 1 ELSE cMax = Xarrd
306.     IF r > 2 THEN rMin = r - 1 ELSE rMin = 1
307.     IF r < Yarrd - 1 THEN rMax = r + 1 ELSE rMax = Yarrd
308.     FOR y = rMin TO rMax
309.         FOR x = cMin TO cMax
310.             IF b(x, y).reveal = 0 THEN
311.                 id = b(x, y).id
312.                 IF b(x, y).mine = 0 AND id = 0 THEN
313.                     b(x, y).reveal = -1 'mark played
314.                     showCell x, y
315.                     sweepZeros x, y
316.                 ELSE
317.                     IF b(x, y).mine = 0 AND id >= 1 AND id <= 8 THEN
318.                         b(x, y).reveal = -1
319.                         showCell x, y
320.                     END IF
321.                 END IF
322.             END IF
323.         NEXT
324.     NEXT
325. END SUB
326.  
327. 'center the text around (x, y) point, needs a graphics screen!
328. SUB cText (x, y, textHeight AS SINGLE, K AS _UNSIGNED LONG, txt$)
329.     DIM fg AS _UNSIGNED LONG, cur&, I&, mult!, xlen
330.     fg = _DEFAULTCOLOR
331.     'screen snapshot
332.     cur& = _DEST
333.     I& = _NEWIMAGE(8 * LEN(txt$), 16, 32)
334.     _DEST I&
335.     COLOR K, _RGBA32(0, 0, 0, 0)
336.     _PRINTSTRING (0, 0), txt$
337.     mult! = textHeight / 16
338.     xlen = LEN(txt$) * 8 * mult!
339.     _PUTIMAGE (x - .5 * xlen, y - .5 * textHeight)-STEP(xlen, textHeight), I&, cur&
340.     COLOR fg
341.     _FREEIMAGE I&
342. END SUB
343.  
344. FUNCTION rightOf$ (source$, of$)
345.     IF INSTR(source$, of$) > 0 THEN rightOf$ = MID$(source$, INSTR(source$, of$) + LEN(of$))
346. END FUNCTION
347.  
348. FUNCTION getChar$ (fromStr$)
349.     DIM OK AS INTEGER, k$
350.     WHILE OK = 0
351.         k$ = INKEY$
352.         IF LEN(k$) THEN
353.             IF INSTR(fromStr$, k$) <> 0 THEN OK = -1
354.         END IF
355.         _LIMIT 200
356.     WEND
357.     _KEYCLEAR
358.     getChar$ = k$
359. END SUB
360.  
361.  

It's currently set to pretty easy game, just don't click top left cell for starters, the percentages are bad.

[SMcNeill]

You like various challenges, bplus; maybe you'll like the idea for this one -- create a hexagonal minesweeper, just to be different.

Code: QB64: [Select]

1. SCREEN _NEWIMAGE(640, 480, 32)
2. DrawMap 50, 50, 24, 12, 10, -1
3.  
4.  
5. SUB DrawMap (TopLeftX, TopLeftY, Hexsize, MapXLimit, MapYLimit, C)
6.     F = _FONT
7.     DC = _DEFAULTCOLOR: BG = _BACKGROUNDCOLOR
8.     HexWidth = SQR(3) * Hexsize: HexHeight = 2 * Hexsize 'Height and Width of each individual hex
9.     FOR X = 0 TO MapXLimit
10.         FOR Y = 0 TO MapYLimit
11.             CenterX = TopLeftX + X * HexWidth
12.             CenterY = TopLeftY + Y * HexHeight * 0.75
13.             IF Y MOD 2 THEN CenterX = CenterX + HexWidth / 2 'offset for odd/even rows
14.             Point1X = CenterX - HexWidth / 2
15.             Point2X = CenterX
16.             Point3x = CenterX + HexWidth / 2
17.             Point1y = CenterY - HexHeight / 2
18.             Point2y = CenterY - HexHeight / 4
19.             Point3y = CenterY + HexHeight / 4
20.             Point4y = CenterY + HexHeight / 2
21.             LINE (Point1X, Point2y)-(Point2X, Point1y), C 'NorthWest
22.             LINE (Point2X, Point1y)-(Point3x, Point2y), C 'NorthEast
23.             LINE (Point3x, Point2y)-(Point3x, Point3y), C 'East
24.             LINE (Point3x, Point3y)-(Point2X, Point4y), C 'SouthEast
25.             LINE (Point2X, Point4y)-(Point1X, Point3y), C 'SouthWest
26.             LINE (Point1X, Point3y)-(Point1X, Point2y), C 'West
27.  
28.             'If we want the coordinates, we use the following, else just delete or remark out the next few lines:
29.             _FONT 8
30.             COLOR &HFFFF0000, 0
31.             CenterText Point1X, Point1y, Point3x, Point4y, _TRIM$(STR$(X)) + "," + _TRIM$(STR$(Y))
32.         NEXT
33.     NEXT
34.     _FONT F
35.     COLOR DC, BG
36. END SUB
37.  
38. SUB CenterText (x1, y1, x2, y2, text$)
39.     text$ = _TRIM$(text$)
40.     xmax = x2 - x1: ymax = y2 - y1
41.     textlength = _PRINTWIDTH(text$)
42.     xpos = (xmax - textlength) / 2
43.     ypos = (ymax - _FONTHEIGHT) / 2
44.     _PRINTSTRING (x1 + xpos, y1 + ypos), text$
45. END SUB

Trickiest part here is remembering that diagonals are only a half step off.  View the example above and study the coordinate system carefully:

Y  coordinates change by 1 step each time we move in the grid.
X coordinates only change by .5 each step we move in the grid. 

[bplus]

:) Thanks Steve, you got me thinking.

[bplus]

OK the quick version seems to be working OK:

Code: QB64: [Select]

1. OPTION _EXPLICIT 'Bplus 2019-08-07 instigated by Steve McNeill
2. '2019-08-08 fixed incomplete sweepZeros problem
3.  
4. DEFINT A-Z '      10 x 10 Hex grid, 12% mines
5. CONST xmax = 510, ymax = 430, cellR = 25, arrD = 10, mines = 10
6. DIM SHARED xspacing!, yspacing!
7. xspacing! = 2 * cellR * COS(_D2R(30)): yspacing! = cellR * (1 + SIN(_D2R(30)))
8.  
9. _TITLE STR$(mines) + " Mine-sweeper Hexagon Style!: left click cell to reveal, right click to mark mine (red)"
10. SCREEN _NEWIMAGE(xmax, ymax, 32)
11. _SCREENMOVE 300, 10
12. RANDOMIZE TIMER
13. TYPE boardType
14.     x AS SINGLE 'pixel location
15.     y AS SINGLE 'pixel location
16.     id AS INTEGER '0 to 8 neighbor mines
17.     reveal AS INTEGER ' 1 for marked, 0 hidden, -1 for revealed
18.     mine AS INTEGER '0 or -1
19. END TYPE
20. REDIM SHARED b(0 TO arrD + 1, 0 TO arrD + 1) AS boardType 'oversize the board to make it easy to count mines
21. DIM SHARED restart, dxdyOFF(6, 1), dxdyNoOff(6, 1)
22. DIM gameOver, cc, cr, mbN, c, r, i, dx, dy
23.  
24. 'set the 2 sets of directions to neighbors a cell could have depending if the row is offset or not
25. RESTORE NoOff
26. FOR i = 0 TO 5
27.     READ dx, dy
28.     dxdyNoOff(i, 0) = dx: dxdyNoOff(i, 1) = dy
29. NEXT
30. RESTORE xOff
31. FOR i = 0 TO 5
32.     READ dx, dy
33.     dxdyOFF(i, 0) = dx: dxdyOFF(i, 1) = dy
34. NEXT
35.  
36. restart = 1
37. WHILE 1
38.     gameOver = 0
39.     WHILE gameOver = 0
40.         IF restart THEN initialize
41.         mbN = 0
42.         getCell cc, cr, mbN
43.         IF mbN = 1 AND b(cc, cr).reveal = 0 THEN
44.             IF b(cc, cr).mine THEN 'ka boom
45.                 FOR r = 1 TO arrD 'show all mines
46.                     FOR c = 1 TO arrD
47.                         IF b(c, r).mine THEN b(c, r).reveal = -1: showCell c, r
48.                     NEXT
49.                 NEXT
50.                 cText xmax / 2, ymax / 2, 72, &HFF000000, "KA - BOOOMMMM!"
51.                 cText xmax / 2 - 4, ymax / 2 - 4, 64, &HFFFF0000, "KA - BOOOMMMM!"
52.                 cText xmax / 2 - 8, ymax / 2 - 8, 56, &HFFFFFF00, "KA - BOOOMMMM!"
53.                 gameOver = -1
54.                 _DELAY 7
55.             ELSE
56.                 b(cc, cr).reveal = -1: showCell cc, cr
57.                 IF b(cc, cr).id = 0 THEN sweepZeros cc, cr
58.             END IF
59.         ELSEIF mbN = 2 THEN
60.             IF b(cc, cr).reveal = 1 THEN
61.                 b(cc, cr).reveal = 0: showCell cc, cr
62.             ELSE
63.                 IF b(cc, cr).reveal = 0 THEN b(cc, cr).reveal = 1: showCell cc, cr
64.             END IF
65.         END IF
66.         IF TFwin THEN
67.             cText xmax / 2, ymax / 2, 80, &HFF001144, "Good Job!"
68.             cText xmax / 2 - 1, ymax / 2 - 2, 80, &HFF000055, "Good Job!"
69.             _DELAY 5
70.             gameOver = -1
71.         END IF
72.         _LIMIT 60
73.     WEND
74.     restart = 1
75. WEND
76.  
77. NoOff:
78. DATA 1,0,0,-1,0,1,-1,-1,-1,0,-1,1
79.  
80. xOff:
81. DATA -1,0,0,-1,0,1,1,-1,1,0,1,1
82.  
83. SUB initialize ()
84.     DIM minesPlaced, rx, ry, x, y, nMines, xoffset!
85.     CLS
86.     restart = 0
87.     REDIM b(0 TO arrD + 1, 0 TO arrD + 1) AS boardType
88.     minesPlaced = 0
89.     WHILE minesPlaced < mines
90.         rx = INT(RND * arrD) + 1: ry = INT(RND * arrD) + 1
91.         IF b(rx, ry).mine = 0 THEN
92.             b(rx, ry).mine = -1: minesPlaced = minesPlaced + 1
93.         END IF
94.     WEND
95.     'count mines amoung the neighbors
96.     FOR y = 1 TO arrD
97.         IF y MOD 2 = 0 THEN xoffset! = .5 * xspacing! ELSE xoffset! = 0
98.         FOR x = 1 TO arrD
99.             IF b(x, y).mine <> -1 THEN 'not already a mine
100.                 '2 sets of neighbors depending if x offset or not
101.                 IF xoffset! > .1 THEN
102.                     nMines = b(x - 1, y).mine + b(x, y - 1).mine + b(x, y + 1).mine
103.                     nMines = nMines + b(x + 1, y - 1).mine + b(x + 1, y).mine + b(x + 1, y + 1).mine
104.                 ELSE
105.                     nMines = b(x + 1, y).mine + b(x, y - 1).mine + b(x, y + 1).mine
106.                     nMines = nMines + b(x - 1, y - 1).mine + b(x - 1, y).mine + b(x - 1, y + 1).mine
107.                 END IF
108.                 b(x, y).id = -nMines
109.             ELSE
110.                 b(x, y).id = 0
111.             END IF
112.             b(x, y).x = x * xspacing! + xoffset! + 5
113.             b(x, y).y = y * yspacing! + 5
114.             b(x, y).reveal = 0
115.             showCell x, y
116.         NEXT
117.     NEXT
118. END SUB
119.  
120. SUB showCell (c, r)
121.     DIM da, x!, y!, lastx!, lasty!, clr AS _UNSIGNED LONG
122.     SELECT CASE b(c, r).reveal
123.         CASE -1: IF b(c, r).mine THEN clr = &HFF883300 ELSE clr = &HFFFFFFFF 'revealed  white with number of mine neighbors
124.         CASE 0: clr = &HFF008800 'hidden green
125.         CASE 1: clr = &HFFFF0000 'marked red
126.     END SELECT
127.     lastx! = b(c, r).x + cellR * COS(_D2R(-30))
128.     lasty! = b(c, r).y + cellR * SIN(_D2R(-30))
129.     FOR da = 30 TO 330 STEP 60
130.         x! = b(c, r).x + cellR * COS(_D2R(da))
131.         y! = b(c, r).y + cellR * SIN(_D2R(da))
132.         LINE (lastx!, lasty!)-(x!, y!), &HFFFF00FF
133.         lastx! = x!: lasty! = y!
134.     NEXT
135.     PAINT (b(c, r).x, b(c, r).y), clr, &HFFFF00FF
136.     IF b(c, r).reveal = -1 THEN
137.         'cText b(c, r).x, b(c, r).y, 15, &HFF000000, _TRIM$(STR$(c)) + "," + _TRIM$(STR$(r))
138.         IF b(c, r).id > 0 THEN cText b(c, r).x, b(c, r).y, 35, &HFF000000, _TRIM$(STR$(b(c, r).id))
139.         IF b(c, r).mine = -1 THEN cText b(c, r).x, b(c, r).y, 35, &HFFFFFFFF, "*"
140.     END IF
141. END SUB
142.  
143. FUNCTION TFwin
144.     DIM c, x, y
145.     FOR y = 1 TO arrD
146.         FOR x = 1 TO arrD
147.             IF b(x, y).reveal = -1 AND b(x, y).mine = 0 THEN c = c + 1
148.         NEXT
149.     NEXT
150.     IF c = arrD * arrD - mines THEN TFwin = -1
151. END FUNCTION
152.  
153. SUB getCell (returnCol AS INTEGER, returnRow AS INTEGER, mbNum AS INTEGER)
154.     DIM m, mx, my, mb1, mb2, r, c
155.     WHILE _MOUSEINPUT: WEND
156.     mb1 = _MOUSEBUTTON(1): mb2 = _MOUSEBUTTON(2)
157.     IF mb1 THEN mbNum = 1
158.     IF mb2 THEN mbNum = 2
159.     IF mb1 OR mb2 THEN '                      get last place mouse button was down
160.         WHILE mb1 OR mb2 '                    wait for mouse button release as a "click"
161.             m = _MOUSEINPUT: mb1 = _MOUSEBUTTON(1): mb2 = _MOUSEBUTTON(2)
162.             mx = _MOUSEX: my = _MOUSEY
163.         WEND
164.         FOR r = 1 TO arrD
165.             FOR c = 1 TO arrD
166.                 IF ((mx - b(c, r).x) ^ 2 + (my - b(c, r).y) ^ 2) ^ .5 < .5 * xspacing! THEN
167.                     returnCol = c: returnRow = r: EXIT SUB
168.                 END IF
169.             NEXT
170.         NEXT
171.         mbNum = 0 'still here then clicked wrong
172.     END IF
173. END SUB
174.  
175. SUB sweepZeros (col, row)
176.     DIM c, r, d, x, y, id
177.     c = col: r = row 'get copies for recursive sub
178.     FOR d = 0 TO 5
179.         IF r MOD 2 = 0 THEN
180.             x = dxdyOFF(d, 0) + c: y = dxdyOFF(d, 1) + r
181.         ELSE
182.             x = dxdyNoOff(d, 0) + c: y = dxdyNoOff(d, 1) + r
183.         END IF
184.         IF x >= 1 AND x <= arrD AND y >= 1 AND y <= arrD THEN
185.             IF b(x, y).reveal = 0 THEN
186.                 id = b(x, y).id
187.                 IF b(x, y).mine = 0 AND id = 0 THEN
188.                     b(x, y).reveal = -1 'mark played
189.                     showCell x, y
190.                     sweepZeros x, y
191.                 ELSEIF b(x, y).mine = 0 AND id >= 1 THEN
192.                     b(x, y).reveal = -1
193.                     showCell x, y
194.                 END IF
195.             END IF
196.         END IF
197.     NEXT
198. END SUB
199.  
200. 'center the text around (x, y) point, needs a graphics screen!
201. SUB cText (x, y, textHeight, K AS _UNSIGNED LONG, txt$)
202.     DIM fg AS _UNSIGNED LONG, cur&, I&, mult, xlen
203.     fg = _DEFAULTCOLOR
204.     'screen snapshot
205.     cur& = _DEST
206.     I& = _NEWIMAGE(8 * LEN(txt$), 16, 32)
207.     _DEST I&
208.     COLOR K, _RGBA32(0, 0, 0, 0)
209.     _PRINTSTRING (0, 0), txt$
210.     mult = textHeight / 16
211.     xlen = LEN(txt$) * 8 * mult
212.     _PUTIMAGE (x - .5 * xlen, y - .5 * textHeight)-STEP(xlen, textHeight), I&, cur&
213.     COLOR fg
214.     _FREEIMAGE I&
215. END SUB
216.  

hmm... the sweeper might be leaving holes

Update/Code EDIT: found the cause of the incomplete sweeps and fixed in the above code.

[SMcNeill]

Here's a little tweaking to the settings (and number sizes) so you can play around with a 30x30 grid, with 100 mines.  It looks a lot more like an actual minesweeper game to me now.  :D

Code: QB64: [Select]

1. OPTION _EXPLICIT 'Bplus 2019-08-07 instigated by Steve McNeill
2.  
3. DEFINT A-Z '      30 x 30 Hex grid, 12% mines
4. CONST xmax = 510, ymax = 430, cellR = 9, arrD = 30, mines = 100
5. DIM SHARED xspacing!, yspacing!
6. xspacing! = 2 * cellR * COS(_D2R(30)): yspacing! = cellR * (1 + SIN(_D2R(30)))
7.  
8. _TITLE STR$(mines) + " Mine-sweeper Hexagon Style!: left click cell to reveal, right click to mark mine (red)"
9. SCREEN _NEWIMAGE(xmax, ymax, 32)
10. _SCREENMOVE 300, 10
11. RANDOMIZE TIMER
12. TYPE boardType
13.     x AS SINGLE 'pixel location
14.     y AS SINGLE 'pixel location
15.     id AS INTEGER '0 to 8 neighbor mines
16.     reveal AS INTEGER ' 1 for marked, 0 hidden, -1 for revealed
17.     mine AS INTEGER '0 or -1
18. END TYPE
19. REDIM SHARED b(0 TO arrD + 1, 0 TO arrD + 1) AS boardType 'oversize the board to make it easy to count mines
20. DIM SHARED restart, dxdyOFF(5, 1), dxdyNoOff(5, 1)
21. DIM gameOver, cc, cr, mbN, c, r, i, dx, dy
22.  
23. 'set the 2 sets of directions to neighbors a cell could have depending if the row is offset or not
24. RESTORE NoOff
25. FOR i = 0 TO 5
26.     READ dx, dy
27.     dxdyNoOff(i, 0) = dx: dxdyNoOff(i, 1) = dy
28. NEXT
29. RESTORE xOff
30. FOR i = 0 TO 5
31.     READ dx, dy
32.     dxdyOFF(i, 0) = dx: dxdyOFF(i, 1) = dy
33. NEXT
34.  
35. restart = 1
36. WHILE 1
37.     gameOver = 0
38.     WHILE gameOver = 0
39.         IF restart THEN initialize
40.         mbN = 0
41.         getCell cc, cr, mbN
42.         IF mbN = 1 AND b(cc, cr).reveal = 0 THEN
43.             IF b(cc, cr).mine THEN 'ka boom
44.                 FOR r = 1 TO arrD 'show all mines
45.                     FOR c = 1 TO arrD
46.                         IF b(c, r).mine THEN b(c, r).reveal = -1: showCell c, r
47.                     NEXT
48.                 NEXT
49.                 cText xmax / 2, ymax / 2, 72, &HFF000000, "KA - BOOOMMMM!"
50.                 cText xmax / 2 - 4, ymax / 2 - 4, 64, &HFFFF0000, "KA - BOOOMMMM!"
51.                 cText xmax / 2 - 8, ymax / 2 - 8, 56, &HFFFFFF00, "KA - BOOOMMMM!"
52.                 gameOver = -1
53.                 _DELAY 7
54.             ELSE
55.                 b(cc, cr).reveal = -1: showCell cc, cr
56.                 IF b(cc, cr).id = 0 THEN sweepZeros cc, cr
57.             END IF
58.         ELSEIF mbN = 2 THEN
59.             IF b(cc, cr).reveal = 1 THEN
60.                 b(cc, cr).reveal = 0: showCell cc, cr
61.             ELSE
62.                 IF b(cc, cr).reveal = 0 THEN b(cc, cr).reveal = 1: showCell cc, cr
63.             END IF
64.         END IF
65.         IF TFwin THEN
66.             cText xmax / 2, ymax / 2, 80, &HFF001144, "Good Job!"
67.             cText xmax / 2 - 1, ymax / 2 - 2, 80, &HFF000055, "Good Job!"
68.             _DELAY 15
69.             gameOver = -1
70.         END IF
71.         _LIMIT 60
72.     WEND
73.     restart = 1
74. WEND
75.  
76. NoOff:
77. DATA 1,0,0,-1,0,1,-1,-1,-1,0,-1,1
78.  
79. xOff:
80. DATA -1,0,0,-1,0,1,1,-1,1,0,1,1
81.  
82. SUB initialize ()
83.     DIM minesPlaced, rx, ry, x, y, nMines, xoffset!
84.     CLS
85.     restart = 0
86.     REDIM b(0 TO arrD + 1, 0 TO arrD + 1) AS boardType
87.     minesPlaced = 0
88.     WHILE minesPlaced < mines
89.         rx = INT(RND * arrD) + 1: ry = INT(RND * arrD) + 1
90.         IF b(rx, ry).mine = 0 THEN
91.             b(rx, ry).mine = -1: minesPlaced = minesPlaced + 1
92.         END IF
93.     WEND
94.     'count mines amoung the neighbors
95.     FOR y = 1 TO arrD
96.         IF y MOD 2 = 0 THEN xoffset! = .5 * xspacing! ELSE xoffset! = 0
97.         FOR x = 1 TO arrD
98.             IF b(x, y).mine <> -1 THEN 'not already a mine
99.                 '2 sets of neighbors depending if x offset or not
100.                 IF xoffset! > .1 THEN
101.                     nMines = b(x - 1, y).mine + b(x, y - 1).mine + b(x, y + 1).mine
102.                     nMines = nMines + b(x + 1, y - 1).mine + b(x + 1, y).mine + b(x + 1, y + 1).mine
103.                 ELSE
104.                     nMines = b(x + 1, y).mine + b(x, y - 1).mine + b(x, y + 1).mine
105.                     nMines = nMines + b(x - 1, y - 1).mine + b(x - 1, y).mine + b(x - 1, y + 1).mine
106.                 END IF
107.                 b(x, y).id = -nMines
108.             ELSE
109.                 b(x, y).id = 0
110.             END IF
111.             b(x, y).x = x * xspacing! + xoffset! + 5
112.             b(x, y).y = y * yspacing! + 5
113.             b(x, y).reveal = 0
114.             showCell x, y
115.         NEXT
116.     NEXT
117. END SUB
118.  
119. SUB showCell (c, r)
120.     DIM da, x!, y!, lastx!, lasty!, clr AS _UNSIGNED LONG
121.     SELECT CASE b(c, r).reveal
122.         CASE -1: IF b(c, r).mine THEN clr = &HFF883300 ELSE clr = &HFFFFFFFF 'revealed  white with number of mine neighbors
123.         CASE 0: clr = &HFF008800 'hidden green
124.         CASE 1: clr = &HFFFF0000 'marked red
125.     END SELECT
126.     lastx! = b(c, r).x + cellR * COS(_D2R(-30))
127.     lasty! = b(c, r).y + cellR * SIN(_D2R(-30))
128.     FOR da = 30 TO 330 STEP 60
129.         x! = b(c, r).x + cellR * COS(_D2R(da))
130.         y! = b(c, r).y + cellR * SIN(_D2R(da))
131.         LINE (lastx!, lasty!)-(x!, y!), &HFFFF00FF
132.         lastx! = x!: lasty! = y!
133.     NEXT
134.     PAINT (b(c, r).x, b(c, r).y), clr, &HFFFF00FF
135.     IF b(c, r).reveal = -1 THEN
136.         'cText b(c, r).x, b(c, r).y, 15, &HFF000000, _TRIM$(STR$(c)) + "," + _TRIM$(STR$(r))
137.         IF b(c, r).id > 0 THEN cText b(c, r).x, b(c, r).y, 35, &HFF000000, _TRIM$(STR$(b(c, r).id))
138.         IF b(c, r).mine = -1 THEN cText b(c, r).x, b(c, r).y, 35, &HFFFFFFFF, "*"
139.     END IF
140. END SUB
141.  
142. FUNCTION TFwin
143.     DIM c, x, y
144.     FOR y = 1 TO arrD
145.         FOR x = 1 TO arrD
146.             IF b(x, y).reveal = -1 AND b(x, y).mine = 0 THEN c = c + 1
147.         NEXT
148.     NEXT
149.     IF c = arrD * arrD - mines THEN TFwin = -1
150. END FUNCTION
151.  
152. SUB getCell (returnCol AS INTEGER, returnRow AS INTEGER, mbNum AS INTEGER)
153.     DIM m, mx, my, mb1, mb2, r, c
154.     WHILE _MOUSEINPUT: WEND
155.     mb1 = _MOUSEBUTTON(1): mb2 = _MOUSEBUTTON(2)
156.     IF mb1 THEN mbNum = 1
157.     IF mb2 THEN mbNum = 2
158.     IF mb1 OR mb2 THEN '                      get last place mouse button was down
159.         WHILE mb1 OR mb2 '                    wait for mouse button release as a "click"
160.             m = _MOUSEINPUT: mb1 = _MOUSEBUTTON(1): mb2 = _MOUSEBUTTON(2)
161.             mx = _MOUSEX: my = _MOUSEY
162.         WEND
163.         FOR r = 1 TO arrD
164.             FOR c = 1 TO arrD
165.                 IF ((mx - b(c, r).x) ^ 2 + (my - b(c, r).y) ^ 2) ^ .5 < .5 * xspacing! THEN
166.                     returnCol = c: returnRow = r: EXIT SUB
167.                 END IF
168.             NEXT
169.         NEXT
170.         mbNum = 0 'still here then clicked wrong
171.     END IF
172. END SUB
173.  
174. SUB sweepZeros (col, row) ' recursive sweep with Rod's limits set
175.     DIM c, r, d, x, y, id
176.     c = col: r = row 'get copies for recursive sub
177.     FOR d = 0 TO 5
178.         IF r MOD 2 = 0 THEN
179.             x = dxdyNoOff(d, 0) + c: y = dxdyNoOff(d, 1) + r
180.         ELSE
181.             x = dxdyOFF(d, 0) + c: y = dxdyOFF(d, 1) + r
182.         END IF
183.         IF x >= 1 AND x <= arrD AND y >= 1 AND y <= arrD THEN
184.             IF b(x, y).reveal = 0 THEN
185.                 id = b(x, y).id
186.                 IF b(x, y).mine = 0 AND id = 0 THEN
187.                     b(x, y).reveal = -1 'mark played
188.                     showCell x, y
189.                     sweepZeros x, y
190.                 ELSE
191.                     IF b(x, y).mine = 0 AND id >= 1 AND id <= 8 THEN
192.                         b(x, y).reveal = -1
193.                         showCell x, y
194.                     END IF
195.                 END IF
196.             END IF
197.         END IF
198.     NEXT
199. END SUB
200.  
201. 'center the text around (x, y) point, needs a graphics screen!
202. SUB cText (x, y, textHeight, K AS _UNSIGNED LONG, txt$)
203.     DIM fg AS _UNSIGNED LONG, cur&, I&, mult, xlen
204.     fg = _DEFAULTCOLOR
205.     'screen snapshot
206.     cur& = _DEST
207.     I& = _NEWIMAGE(8 * LEN(txt$), 16, 32)
208.     _DEST I&
209.     COLOR K, _RGBA32(0, 0, 0, 0)
210.     _PRINTSTRING (0, 0), txt$
211.     mult = textHeight / 16
212.     xlen = LEN(txt$) * 8 * mult
213.     _PUTIMAGE (x - .15 * xlen, y - .15 * textHeight)-STEP(.33 * xlen, .33 * textHeight), I&, cur&
214.     COLOR fg
215.     _FREEIMAGE I&
216. END SUB