aparler/RosettaCodeData
1
0
Fork 0
Code Issues 12 Pull requests 3 Projects Releases Packages Wiki Activity Actions

Data commit

Browse source
This commit is contained in:
Ingy döt Net 2023-07-01 11:58:00 -04:00
parent 7387c8f97b
commit cb5bb5e222
199093 changed files with 3378972 additions and 0 deletions
Download patch file Download diff file Expand all files Collapse all files

181
Task/Minesweeper-game/Icon/minesweeper-game.icon Normal file
View file

@ -0,0 +1,181 @@
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