OPTION _EXPLICIT 'Bplus started 2019-08-08 from quick version of Hex Minesweeper and Minesweeper Custom Field ' 2021-01-19 update move all ogg files into separate sub folder for Windows users
'============================================================================================================
'
' Hex Minesweeper v3.1W: Field Customization, Sound Effects and mod Crater Maker!
'
' bplus mod 2021-01-19
'=============================================================================================================
' 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.
' 2019-08-13 Hex Minesweeper Custom and Sound.bas add ogg file sound effects
' Public domain .ogg files source
' https://bigsoundbank.com/detail-0029-computer-mouse.html
' and bomb #6: https://www.mediacollege.com/downloads/sound-effects/explosion/
'2020-02-09 adding Crater Maker effect I devloped for SmallBASIC 2020-02-08 should work even better with QB64.
' It does indeed!!!!
'
'2020-02-10 refined Crater Maker to scale to board size and Bombsound time of blast
'
'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
'sound events
_TITLE "Hexagon Minesweeper v3.1W: Customize, Sound Effects and now Crater Maker" ogg$ = "Ogg Files\"
ToggleSnd
= _SNDOPEN(ogg$
+ "Toggle.ogg")openSnd
= _SNDOPEN(ogg$
+ "Ticking.ogg")ApplauseSnd
= _SNDOPEN(ogg$
+ "Applause sm.ogg")SwooshSnd
= _SNDOPEN(ogg$
+ "Flyby.ogg")'_SNDPLAY SwooshSnd: IF SwooshSnd = 0 THEN PRINT " not loaded." ELSE PRINT "OK loaded.": END
'rnd reveal sounds
rndSnd
(0) = _SNDOPEN(ogg$
+ "357 shot.ogg")rndSnd
(1) = _SNDOPEN(ogg$
+ "alarm.ogg")rndSnd
(2) = _SNDOPEN(ogg$
+ "Apple bite.ogg")rndSnd
(3) = _SNDOPEN(ogg$
+ "Barkings.ogg")rndSnd
(5) = _SNDOPEN(ogg$
+ "brake.ogg")rndSnd
(6) = _SNDOPEN(ogg$
+ "bumble bee.ogg")rndSnd
(7) = _SNDOPEN(ogg$
+ "creaking.ogg")rndSnd
(8) = _SNDOPEN(ogg$
+ "crows.ogg")rndSnd
(10) = _SNDOPEN(ogg$
+ "dinggg.ogg")rndSnd
(11) = _SNDOPEN(ogg$
+ "Donkey.ogg")rndSnd
(12) = _SNDOPEN(ogg$
+ "elec phone.ogg")rndSnd
(13) = _SNDOPEN(ogg$
+ "Fill mug.ogg")rndSnd
(14) = _SNDOPEN(ogg$
+ "goat.ogg")rndSnd
(16) = _SNDOPEN(ogg$
+ "Horse.ogg")rndSnd
(17) = _SNDOPEN(ogg$
+ "Kids.ogg")rndSnd
(18) = _SNDOPEN(ogg$
+ "M scream.ogg")rndSnd
(19) = _SNDOPEN(ogg$
+ "Male Hilarious.ogg")rndSnd
(20) = _SNDOPEN(ogg$
+ "Marimba.ogg")rndSnd
(21) = _SNDOPEN(ogg$
+ "neighing.ogg")rndSnd
(22) = _SNDOPEN(ogg$
+ "polaris ring.ogg")rndSnd
(23) = _SNDOPEN(ogg$
+ "pull top can.ogg")rndSnd
(24) = _SNDOPEN(ogg$
+ "Punch line drum.ogg")rndSnd
(25) = _SNDOPEN(ogg$
+ "Ring 2.ogg")rndSnd
(26) = _SNDOPEN(ogg$
+ "Rooster.ogg")rndSnd
(27) = _SNDOPEN(ogg$
+ "Unlock door.ogg")rndSnd
(28) = _SNDOPEN(ogg$
+ "whook.ogg")'DIM i 'test load and sounds
'FOR i = 10 TO 28
' _SNDPLAY (rndSnd(i))
' PRINT i;
' IF rndSnd(i) = 0 THEN PRINT i; " not loaded." ELSE PRINT
' _DELAY 2
'NEXT
'END
customField
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
, s$
, sz!
_TITLE _TRIM$(STR$(Yarrd
* Xarrd
- mines
)) + " Cells to Free Instructions: Left click Reveals, Right Marks Red" restart = 1
gameOver = 0
mbN = 0
getCell cc, cr, mbN
IF b
(cc
, cr
).mine
THEN 'ka boom makeCrater cc, cr
's$ = "KA - BOOOMMMM!" 'comment out since post code
'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
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
SUB makeCrater
(col
, row
)
DIM nP
, r
, c
, a!
, i
, ra!
, red!
, j
, stopper
nP = 25 * Xarrd * Yarrd
_DELAY .500 'need a fairly long delay before actually hear sound LINE (0, 0)-(xmax
, ymax
), &HFFFFFFFF, BF
FOR r
= 1 TO Yarrd
'show all mines IF b
(c
, r
).mine
THEN b
(c
, r
).reveal
= -1 showCell c, r
a!
= _ATAN2(b
(c
, r
).y
- b
(col
, row
).y
, b
(c
, r
).x
- b
(col
, row
).x
) b
(c
, r
).dx
= .005 * Xarrd
* Yarrd
* COS(a!
) b
(c
, r
).dy
= .005 * Xarrd
* Yarrd
* SIN(a!
) p
(i
).x
= b
(col
, row
).x
+ RND * 2 * cellR
- cellR
p
(i
).y
= b
(col
, row
).y
+ RND * 2 * cellR
- cellR
p
(i
).dx
= .09 * Xarrd
* Yarrd
/ p
(i
).sz
* COS(ra!
) p
(i
).dy
= .09 * Xarrd
* Yarrd
/ p
(i
).sz
* SIN(ra!
) p
(i
).c
= _RGB32(red!
, .5 * red!
+ .1 * red!
* RND - .05 * red!
, .25 * red!
+ .05 * red!
* RND - .025 * red!
) stopper = .5 * nP 'orig .3
FOR i
= 1 TO 170 'make a Crater!!! maybe runs to long try 70 from original post 270 FOR r
= 1 TO Yarrd
'redraw board with cells moved b(c, r).dx = .9 * b(c, r).dx
b(c, r).dy = .9 * b(c, r).dy
b(c, r).x = b(c, r).x + b(c, r).dx
b(c, r).y = b(c, r).y + b(c, r).dy
showCell c, r
fcirc p(j).x, p(j).y, p(j).sz, p(j).c
LINE (p
(j
).x
- .5 * p
(i
).sz
, p
(j
).y
- .5 * p
(j
).sz
)-STEP(p
(j
).sz
, p
(j
).sz
), p
(j
).c
, BF
p(j).x = p(j).x + p(j).dx
p(j).y = p(j).y + p(j).dy
p(j).dx = .97 * p(j).dx ' original post .992
p(j).dy = .97 * p(j).dy
IF i
< 70 THEN stopper
= stopper
+ 80 ' ELSE stopper = stopper + 1 IF stopper
> nP
THEN stopper
= nP
'set all these 'DIM SHARED xmax, ymax, XarrD, YarrD, mines
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 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 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$
'from Steve Gold standard
Radius
= ABS(R
): RadiusError
= -Radius: X
= Radius: Y
= 0 LINE (CX
- X
, CY
)-(CX
+ X
, CY
), C
, BF
RadiusError = RadiusError + Y * 2 + 1
LINE (CX
- Y
, CY
- X
)-(CX
+ Y
, CY
- X
), C
, BF
LINE (CX
- Y
, CY
+ X
)-(CX
+ Y
, CY
+ X
), C
, BF
X = X - 1
RadiusError = RadiusError - X * 2
Y = Y + 1
LINE (CX
- X
, CY
- Y
)-(CX
+ X
, CY
- Y
), C
, BF
LINE (CX
- X
, CY
+ Y
)-(CX
+ X
, CY
+ Y
), C
, BF
