181 lines
6 KiB
Text
181 lines
6 KiB
Text
global DEFARGS,MF
|
|
|
|
record minefield(mask,grid,rows,cols,mines,density,marked)
|
|
|
|
$define _DEFAULTS [6, 4, .2, .6] # task defaults
|
|
#$define _DEFAULTS [6, 7, .05, .1] # defaults for debugging
|
|
$define _INDENT 6
|
|
$define _MINE "Y"
|
|
$define _TRUEMINE "Y"
|
|
$define _FALSEMINE "N"
|
|
$define _MASK "."
|
|
$define _MARK "?"
|
|
$define _TOGGLE1 ".?"
|
|
$define _TOGGLE2 "?."
|
|
|
|
procedure main(arglist) #: play the game
|
|
static trace
|
|
initial trace := -1
|
|
|
|
DEFARGS := _DEFAULTS
|
|
if *arglist = 0 then arglist := DEFARGS
|
|
|
|
newgame!arglist
|
|
while c := trim(read()) do {
|
|
c ? { tab(many(' '))
|
|
case move(1) of {
|
|
# required commands
|
|
"c": clear() & showgrid() # c clear 1 sq and show
|
|
"m": mark() # m flag/unflag a mine
|
|
"p": showgrid() # p show the mine field
|
|
"r": endgame("Resigning.") # r resign this game
|
|
# optional commands
|
|
"n": newgame!arglist # n new game grid
|
|
"k": clearunmarked() & showgrid() # k clears adjecent unmarked cells if #flags = count
|
|
"x": clearallunmarked() # x clears every unflagged cell at once win/loose fast
|
|
"q": stop("Quitting") # q quit
|
|
"t": &trace :=: trace # t toggle tracing for debugging
|
|
default: usage()
|
|
}}
|
|
testforwin(g)
|
|
}
|
|
end
|
|
|
|
procedure newgame(r,c,l,h) #: start a new game
|
|
local i,j,t
|
|
|
|
MF := minefield()
|
|
|
|
MF.rows := 0 < integer(\r) | DEFARGS[1]
|
|
MF.cols := 0 < integer(\c) | DEFARGS[2]
|
|
|
|
every !(MF.mask := list(MF.rows)) := list(MF.cols,_MASK) # set mask
|
|
every !(MF.grid := list(MF.rows)) := list(MF.cols,0) # default count
|
|
|
|
l := 1 > (0 < real(\l)) | DEFARGS[3]
|
|
h := 1 > (0 < real(\h)) | DEFARGS[4]
|
|
if l > h then l :=: h
|
|
|
|
until MF.density := l <= ( h >= ?0 ) # random density between l:h
|
|
MF.mines := integer(MF.rows * MF.cols * MF.density) # mines needed
|
|
MF.marked := 0
|
|
|
|
write("Creating ",r,"x",c," mine field with ",MF.mines," (",MF.density * 100,"%).")
|
|
every 1 to MF.mines do until \MF.grid[r := ?MF.rows, c := ?MF.cols] := &null # set mines
|
|
every \MF.grid[i := 1 to MF.rows,j:= 1 to MF.cols] +:= (/MF.grid[i-1 to i+1,j-1 to j+1], 1) # set counts
|
|
|
|
showgrid()
|
|
return
|
|
end
|
|
|
|
procedure usage() #: show usage
|
|
return write(
|
|
"h or ? - this help\n",
|
|
"n - start a new game\n",
|
|
"c i j - clears x,y and displays the grid\n",
|
|
"m i j - marks (toggles) x,y\n",
|
|
"p - displays the grid\n",
|
|
"k i j - clears adjecent unmarked cells if #marks = count\n",
|
|
"x - clears ALL unmarked flags at once\n",
|
|
"r - resign the game\n",
|
|
"q - quit the game\n",
|
|
"where i is the (vertical) row number and j is the (horizontal) column number." )
|
|
end
|
|
|
|
procedure getn(n) #: command parsing
|
|
tab(many(' '))
|
|
if n := n >= ( 0 < integer(tab(many(&digits)))) then return n
|
|
else write("Invalid or out of bounds grid square.")
|
|
end
|
|
|
|
procedure showgrid() #: show grid
|
|
local r,c,x
|
|
|
|
write(right("",_INDENT)," ",repl("----+----|",MF.cols / 10 + 1)[1+:MF.cols])
|
|
every r := 1 to *MF.mask do {
|
|
writes(right(r,_INDENT)," : ")
|
|
every c := 1 to *MF.mask[r] do
|
|
writes( \MF.mask[r,c] | map(\MF.grid[r,c],"0"," ") | _MINE)
|
|
write()
|
|
}
|
|
write(MF.marked," marked mines and ",MF.mines - MF.marked," mines left to be marked.")
|
|
end
|
|
|
|
procedure mark() #: mark/toggle squares
|
|
local i,j
|
|
|
|
if \MF.mask[i := getn(MF.rows), j :=getn(MF.cols)] := map(MF.mask[i,j],_TOGGLE1,_TOGGLE2) then {
|
|
case MF.mask[i,j] of {
|
|
_MASK : MF.marked -:= 1
|
|
_MARK : MF.marked +:= 1
|
|
}
|
|
}
|
|
end
|
|
|
|
procedure clear() #: clear a square
|
|
local i,j
|
|
|
|
if ( i := getn(MF.rows) ) & ( j :=getn(MF.cols) ) then
|
|
if /MF.mask[i,j] then
|
|
write(i," ",j," was already clear")
|
|
else if /MF.grid[i,j] then endgame("KABOOM! You lost.")
|
|
else return revealclearing(i,j)
|
|
end
|
|
|
|
procedure revealclearing(i,j) #: reaveal any clearing
|
|
|
|
if \MF.mask[i,j] := &null then {
|
|
if MF.grid[i,j] = 0 then
|
|
every revealclearing(i-1 to i+1,j-1 to j+1)
|
|
return
|
|
}
|
|
end
|
|
|
|
procedure clearunmarked() #: clears adjecent unmarked cells if #flags = count
|
|
local i,j,k,m,n
|
|
|
|
if ( i := getn(MF.rows) ) & ( j :=getn(MF.cols) ) then
|
|
if /MF.mask[i,j] & ( k := 0 < MF.grid[i,j] ) then {
|
|
every (\MF.mask[i-1 to i+1,j-1 to j+1] == _MARK) & ( k -:= 1)
|
|
if k = 0 then {
|
|
every (m := i-1 to i+1) & ( n := j-1 to j+1) do
|
|
if \MF.mask[m,n] == _MASK then MF.mask[m,n] := &null
|
|
revealclearing(i,j)
|
|
return
|
|
}
|
|
else
|
|
write("Marked squares must match adjacent mine count.")
|
|
}
|
|
else write("Must be adjecent to one or more marks to clear surrounding squares.")
|
|
end
|
|
|
|
procedure clearallunmarked() #: fast win or loose
|
|
local i,j,k
|
|
|
|
every (i := 1 to MF.rows) & (j := 1 to MF.cols) do {
|
|
if \MF.mask[i,j] == _MASK then {
|
|
MF.mask[i,j] := &null
|
|
if /MF.grid[i,j] then k := 1
|
|
}
|
|
}
|
|
if \k then endgame("Kaboom - you loose.")
|
|
end
|
|
|
|
procedure testforwin() #: win when rows*cols-#_MARK-#_MASK are clear and no Kaboom
|
|
local t,x
|
|
|
|
t := MF.rows * MF.cols - MF.mines
|
|
every x := !!MF.mask do if /x then t -:= 1
|
|
if t = 0 then endgame("You won!")
|
|
end
|
|
|
|
procedure endgame(tag) #: end the game
|
|
local i,j,m
|
|
|
|
every !(m := list(MF.rows)) := list(MF.cols) # new mask
|
|
every (i := 1 to MF.rows) & (j := 1 to MF.cols) do
|
|
if \MF.mask[i,j] == _MARK then
|
|
m[i,j] := if /MF.grid[i,j] then _TRUEMINE else _FALSEMINE
|
|
MF.mask := m
|
|
write(tag) & showgrid()
|
|
end
|