They got this cool new thing on Windows 3.11, it's called MineSweeper and it's absolutely crazy. MineSweeper is a logic game in which you are tasked with revealing all the tiles of a mine field without ever stepping on a landmine.
The field is a collection of cells organized in a two-dimensional grid. Each cell has two attributes: a numeric value that holds the number of mines located nearby (if any) or a special code that signifies the cell is a mine. The second attribute is sort of a display setting we'll call "cell status" (or "cStat" for short.) It tells us whether or not the cell has been revealed, or if the player put a flag (if he thinks there's a mine there) or question mark (to remember there could be a mine) on it.
To keep things tightly packed, we're going to place both attributes into one INTEGER and use some masking to access the data. The low nibble (4 bits) will contain 0 if there are no mines nearby, a number between 1 and 8 if there are some mines nearby, or 9 if the cell itself is a mine (since we cannot reveal mines, there's no point in keeping track of the number of neighboring mines.) The high nibble will just contain a series a bitflags so we know how it should be displayed on screen.
Let's setup some shared variables for the field dimensions (in cells,) as well as the total number of mines, and of course a simple one-dimensional array to hold the whole field:
CONST CellCounterMask = &HF ' Cell counter mask. CONST CellIsMine = 9 ' Counter code for "mine." CONST cStatClear = &H10 ' Player put a flag on this cell. CONST cStatMaybe = &H20 ' Player put a question mark on this cell. CONST cStatReveal = &H40 ' This cell is uncovered. CONST MaxFieldSize = 256 ' Maximum field size, in cells. DIM SHARED gField(MaxFieldSize - 1) AS INTEGER ' Field data. DIM SHARED gFieldW AS INTEGER ' Field width, in cells. DIM SHARED gFieldH AS INTEGER ' Field height, in cells. DIM SHARED gNumCells AS INTEGER ' Total number of cells (gFieldW * gFieldH.) DIM SHARED gNumMines AS INTEGER ' Number of mines. DIM SHARED gNumClear AS INTEGER ' Number of cells cleared.
Accessing the cell's status (in the high nibble) is straighforward: we simply use the AND boolean operator with one of the bitflags we defined (let's say "cStatReveal") and see if the result is not NULL:
IF (gField(16) AND cStatReveal) THEN PRINT "Cell number 16 is revealed" ELSE PRINT "Cell number 16 is still covered" END IF
We can also use the OR boolean operator to set a bitflag. For instance, if we want to reveal the entirety of the field, we just:
DECLARE SUB fieldRevealAll ()
''
'' REVEAL THE WHOLE FIELD
''
SUB fieldRevealAll
FOR i% = 0 TO gNumCells - 1
gField(i%) = gField(i%) OR cStatReveal
NEXT i%
END SUB
To determine the number of mines nearby (or if the cell itself is a mine,) we mask the 4 least significant bits with CellCounterMask:
counter% = (gField(t%) AND CellCounterMask) SELECT CASE counter% CASE 0 PRINT "There no mine nearby"; t% CASE 1 TO 8 PRINT "There is/are"; counter%; "mine(s) near cell"; t% CASE CellIsMine PRINT "Cell"; t%; "is a mine!" END SELECT
We're off to a good start.
It may seem a little premature to write the drawing routine, but Minesweeper is not a complex game and we already have all the data we need to display the field... so let's do it!
First, we're going to reserve an array to store DRAW instructions we can use to write the number of mines nearby, then we go through each cell, one by one, and draw a rectangle at the proper place. Depending on the cell's status, we either write the number of mines nearby, a mine, or an emboss if the cell is still covered.
We're going to use Mode 13 (320x200 and 256 colors) for this. If you want to use a high resolution mode like Mode 13 (640x480 and 16 colors,) modify the constants "cellW" and "cellH" to draw bigger cells ("cellHalfW" and "cellHalfH" will automatically adjust themselves.)
CONST cellW = 10 ' Width of a cell, in pixels
CONST cellH = 10 ' Height of a cell, in pixels
CONST cellHalfW = cellW \ 2 ' Half the width, in pixels
CONST cellHalfH = cellH \ 2 ' Half the height, in pixels
DECLARE SUB renderField (x AS INTEGER, y AS INTEGER)
SCREEN 13
''
'' DRAW THE WHOLE FIELD AT X,Y
''
SUB renderField (x AS INTEGER, y AS INTEGER)
DIM ofsX AS INTEGER, ofsY AS INTEGER
DIM cellOfs AS INTEGER, cellIndex AS INTEGER
DIM digit(7) AS STRING
' Digit drawing codes (there can be up to 8 mines around)
digit(0) = "c1 bm+0,1ed3gr2" ' 1: blue
digit(1) = "c2 rfg2dr2" ' 2: green
digit(2) = "c4 rfgfgl" ' 3: red
digit(3) = "c1 d2r2gd" ' 4: blue
digit(4) = "c4 bm+2,0l2d2rfgl" ' 5: red
digit(5) = "c3 bm+2,0lgd3r2u2l" ' 6: cyan
digit(6) = "c0 r2dgd2" ' 7: black
digit(7) = "c8 r2dg2dr2uh2" ' 8: gray
' Draw tiles surface (light gray)
LINE (x, y)-STEP(gFieldW * cellW - 1, gFieldH * cellH - 1), 7, BF
' For each row...
FOR r% = 0 TO gFieldH - 1
' Get the drawing offset
ofsY = y + r% * cellH
' Get the index of the 1st cell of the row
cellOfs = r% * gFieldW
' For each column...
FOR c% = 0 TO gFieldW - 1
' Get the drawing offset
ofsX = x + c% * cellW
' Compute the full cell index
cellIndex = cellOfs + c%
' If the cell is revealed...
IF (gField(cellIndex) AND cStatReveal) THEN
' Get the counter value
cnt = gField(cellIndex) AND CellCounterMask
SELECT CASE cnt
' There are between 1 and 8 mines nearby, draw number
CASE 1 TO 8
DRAW "bm" + STR$(ofsX + cellHalfW - 2) + _
"," + STR$(ofsY + cellHalfH - 3) + digit(cnt - 1)
' The cell itself is a mine
CASE 9
CIRCLE (ofsX + cellHalfW - 1, ofsY + cellHalfH - 1), cellH \ 3, 0
PAINT (ofsX + cellHalfW - 1, ofsY + cellHalfH - 1), 0
END SELECT
' The cell is still covered...
ELSE
' Draw emboss
LINE (ofsX, ofsY + (cellH - 2))-STEP(0, -(cellH - 2)), 15
LINE -STEP((cellW - 2), 0), 15
LINE (ofsX + (cellW - 1), ofsY + 1)-STEP(0, (cellH - 2)), 8
LINE -STEP(-(cellW - 2), 0), 8
' The player put a flag on it
IF (gField(cellIndex) AND cStatClear) THEN
draw "bm " + str$(ofsX + 3) + "," + str$(ofsY + 7) + " c0r2h1u4r1 c4r1h-1l2d1r1"
' The player put a question mark on it
ELSEIF (gField(cellIndex) AND cStatMaybe) THEN
draw "bm " + str$(ofsX + 3) + "," + str$(ofsY + 3) + " c0u1r3d1g2 bm+0,+2 r0"
END IF
END IF
NEXT c%
NEXT r%
END SUB
You'll notice that the routine takes two INTEGERs to place the top-left corner of the field on the screen; I thought it would be handy if we want to center the field:
DIM scrX AS INTEGER, scrY AS INTEGER ' Compute on-screen vertical and horizontal ' position, center the field on the screen. scrX = ((320 - cellW * gFieldW) \ 2) ' Set to 640 for mode 12 scrY = ((200 - cellH * gFieldH) \ 2) ' Set to 480 for mode 12 renderField scrX, scrY
It's just super handy. Speaking of handy...
We need a routine to get the address of adjacent cells! It's going to be useful when we count neighboring mines but also when we start revealing tiles after a click.
Computing the index of neighbors is trivial (decrease the index of the master cell by the width of the board and you get the cell directly on top, increase the value to get the cell below, etc...) but making sure that the index is actually valid is something else. For instance, if we compute the index of cells located above the very 1st row, we'll get invalid values reaching outside the boundaries of the field. So how do we determine which indices are correct and which are not? We could use a few conditional branchings with SELECT CASE or IF, but we could also go for something slightly fancier.
You may remember that the 16-bit INTEGER value -1 is represented as 11111111 11111111 in binary. The opposite value, 0, is represented as 00000000 00000000. So far so good. Now, you may also remember that the OR boolean operator returns a value that includes all the bits that are set in either operands:
00000100 00001111 OR 11110010 11110011 = 11110110 11111111
It means that "-1 OR 0" returns -1:
11111111 11111111 OR 00000000 00000000 = 11111111 11111111
In fact, "-1 OR anything" always return -1. Do you also remember that when evaluating an expression, QuickBASIC returns either -1 for TRUE or 0 for FALSE? I think we're onto something here:
If we evaluate the expression "y <= 0" and Y is indeed 0 or less (that is, Y points to the topmost row of the field,) then we'll obtain -1 (or TRUE.) But if Y is greater than 0 (which implies there IS a row located above that Y location,) then we'll obtain 0 (or FALSE.) If we do the same for "y >= gFieldH - 1," "x <= 0," and "x >= gFieldW - 1," then we obtain masks that can turn any value into -1 if the index is out of reach, or do absolutely nothing if the index is located inside the field.
From there, all we have to do is calculate the cell index and use the boolean operator OR. The result is returned in an easy-to-manage 8-INTEGER long array:
DECLARE SUB getNearbyCells (x AS INTEGER, y AS INTEGER, adrLst() AS INTEGER) '' '' THIS ROUTINE TAKES AN 8-INTEGER ARRAY AND FILLS IT '' WITH THE INDICES OF NEIGHBORING CELLS. IF THE CELL '' DOES NOT EXIST (LOCATED OUTSIDE THE AREA,) THEN ITS '' INDEX NUMBER IS SET TO -1. '' SUB getNearbyCells (x AS INTEGER, y AS INTEGER, adrLst() AS INTEGER) DIM maskLf AS INTEGER, maskRt AS INTEGER DIM maskUp AS INTEGER, maskDn AS INTEGER DIM index AS INTEGER, baseId AS INTEGER ' Get the vertical and horizontal masks. If the coordinate is located on the ' first or last row/column, then the mask is set to -1. Next, we're going to ' compute the index of the cell and apply the mask with the OR operator. If ' the mask is -1, the end result is -1. If the mask is 0, the end result is ' the index of the cell. In other words, any cell index that falls outside ' the field is represented as -1. maskLf = (x <= 0): maskRt = (x >= gFieldW - 1) maskUp = (y <= 0): maskDn = (y >= gFieldH - 1) ' Get the index of the selected cell baseId = x + y * gFieldW ' Top row index = baseId - gFieldW adrLst(0) = (index - 1) OR maskUp OR maskLf adrLst(1) = index OR maskUp adrLst(2) = (index + 1) OR maskUp OR maskRt ' Center row adrLst(3) = (baseId - 1) OR maskLf adrLst(4) = (baseId + 1) OR maskRt ' Bottom row index = baseId + gFieldW adrLst(5) = (index - 1) OR maskDn OR maskLf adrLst(6) = index OR maskDn adrLst(7) = (index + 1) OR maskDn OR maskRt END SUB
Don't you hate it when you click a random cell on a 20x20 board and step on the only mine on the board? Some Minesweeper games prevent that by moving the mine to the first empty cell available (usually in the top left corner of the field.) While it's a nice touch, I'd like to go further and make a 3x3 mine-free zone centered on the first click, so that the player can get some information about possible mines nearby.
First, let's write a routine to initialize the field, place the mines (while making sure the player did not trigger one on his first turn,) and update the counter of each cell so we know how many mines are adjacent. This routine only needs to be called ONCE right after the VERY FIRST click of the game (at that point, gNumClear equals 0.)
DECLARE SUB fieldInit (cellId AS INTEGER) '' '' INITIALIZE FIELD, CALLED ONCE BEFORE PROCESSING THE 1ST CLICK. '' "CELLID" IS THE INDEX OF THE CELL THE PLAYER CLICKED. '' SUB fieldInit (cellId AS INTEGER) ' Place mines at random fieldPopulate ' Move mines triggered by the player fieldSafeClick cellId ' Reset mine counter of each cell fieldNearMines END SUB
Alright. So, how do we place mines in the field? We could (and I do mean "could") loop indefinitely, picking cells at random and adding mines (if the cell doesn't contain one already) until we got the requested number. Let's call that technique "Method A:"
DECLARE SUB fieldPopulate ()
''
'' PLACE MINES AT RANDOM, THE WORST WAY POSSIBLE
''
SUB fieldPopulate
DIM count AS INTEGER, index AS INTEGER
count = gNumMines
DO
' Take a cell at random
index = INT(RND * gNumCells)
' If the cell doesn't contain a mine...
IF ((gField(index) AND CellCounterMask) <> CellIsMine) then
' ... add it now.
gField(index) = gField(index) OR CellIsMine
' Decrease mine counter.
count = count - 1
END IF
LOOP WHILE (count)
END SUB
...it works but it's a bit clumsy. Here are two other options I like better.
Method B: first, we reset all cells, and then fill the first gNumMines cells with mines. Then we go through each cell again and swap them at random. It's easy to understand, but we can do better.
DECLARE SUB fieldPopulate ()
''
'' PLACE MINES AT RANDOM
''
SUB fieldPopulate
' Insert mines
FOR t% = 0 TO gNumMines - 1
gField(t%) = CellIsMine
NEXT t%
' Clear the rest of the field
FOR t% = gNumMines TO gNumCells - 1
gField(t%) = 0
NEXT t%
' Shuffle at random
FOR t% = 0 TO gNumCells - 1
SWAP gField(t%), gField(INT(RND * gNumCells))
NEXT t%
END SUB
Method C: this time, we're going to do it in a single pass! We compute the ratio between the number of mines remaining and the number of cells left in the field. That value is 0 when there is no mine left to place, 1 when the number of mines to place is equal to the number of cells left in the field, or anything in-between if there are some mines left to place. We then compare this ratio to RND (this function returns a pseudo-random decimal value between 0 included and 1 excluded) to determine whether or not a mine should be placed.
DECLARE SUB fieldPopulate ()
''
'' PLACE MINES AT RANDOM
''
SUB fieldPopulate
DIM remain AS INTEGER
' Number of mines left to place
remain = gNumMines
' Go through the whole field
FOR t% = 0 TO gNumCells - 1
' The ratio system balances the odds itself. It's pretty neat.
IF (RND < (remain / (gNumCells - t%))) THEN
gField(t%) = CellIsMine
remain = remain - 1
ELSE
gField(t%) = 0
END IF
NEXT t%
END SUB
For the most skeptical out there, here's how it works: if we get God-awful RNG and the loop consistently fails to place mines, eventually the number of mines left to place equals the number of cells left to parse, producing a ratio of 1. Since RNG is always less than 1, it is guaranteed that all remaining cells are mines. But what if we have such RNG that the loop has been continuously placing mines? It will run out of mines, produce a ratio of 0, and because RNG is never less than 0, no more mine will be added.
TL;DR: it is mathematically impossible for this formula to place too many or too few mines, and thus it's bound to provide just the right amount every time.
Now is the time to move mines that the player has unearthed on the very first click. It's pretty straightforward: we test the cell that was clicked by the player and its direct neighbors. For each cell containing a mine, we remove it and increase a counter. We also tag those cells as a "safe zone" so we don't put the mines back there (just in case the player clicked the top left cell for instance.) Then we go back to the very first cell in the top left. If the cell doesn't already contain a mine and it is not tagged as "safe," insert the mine, decrease the counter and move to the next cell. Keep going until the counter reaches zero.
CONST cStatIsSafe = &H80 ' Can't move mine here.
DECLARE SUB fieldSafeClick (cellId AS INTEGER)
''
'' MOVE MINES ADJACENT TO THE PROVIDED CELL INDEX ELSEWEHRE.
''
SUB fieldSafeClick (cellId AS INTEGER)
DIM x AS INTEGER, y AS INTEGER, near(7) AS INTEGER
DIM index AS INTEGER, move AS INTEGER
' Get list of nearby cells
x = cellId MOD gFieldW
y = cellId \ gFieldW
getNearbyCells x, y, near()
' There's a mine in the master cell (the one the player just clicked)
IF ((gField(cellId) AND CellCounterMask) = CellIsMine) then
' Remove it
gField(cellId) = 0
' Increment the number of mines we have to move
move = move + 1
END IF
' We cannot place a mine on this cell
gField(cellId) = gField(cellId) OR cStatIsSafe
' Parse every neighbor
FOR i% = 0 TO 7
index = near(i%)
' This tile exists
IF (index <> -1) THEN
' It contains a mine
IF ((gField(index) AND CellCounterMask) = CellIsMine) THEN
' Remove it
gField(index) = 0
' Increment the number of mines we have to move
move = move + 1
END IF
' We cannot place a mine on this cell
gField(index) = gField(index) OR cStatIsSafe
END IF
NEXT i%
' Move mines top the top left corner of the board
index = 0
WHILE (move)
' The cell is not locked and doesn't have any mine, move one here
IF (((gField(index) AND cStatIsSafe) = 0) AND (gField(index) = 0)) THEN
gField(index) = CellIsMine
move = move - 1
END IF
' Test the next tile
index = index + 1
WEND
END SUB
The field has been initialized, all mines are placed and a safe zone has been defined... however, we're not done just yet. Before going for the big reveal we have to initialize the "nearby mines" counter of each cell.
Rather than checking all 8 neighbors of every cell for mines, we're going to look for mines only, and then increment by 1 the counter of each adjacent cell that doesn't contain a mine.
DECLARE SUB fieldNearMines ()
''
'' UPDATE NEARBY MINES COUNTERS
''
SUB fieldNearMines
DIM rowId AS INTEGER, near(7) AS INTEGER
' For each row, ...
FOR r% = 0 TO gFieldH - 1
' Get the address of the 1st cell of the row
rowId = r% * gFieldW
' For each column, ...
FOR c% = 0 TO gFieldW - 1
' This cell contains a mine, update neighbors mine counter
IF ((gField(rowId + c%) AND CellCounterMask) = CellIsMine) THEN
' Get list of nearby cells
getNearbyCells c%, r%, near()
' Go through the neighbor list
FOR i% = 0 TO 7
' This is a valid cell index
IF (near(i%) <> -1) THEN
' Increment the mine counter if the cell doesn't contain a mine
gField(near(i%)) = gField(near(i%)) - (gField(near(i%)) <> CellIsMine)
END IF
NEXT i%
END IF
NEXT c%
NEXT r%
END SUB
We don't really need to use a span-filling Flood fill algorithm but we should, in the very least, try to come up with a non-recursive (iterative) routine. For those who arrived late, a recursive routine is a routine that invokes itself ("I like my coffee like I like my coffee: recursive.")
Recursions are easy to write (because they don't actually need any adjustement to the routine,) but they're slower to process because function/routine calls are not cheap. They also consume much more memory than non-recursive routines and in this specific case, they may crash the application with a "out of stack space" error when processing large boards.
The iterative function we're going to write will maintain a list of cells that must be processed. At first, the list only contains one cell (the one the player clicked.) Then we enter a loop that reads the last entry of the list and discards it (by simply decreasing the list length.) The code inside the loop tests nearby cells and may append them to the list if they satisfy two conditions:
1. They are not yet part of the list.
2. They are not tagged for reveal.
The loop ends when the list is empty.
CONST cStatQueued = &H100 ' Cell queued for reveal.
DECLARE FUNCTION fieldReveal% (x AS INTEGER, y AS INTEGER)
''
'' REVEAL CELLS STARTING WITH THE ONE LOCATED AT X,Y. THIS
'' FUNCTION RETURNS THE TOTAL NUMBER OF CELLS REVEALED OR
'' -1 IF THE PLAYER DUG UP A MINE. THE ROUTINE IS ITERATIVE
'' RATHER THAN RECURSIVE (IT MAINTAINS A LIST OF CELLS TO
'' PROCESS RATHER THAN CALL ITSELF OVER AND OVER AGAIN.)
''
FUNCTION fieldReveal% (x AS INTEGER, y AS INTEGER)
DIM cell(MaxFieldSize - 1) AS INTEGER ' Reveal queue
DIM numCells AS INTEGER ' Reveal queue size
DIM index AS INTEGER ' Convenience variable: cell index
DIM near(7) AS INTEGER ' Indices of adjacent cells
' Get cell index
index = x + y * gFieldW
' Cell is revealed or is protected by a flag/question mark, abort.
IF (gField(index) AND (cStatClear OR cStatMaybe OR cStatReveal)) THEN
fieldReveal% = 0
EXIT FUNCTION
END IF
' Cell is a mine, game over.
IF ((gField(index) AND CellCounterMask) = CellIsMine) THEN
fieldReveal% = -1
EXIT FUNCTION
END IF
' Push cell into list and set "queued" flag. The queued flag is used to
' prevent cells that have not been processed yet to be inserted into the
' list again. The flag is cleared as soon as the cell has been processed
' and its content is revealed. Cells that are already visible cannot enter
' the queue.
cell(numCells) = index
numCells = numCells + 1
gField(index) = gField(index) OR cStatQueued
' The queue is not empty, keep going.
DO WHILE (numCells)
' This function returns the number of cells that have been
' successfuly revealed after each click, and we're just about
' to reveal one more cell, so let's update the counter now!
revealCount = revealCount + 1
' Pop cell from queue, ...
numCells = numCells - 1
index = cell(numCells)
' ... and clear its "queued" flag.
gField(index) = gField(index) XOR cStatQueued
' Tag as "revealed."
gField(index) = gField(index) OR cStatReveal
' If there's no mine nearby, get all adjacent cells and
' push them into the queue so we can process them later.
IF ((gField(index) AND CellCounterMask) = 0) THEN
' Get neighbors list.
getNearbyCells index MOD gFieldW, index \ gFieldW, near()
' Go through the list.
FOR i% = 0 TO 7
index = near(i%)
' This neighbor exists!
IF (index <> -1) THEN
' If the neighbor has not been queued yet and is not revealed...
IF ((gField(index) AND (cStatReveal OR cStatQueued)) = 0) THEN
' Push neighbor cell to queue!
cell(numCells) = index
numCells = numCells + 1
' ... and set its "queued" flag so we don't
' attempt to push it into the queue again later.
gField(index) = gField(index) OR cStatQueued
END IF
END IF
NEXT i%
END IF
' One cell has been revealed and all its neighbors have been added to the
' the queue so they can be processed. Keep going until the whole queue is
' depleted (see the DO statement earlier.)
LOOP
' Return the number of cells revealed.
fieldReveal% = revealCount
END FUNCTION
All we have to do now is catch the value returned by fieldReveal%(): if it is -1, the player found a mine and it's game over. If it's 0, the player clicked a cell that's already revealed and nothing happens. If it's anything else, we take the value and add it to the general counter gNumClear. Finally, if gNumCells = gNumClear + gNumMines, the player won.
We have all the pieces we need, now we just have to take user inputs and redraw the screen as we go. To limit the amount of code, we'll go with simple keyboard controls: arrow keys to move the cursor around, space/enter to reveal cells, plus to place a flag or question mark, and escape to quit.
Here's what the full code looks like:
DECLARE SUB main (w AS INTEGER, h AS INTEGER, m AS INTEGER)
DECLARE SUB getNearbyCells (x AS INTEGER, y AS INTEGER, adrLst() AS INTEGER)
DECLARE SUB renderField (x AS INTEGER, y AS INTEGER)
DECLARE SUB fieldInit (cellId AS INTEGER)
DECLARE SUB fieldPopulate ()
DECLARE SUB fieldSafeClick (cellId AS INTEGER)
DECLARE SUB fieldNearMines ()
DECLARE SUB fieldRevealAll ()
DECLARE SUB fieldFlag (cellId AS INTEGER)
DECLARE FUNCTION fieldReveal% (x AS INTEGER, y AS INTEGER)
CONST MaxFieldSize = 256 ' Maximum field size, in cells.
CONST CellCounterMask = &HF ' Cell counter mask.
CONST CellIsMine = 9 ' Counter code for "mine."
CONST cStatClear = &H10 ' Player put a flag on this cell.
CONST cStatMaybe = &H20 ' Player put a question mark on this cell.
CONST cStatReveal = &H40 ' This cell is uncovered.
CONST cStatIsSafe = &H80 ' Can't move mine here.
CONST cStatQueued = &H100 ' Cell queued for reveal.
CONST cellW = 10 ' Width of a cell, in pixels
CONST cellH = 10 ' Height of a cell, in pixels
CONST cellHalfW = cellW \ 2 ' Half the width, in pixels
CONST cellHalfH = cellH \ 2 ' Half the height, in pixels
DIM SHARED gField(MaxFieldSize - 1) AS INTEGER ' Field data.
DIM SHARED gFieldW AS INTEGER ' Field width, in cells.
DIM SHARED gFieldH AS INTEGER ' Field height, in cells.
DIM SHARED gNumCells AS INTEGER ' Total number of cells (gFieldW * gFieldH.)
DIM SHARED gNumMines AS INTEGER ' Number of mines.
DIM SHARED gNumClear AS INTEGER ' Number of cells cleared.
' Set graphic mode 13 (320x200, 256 colors)
SCREEN 13
' Start a new game with a 10x10 field and 8 mines
main 10, 10, 8
''
'' TOGGLE FLAG AND QUESTION MARK.
''
SUB fieldFlag (cellId AS INTEGER)
' Replace flag by question mark
IF (gField(cellId) AND cStatClear) THEN
gField(cellId) = (gField(cellId) XOR cStatClear) OR cStatMaybe
' Remove question mark
ELSEIF (gField(cellId) AND cStatMaybe) THEN
gField(cellId) = gField(cellId) XOR cStatMaybe
' Place flag
ELSE
gField(cellId) = gField(cellId) OR cStatClear
END IF
END SUB
''
'' INITIALIZE FIELD, CALLED ONCE BEFORE PROCESSING THE 1ST CLICK.
'' "CELLID" IS THE INDEX OF THE CELL THE PLAYER CLICKED.
''
SUB fieldInit (cellId AS INTEGER)
' Place mines at random
fieldPopulate
' Move mines triggered by the player
fieldSafeClick cellId
' Reset mine counter of each cell
fieldNearMines
END SUB
''
'' UPDATE NEARBY MINES COUNTERS
''
SUB fieldNearMines
DIM rowId AS INTEGER, near(7) AS INTEGER
' For each row, ...
FOR r% = 0 TO gFieldH - 1
' Get the address of the 1st cell of the row
rowId = r% * gFieldW
' For each column, ...
FOR c% = 0 TO gFieldW - 1
' This cell contains a mine, update neighbors mine counter
IF ((gField(rowId + c%) AND CellCounterMask) = CellIsMine) THEN
' Get list of nearby cells
getNearbyCells c%, r%, near()
' Go through the neighbor list
FOR i% = 0 TO 7
' This is a valid cell index
IF (near(i%) <> -1) THEN
' Increment the mine counter if the cell doesn't contain a mine
gField(near(i%)) = gField(near(i%)) - (gField(near(i%)) <> CellIsMine)
END IF
NEXT i%
END IF
NEXT c%
NEXT r%
END SUB
''
'' PLACE MINES AT RANDOM
''
SUB fieldPopulate
DIM remain AS INTEGER
' Number of mines left to place
remain = gNumMines
' Go through the whole field
FOR t% = 0 TO gNumCells - 1
' The ratio system balances the odds itself. It's pretty neat.
IF (RND < (remain / (gNumCells - t%))) THEN
gField(t%) = CellIsMine
remain = remain - 1
ELSE
gField(t%) = 0
END IF
NEXT t%
END SUB
''
'' REVEAL CELLS STARTING WITH THE ONE LOCATED AT X,Y. THIS
'' FUNCTION RETURNS THE TOTAL NUMBER OF CELLS REVEALED OR
'' -1 IF THE PLAYER DUG UP A MINE. THE ROUTINE IS ITERATIVE
'' RATHER THAN RECURSIVE (IT MAINTAINS A LIST OF CELLS TO
'' PROCESS RATHER THAN CALL ITSELF OVER AND OVER AGAIN.)
''
FUNCTION fieldReveal% (x AS INTEGER, y AS INTEGER)
DIM cell(MaxFieldSize - 1) AS INTEGER ' Reveal queue
DIM numCells AS INTEGER ' Reveal queue size
DIM index AS INTEGER ' Convenience variable: cell index
DIM near(7) AS INTEGER ' Indices of adjacent cells
' Get cell index
index = x + y * gFieldW
' Cell is revealed or is protected by a flag/question mark, abort.
IF (gField(index) AND (cStatClear OR cStatMaybe OR cStatReveal)) THEN
fieldReveal% = 0
EXIT FUNCTION
END IF
' Cell is a mine, game over.
IF ((gField(index) AND CellCounterMask) = CellIsMine) THEN
fieldReveal% = -1
EXIT FUNCTION
END IF
' Push cell into list and set "queued" flag. The queued flag is used to
' prevent cells that have not been processed yet to be inserted into the
' list again. The flag is cleared as soon as the cell has been processed
' and its content is revealed. Cells that are already visible cannot enter
' the queue.
cell(numCells) = index
numCells = numCells + 1
gField(index) = gField(index) OR cStatQueued
' The queue is not empty, keep going.
DO WHILE (numCells)
' This function returns the number of cells that have been
' successfuly revealed after each click, and we're just about
' to reveal one more cell, so let's update the counter now!
revealCount = revealCount + 1
' Pop cell from queue, ...
numCells = numCells - 1
index = cell(numCells)
' ... and clear its "queued" flag.
gField(index) = gField(index) XOR cStatQueued
' Tag as "revealed."
gField(index) = gField(index) OR cStatReveal
' If there's no mine nearby, get all adjacent cells and
' push them into the queue so we can process them later.
IF ((gField(index) AND CellCounterMask) = 0) THEN
' Get neighbors list.
getNearbyCells index MOD gFieldW, index \ gFieldW, near()
' Go through the list.
FOR i% = 0 TO 7
index = near(i%)
' This neighbor exists!
IF (index <> -1) THEN
' If the neighbor has not been queued yet and is not revealed...
IF ((gField(index) AND (cStatReveal OR cStatQueued)) = 0) THEN
' Push neighbor cell to queue!
cell(numCells) = index
numCells = numCells + 1
' ... and set its "queued" flag so we don't
' attempt to push it into the queue again later.
gField(index) = gField(index) OR cStatQueued
END IF
END IF
NEXT i%
END IF
' One cell has been revealed and all its neighbors have been added to the
' the queue so they can be processed. Keep going until the whole queue is
' depleted (see the DO statement earlier.)
LOOP
' Return the number of cells revealed.
fieldReveal% = revealCount
END FUNCTION
''
'' REVEAL THE WHOLE FIELD
''
SUB fieldRevealAll
FOR i% = 0 TO gNumCells - 1
gField(i%) = gField(i%) OR cStatReveal
NEXT i%
END SUB
''
'' MOVE MINES ADJACENT TO THE PROVIDED CELL INDEX ELSEWEHRE.
''
SUB fieldSafeClick (cellId AS INTEGER)
DIM x AS INTEGER, y AS INTEGER, near(7) AS INTEGER
DIM index AS INTEGER, move AS INTEGER
' Get list of nearby cells
x = cellId MOD gFieldW
y = cellId \ gFieldW
getNearbyCells x, y, near()
' There's a mine in the master cell (the one the player just clicked)
IF ((gField(cellId) AND CellCounterMask) = CellIsMine) THEN
' Remove it
gField(cellId) = 0
' Increment the number of mines we have to move
move = move + 1
END IF
' We cannot place a mine on this cell
gField(cellId) = gField(cellId) OR cStatIsSafe
' Parse every neighbor
FOR i% = 0 TO 7
index = near(i%)
' This tile exists
IF (index <> -1) THEN
' It contains a mine
IF ((gField(index) AND CellCounterMask) = CellIsMine) THEN
' Remove it
gField(index) = 0
' Increment the number of mines we have to move
move = move + 1
END IF
' We cannot place a mine on this cell
gField(index) = gField(index) OR cStatIsSafe
END IF
NEXT i%
' Move mines top the top left corner of the board
index = 0
WHILE (move)
' The cell is not locked and doesn't have any mine, move one here
IF (((gField(index) AND cStatIsSafe) = 0) AND (gField(index) = 0)) THEN
gField(index) = CellIsMine
move = move - 1
END IF
' Test the next tile
index = index + 1
WEND
END SUB
''
'' THIS ROUTINE TAKES AN 8-INTEGER ARRAY AND FILLS IT
'' WITH THE INDICES OF NEIGHBORING CELLS. IF THE CELL
'' DOES NOT EXIST (LOCATED OUTSIDE THE AREA,) THEN ITS
'' INDEX NUMBER IS SET TO -1.
''
SUB getNearbyCells (x AS INTEGER, y AS INTEGER, adrLst() AS INTEGER)
DIM maskLf AS INTEGER, maskRt AS INTEGER
DIM maskUp AS INTEGER, maskDn AS INTEGER
DIM index AS INTEGER, baseId AS INTEGER
' Get the vertical and horizontal masks. If the coordinate is located on the
' first or last row/column, then the mask is set to -1. Next, we're going to
' compute the index of the cell and apply the mask with the OR operator. If
' the mask is -1, the end result is -1. If the mask is 0, the end result is
' the index of the cell. In other words, any cell index that falls outside
' the field is represented as -1.
maskLf = (x <= 0): maskRt = (x >= gFieldW - 1)
maskUp = (y <= 0): maskDn = (y >= gFieldH - 1)
' Get the index of the selected cell
baseId = x + y * gFieldW
' Top row
index = baseId - gFieldW
adrLst(0) = (index - 1) OR maskUp OR maskLf
adrLst(1) = index OR maskUp
adrLst(2) = (index + 1) OR maskUp OR maskRt
' Center row
adrLst(3) = (baseId - 1) OR maskLf
adrLst(4) = (baseId + 1) OR maskRt
' Bottom row
index = baseId + gFieldW
adrLst(5) = (index - 1) OR maskDn OR maskLf
adrLst(6) = index OR maskDn
adrLst(7) = (index + 1) OR maskDn OR maskRt
END SUB
''
'' MAIN LOOP, WHERE THE MAGIC HAPPENS
''
SUB main (w AS INTEGER, h AS INTEGER, m AS INTEGER)
DIM scrX AS INTEGER, scrY AS INTEGER ' on-screen position
DIM userStr AS STRING, userInt AS INTEGER ' user inputs
DIM plX AS INTEGER, plY AS INTEGER ' player cursor (column and row)
DIM cleared AS INTEGER, gameOver AS INTEGER ' tiles cleared, game over status
' Setup field variables
gFieldW = w
gFieldH = h
gNumCells = w * h
gNumMines = m
' Compute on-screen vertical and horizontal position,
' center the field on the screen.
scrX = ((320 - cellW * gFieldW) \ 2)
scrY = ((200 - cellH * gFieldH) \ 2)
' Number of mines and field size
LOCATE 1, 1
PRINT " MINES:"; gNumMines
PRINT " CELLS:"; gNumCells
' Main loop
DO
' Redraw whole field
renderField scrX, scrY
' Redraw player cursor
LINE (scrX + plX * cellW, scrY + plY * cellH)-STEP(cellW - 1, cellH - 1), 4, B
' Percentage of the field revealed
LOCATE 3, 1
PRINT "CLEARED:"; STR$((gNumClear * 100) \ (gNumCells - gNumMines)); "%"
' Game status: everything has been revealed
IF (gNumClear + gNumMines = gNumCells) THEN
PRINT "ALL DONE!"
EXIT SUB
' Game status: player found a mine
ELSEIF (gameOver) THEN
PRINT "YOU BLEW IT!"
EXIT SUB
END IF
' User input, etc.
DO
userStr = INKEY$
IF (LEN(userStr) = 1) THEN
userInt = ASC(userStr)
ELSEIF (LEN(userStr) = 2) THEN
userInt = CVI(userStr)
END IF
IF (userInt) THEN
SELECT CASE userInt
CASE &H1B ' escape, abort game
EXIT SUB
CASE &H2B ' plus, place a flag or question mark
IF (gNumClear) THEN
fieldFlag plX + plY * gFieldW
END IF
CASE &H20, &HD ' space (or enter,) reveal a tile
' First click, initialize mine field now
IF (gNumClear = 0) THEN fieldInit plX + plY * gFieldW
' Reveal cells
cleared = fieldReveal%(plX, plY)
IF (cleared = -1) THEN
gameOver = -1
fieldRevealAll
ELSE
gNumClear = gNumClear + cleared
END IF
CASE &H4800 ' up arrow, move cursor up
plY = plY + (plY > 0)
CASE &H5000 ' down arrow, move cursor down
plY = plY - (plY < gFieldH - 1)
CASE &H4B00 ' left arrow, move cursor left
plX = plX + (plX > 0)
CASE &H4D00 ' right arrow, move cursor right
plX = plX - (plX < gFieldW - 1)
END SELECT
' Clear user input
userInt = 0
EXIT DO
END IF
LOOP
LOOP
END SUB
''
'' DRAW THE WHOLE FIELD AT X,Y
''
SUB renderField (x AS INTEGER, y AS INTEGER)
DIM ofsX AS INTEGER, ofsY AS INTEGER
DIM cellOfs AS INTEGER, cellIndex AS INTEGER
DIM digit(7) AS STRING
' Digit drawing codes (there can be up to 8 mines around)
digit(0) = "c1 bm+0,1ed3gr2" ' 1: blue
digit(1) = "c2 rfg2dr2" ' 2: green
digit(2) = "c4 rfgfgl" ' 3: red
digit(3) = "c1 d2r2gd" ' 4: blue
digit(4) = "c4 bm+2,0l2d2rfgl" ' 5: red
digit(5) = "c3 bm+2,0lgd3r2u2l" ' 6: cyan
digit(6) = "c0 r2dgd2" ' 7: black
digit(7) = "c8 r2dg2dr2uh2" ' 8: gray
' Draw tiles surface (light gray)
LINE (x, y)-STEP(gFieldW * cellW - 1, gFieldH * cellH - 1), 7, BF
' For each row...
FOR r% = 0 TO gFieldH - 1
' Get the drawing offset
ofsY = y + r% * cellH
' Get the index of the 1st cell of the row
cellOfs = r% * gFieldW
' For each column...
FOR c% = 0 TO gFieldW - 1
' Get the drawing offset
ofsX = x + c% * cellW
' Compute the full cell index
cellIndex = cellOfs + c%
' If the cell is revealed...
IF (gField(cellIndex) AND cStatReveal) THEN
' Get the counter value
cnt = gField(cellIndex) AND CellCounterMask
SELECT CASE cnt
' There are between 1 and 8 mines nearby, draw number
CASE 1 TO 8
DRAW "bm" + STR$(ofsX + cellHalfW - 2) + "," + STR$(ofsY + cellHalfH - 3) + digit(cnt - 1)
' The cell itself is a mine
CASE 9
CIRCLE (ofsX + cellHalfW - 1, ofsY + cellHalfH - 1), cellH \ 3, 0
PAINT (ofsX + cellHalfW - 1, ofsY + cellHalfH - 1), 0
END SELECT
' The cell is still covered...
ELSE
' Draw emboss
LINE (ofsX, ofsY + (cellH - 2))-STEP(0, -(cellH - 2)), 15
LINE -STEP((cellW - 2), 0), 15
LINE (ofsX + (cellW - 1), ofsY + 1)-STEP(0, (cellH - 2)), 8
LINE -STEP(-(cellW - 2), 0), 8
' The player put a flag on it
IF (gField(cellIndex) AND cStatClear) THEN
DRAW "bm " + STR$(ofsX + 3) + "," + STR$(ofsY + 7) + " c0r2h1u4r1 c4r1h-1l2d1r1"
' The player put a question mark on it
ELSEIF (gField(cellIndex) AND cStatMaybe) THEN
DRAW "bm " + STR$(ofsX + 3) + "," + STR$(ofsY + 3) + " c0u1r3d1g2 bm+0,+2 r0"
END IF
END IF
NEXT c%
NEXT r%
END SUB
Have fun!
- Mike Hawk