OPTION _EXPLICIT 'Bplus started 2019-08-08 from quick version of Hex Minesweeper and Minesweeper Custom Field ' Attention: this program creates a file: "Hexagon Minefield Custom Specs.txt"
' that you edit with your text editor, if you select that option in the opening screen menu.
'to make things easy set cellR as const at 25
CONST cellR
= 25 ' which makes the following constant xspacing!
= 2 * cellR
* COS(_D2R(30)): yspacing!
= cellR
* (1 + SIN(_D2R(30)))
DIM SHARED xmax
, ymax
, Xarrd
, Yarrd
, mines
'set all this in customField sub _TITLE "Hexagon Minesweeper: Custom Field" customField
_TITLE STR$(mines
) + " Minesweeper: left click reveals, right marks red" reveal
AS INTEGER ' 1 for marked, 0 hidden, -1 for revealedREDIM SHARED b
(0 TO Xarrd
+ 1, 0 TO Yarrd
+ 1) AS boardType
'oversize the board to make it easy to count mines DIM gameOver
, cc
, cr
, mbN
, c
, r
, s$
, sz!
restart = 1
gameOver = 0
mbN = 0
getCell cc, cr, mbN
'LOCATE 1, 1: PRINT cc, cr, mbN
IF b
(cc
, cr
).mine
THEN 'ka boom FOR r
= 1 TO Yarrd
'show all mines IF b
(c
, r
).mine
THEN b
(c
, r
).reveal
= -1: showCell c
, r
s$ = "KA - BOOOMMMM!"
sz!
= 1.2 * xmax
/ LEN(s$
) cText xmax / 2, ymax / 2, sz!, &HFF000000, s$
cText xmax / 2 - 4, ymax / 2 - 4, sz!, &HFFFF0000, s$
cText xmax / 2 - 8, ymax / 2 - 8, sz!, &HFFFFFF00, s$
gameOver = -1
b(cc, cr).reveal = -1: showCell cc, cr
IF b
(cc
, cr
).id
= 0 THEN sweepZeros cc
, cr
b(cc, cr).reveal = 0: showCell cc, cr
IF b
(cc
, cr
).reveal
= 0 THEN b
(cc
, cr
).reveal
= 1: showCell cc
, cr
s$ = "Good Job!"
sz!
= 1.2 * xmax
/ LEN(s$
) cText xmax / 2, ymax / 2, sz!, &HFF000000, s$
cText xmax / 2 - 1, ymax / 2 - 2, sz!, &HFF000055, s$
gameOver = -1
restart = 1
NoOff:
DATA 1,0,0,-1,0,1,-1,-1,-1,0,-1,1
xOff:
DATA -1,0,0,-1,0,1,1,-1,1,0,1,1
'set all this 'DIM SHARED xmax, ymax, Xsq, Ysq, XarrD, YarrD, mines, Xmargin, Ymargin
DIM fName$
, fe
, fLine$
, p
, inCnt
, beenHere
, allow$
, choice$
fName$ = "Hexagon Minefield Custom Specs.txt"
PRINT " Hexagom Minesweeper options:" PRINT " 1. Use mine field settings: 10 X 10 cells and 10 mines." PRINT " 2. Customize your own field settings." IF fe
THEN PRINT " 3. Use the last customized mine field settings.": allow$
= allow$
+ "3" PRINT " or press esc to quit." choice$ = getChar$(allow$)
CASE "1": xmax
= 800: ymax
= 600: Xarrd
= 10: Yarrd
= 10: mines
= 10 xmax = (Xarrd + 2.5) * xspacing!: ymax = (Yarrd + 2) * yspacing!
editCustom:
PRINT #1, " Custom Field Specs For Your Hexagon Minesweeper Game" PRINT #1, " We will be sizing the screen according to a constant cell radius of 25" PRINT #1, " and then numbers filled in here." PRINT #1, " Please fill out the right side of all Equal signs." PRINT #1, " X dimensions across the screen:" PRINT #1, " Your Max Screen Width (pixels) = " PRINT #1, " Number of Horizontal Cells Across = " PRINT #1, " Y dimensions going down:" PRINT #1, " Your Max Screen Height (pixels) = " PRINT #1, " Number of Cells Down = " PRINT #1, "The percent of mines (8 easy - 15 hard) = " PRINT #1, " To finish, Save the file and then close the editor." ' I picked up this shortcut from Ken, normally I would call a text editor that I don't know if you have!
loadCustom:
beenHere = beenHere + 1 'we'll give it 5 tries
PRINT "OK we tried 5 times, going with default settings..." xmax = 800: ymax = 600: Xarrd = 10: Yarrd = 10: mines = 10
inCnt = 0
WHILE EOF(1) = 0 ' look to get 5 values from 5 = signs 'PRINT fLine$
inCnt = inCnt + 1
CASE 1: xmax
= VAL(rightOf$
(fLine$
, "=")) CASE 2: Xarrd
= VAL(rightOf$
(fLine$
, "=")) CASE 3: ymax
= VAL(rightOf$
(fLine$
, "=")) CASE 4: Yarrd
= VAL(rightOf$
(fLine$
, "=")) CASE 5: mines
= VAL(rightOf$
(fLine$
, "=")) * Xarrd
* Yarrd
/ 100 IF inCnt
= 5 THEN 'alternate exit from gosub IF xmax
>= (Xarrd
+ 2.5) * xspacing!
THEN IF ymax
< (Yarrd
+ 2) * yspacing!
THEN 'all good PRINT "Opps, Screen height is not big enough for Y cells down." PRINT "Opps, Screen width is not big enough for X cells across." PRINT "We did not get everything filled out by = signs."
DIM minesPlaced
, rx
, ry
, x
, y
, nMines
, xoffset!
restart = 0
minesPlaced = 0
WHILE minesPlaced
< mines
b(rx, ry).mine = -1: minesPlaced = minesPlaced + 1
'count mines amoung the neighbors
IF b
(x
, y
).mine
<> -1 THEN 'not already a mine '2 sets of neighbors depending if x offset or not
nMines = b(x - 1, y).mine + b(x, y - 1).mine + b(x, y + 1).mine
nMines = nMines + b(x + 1, y - 1).mine + b(x + 1, y).mine + b(x + 1, y + 1).mine
nMines = b(x + 1, y).mine + b(x, y - 1).mine + b(x, y + 1).mine
nMines = nMines + b(x - 1, y - 1).mine + b(x - 1, y).mine + b(x - 1, y + 1).mine
b(x, y).id = -nMines
b(x, y).id = 0
b(x, y).x = x * xspacing! + xoffset! + .5 * xspacing!
b(x, y).y = y * yspacing! + .5 * yspacing!
b(x, y).reveal = 0
showCell x, y
CASE -1:
IF b
(c
, r
).mine
THEN clr
= &HFF883300 ELSE clr
= &HFFFFFFFF 'revealed white with number of mine neighbors CASE 0: clr
= &HFF008800 'hidden green CASE 1: clr
= &HFFFF0000 'marked red lastx!
= b
(c
, r
).x
+ cellR
* COS(_D2R(-30)) lasty!
= b
(c
, r
).y
+ cellR
* SIN(_D2R(-30)) x!
= b
(c
, r
).x
+ cellR
* COS(_D2R(da
)) y!
= b
(c
, r
).y
+ cellR
* SIN(_D2R(da
)) LINE (lastx!
, lasty!
)-(x!
, y!
), &HFFFF00FF lastx! = x!: lasty! = y!
PAINT (b
(c
, r
).x
, b
(c
, r
).y
), clr
, &HFFFF00FF 'cText b(c, r).x, b(c, r).y, 15, &HFF000000, _TRIM$(STR$(c)) + "," + _TRIM$(STR$(r))
IF b
(c
, r
).id
> 0 THEN cText b
(c
, r
).x
, b
(c
, r
).y
, 35, &HFF000000, _TRIM$(STR$(b
(c
, r
).id
)) IF b
(c
, r
).mine
= -1 THEN cText b
(c
, r
).x
, b
(c
, r
).y
, 35, &HFFFFFFFF, "*"
IF b
(x
, y
).reveal
= -1 AND b
(x
, y
).mine
= 0 THEN c
= c
+ 1 IF c
= Xarrd
* Yarrd
- mines
THEN TFwin
= -1
DIM m
, mx
, my
, mb1
, mb2
, r
, c
IF mb1
OR mb2
THEN ' get last place mouse button was down WHILE mb1
OR mb2
' wait for mouse button release as a "click" IF ((mx
- b
(c
, r
).x
) ^ 2 + (my
- b
(c
, r
).y
) ^ 2) ^ .5 < .5 * xspacing!
THEN returnCol
= c: returnRow
= r:
EXIT SUB mbNum = 0 'still here then clicked wrong
SUB sweepZeros
(col
, row
) ' recursive sweep with Rod's limits set DIM c
, r
, cMin
, cMax
, rMin
, rMax
, x
, y
, id
c = col: r = row 'get copies for recursive sub
IF c
< Xarrd
- 1 THEN cMax
= c
+ 1 ELSE cMax
= Xarrd
IF r
< Yarrd
- 1 THEN rMax
= r
+ 1 ELSE rMax
= Yarrd
id = b(x, y).id
b(x, y).reveal = -1 'mark played
showCell x, y
sweepZeros x, y
b(x, y).reveal = -1
showCell x, y
'center the text around (x, y) point, needs a graphics screen!
'screen snapshot
mult! = textHeight / 16
xlen
= LEN(txt$
) * 8 * mult!
_PUTIMAGE (x
- .5 * xlen
, y
- .5 * textHeight
)-STEP(xlen
, textHeight
), I&
, cur&
getChar$ = k$
