267 lines
9.5 KiB
Text
267 lines
9.5 KiB
Text
Module Minesweeper {
|
|
Font "Arial Black"
|
|
Bold 0
|
|
Form 60,40
|
|
Refresh 1000
|
|
Def com$, com_label$
|
|
Def x, b_row, b_col, where, top_where
|
|
Def rows=4, columns=6, swap_first%
|
|
Def boolean skiptest, end_game, cheat
|
|
Dim Board$(0 to rows+1, 0 to columns+1)="? "
|
|
Def mines%, i%, j%, used%, acc%, n%, m%
|
|
mines%=max.data(random(int(columns*rows*.1),int(columns*rows*.2)-1), 1)
|
|
For i%=1 to rows:For j%=1 to columns
|
|
Board$(i%,j%)=". "
|
|
Next j%:Next i%
|
|
used%=mines%
|
|
While used%
|
|
used%--
|
|
Do
|
|
i%=random(1,rows)
|
|
j%=random(1, columns)
|
|
Until right$(Board$(i%,j%),1)=" "
|
|
Board$(i%,j%)=".*"
|
|
End While
|
|
used%=rows*columns-mines%
|
|
\\ remove rem so to never loose from first open
|
|
Rem :
|
|
swap_first%=used%
|
|
\\ when mines%=0 or used%=0 then player win
|
|
Report {Minesweeper - rosettacode task
|
|
Commands:
|
|
- ? 1 2 flag/unflag 1 2
|
|
- 1 2 open 1 2
|
|
- q to quit
|
|
You can pass multiple commands in a line, but q erase all before execute
|
|
}
|
|
top_where=Row
|
|
While not End_Game {GameLoop()}
|
|
End
|
|
Sub PrintBoard()
|
|
Cls, top_where
|
|
Print
|
|
Print " X ";
|
|
For j%=1 to columns {
|
|
Print format$("{0::-3} ", j%);
|
|
}
|
|
Print
|
|
For i%=1 to rows {
|
|
Print format$(" {0::-3} ", i%);
|
|
For j%=1 to columns {
|
|
Print " ";Left$(Board$(i%,j%),1);" ";
|
|
\\ rem above and unrem follow line to display mines
|
|
Rem: Print " ";Board$(i%,j%)+" ";
|
|
}
|
|
Print
|
|
}
|
|
End Sub
|
|
Sub PrintMines()
|
|
Cls, top_where
|
|
Print
|
|
Print " X ";
|
|
For j%=1 to columns {
|
|
Print format$("{0::-3} ", j%);
|
|
}
|
|
Print
|
|
For i%=1 to rows {
|
|
Print format$(" {0::-3} ", i%);
|
|
For j%=1 to columns {
|
|
Print " ";Right$(Board$(i%,j%),1);" ";
|
|
}
|
|
Print
|
|
}
|
|
End Sub
|
|
Sub GameLoop()
|
|
Local com$, loopagain as boolean
|
|
PrintBoard()
|
|
InputCommand()
|
|
do
|
|
loopagain=true
|
|
while not empty
|
|
\\ process game command
|
|
Read com$
|
|
if com$="q " Then
|
|
Print "Quit" : end_game=True : exit
|
|
Else.if com$="o " Then
|
|
OpenCell()
|
|
Else.if com$="n " Then
|
|
OpenCell2()
|
|
Else.if com$="? " Then
|
|
SwapCell()
|
|
Else.if com$="c " Then
|
|
Exit Sub
|
|
End if
|
|
End While
|
|
If mines%=0 or used%=0 then
|
|
PrintBoard(): Print "Player Win": end_game=True: Exit Sub
|
|
End if
|
|
If mines%=-1 then
|
|
if swap_first%=used% then
|
|
mines%=rows*columns-used%
|
|
Local n%, m%
|
|
While mines%
|
|
Let n%=random(1,rows), m%=random(1, columns)
|
|
If Board$(n%, m%)=". " then Board$(n%, m%)=".*" : mines%=0
|
|
End While
|
|
Board$(i%, j%)=". "
|
|
mines%=rows*columns-used%
|
|
swap_first%=-100
|
|
Push i%, j%, "o "
|
|
loopagain=false
|
|
else
|
|
PrintMines(): Print "Player Loose": end_game=True : Exit Sub
|
|
end if
|
|
End If
|
|
Until loopagain
|
|
Flush
|
|
Refresh if(End_Game->10,1000)
|
|
End Sub
|
|
Sub InputCommand()
|
|
where=row
|
|
While com$=""
|
|
cls, where
|
|
Print "x x | ? x x | q >";
|
|
Refresh 10
|
|
Try {
|
|
Input "", com$
|
|
}
|
|
End While
|
|
x=1
|
|
Flush
|
|
While com$<>""
|
|
com_label$=""
|
|
ParseCommand()
|
|
if len(com_label$)<>2 then
|
|
com$="" : Print com_label$ : Flush
|
|
Refresh 10
|
|
push key$ : drop
|
|
else
|
|
Data com_label$, b_col, b_row
|
|
End if
|
|
End While
|
|
Refresh 1000
|
|
End Sub
|
|
Sub ParseCommand()
|
|
com_label$="o "
|
|
skiptest=true
|
|
ReadColumn()
|
|
if len(com_label$)<>2 then
|
|
com$=""
|
|
Else.if x=-1 then
|
|
com_label$=lcase$(Left$(com$,1))+" "
|
|
com$=mid$(com$, 2)
|
|
x=1
|
|
if len(com_label$)<>2 then
|
|
com_label$="no command found"
|
|
else.if com_label$="? " then
|
|
ReadColumn()
|
|
if x>-1 then ReadRow()
|
|
else.if com_label$="c " then
|
|
cheat=true
|
|
else.if com_label$="q " then
|
|
flush
|
|
com$=""
|
|
else
|
|
com_label$="Use q or ? for commands"
|
|
com$=""
|
|
End if
|
|
else
|
|
ReadRow()
|
|
if x>-1 then com_label$="o "
|
|
End if
|
|
End Sub
|
|
Sub ReadRow()
|
|
com$=mid$(com$,x)
|
|
b_row=val(com$, "??", x)
|
|
if x=-1 then
|
|
com_label$="Need a row"
|
|
else.if b_row<1 or b_row>rows then
|
|
com_label$="Need a row from 1 to "+str$(rows)
|
|
x=-1
|
|
else
|
|
com$=mid$(com$,x+1)
|
|
x=1
|
|
End if
|
|
End Sub
|
|
Sub ReadColumn()
|
|
com$=mid$(com$,x)
|
|
b_col=val(com$, "??", x)
|
|
if x=-1 then
|
|
if not skiptest then com_label$="Need a column"
|
|
else.if b_col<1 or b_col>columns then
|
|
com_label$="Need a column from 1 to"+str$(columns)
|
|
else
|
|
com$=mid$(com$,x+1)
|
|
x=1
|
|
End if
|
|
skiptest=false
|
|
End Sub
|
|
Sub SwapCell()
|
|
Read j%, i%
|
|
If left$(Board$(i%,j%),1)="?" then
|
|
Board$(i%,j%) ="."+Right$(Board$(i%,j%),1)
|
|
If cheat Then if Right$(Board$(i%,j%),1)="*" then mines%++
|
|
Else.If left$(Board$(i%,j%),1)="." then
|
|
Board$(i%,j%) ="?"+Right$(Board$(i%,j%),1)
|
|
If cheat Then if Right$(Board$(i%,j%),1)="*" then mines%--
|
|
End if
|
|
End Sub
|
|
Sub OpenCell()
|
|
Read j%, i%
|
|
If left$(Board$(i%,j%),1)="." then {
|
|
if Right$(Board$(i%,j%),1)="*" then mines%=-1 : flush : exit
|
|
acc%=0
|
|
used%--
|
|
Local n%, m%
|
|
For n%=i%-1 to i%+1 {
|
|
For m%=j%-1 to j%+1 {
|
|
If Right$(Board$(n%,m%),1)="*" then acc%++
|
|
}
|
|
}
|
|
For n%=i%-1 to i%+1 {
|
|
For m%=j%-1 to j%+1 {
|
|
if not (n%=i% and m%=j%) then
|
|
if not Right$(Board$(n%,m%),1)="*" then
|
|
If left$(Board$(n%,m%),1)="." then
|
|
Push n%, m%, "n " ' reverse to stack
|
|
Rem : Print stack.size : Refresh
|
|
End If
|
|
End If
|
|
End If
|
|
}
|
|
}
|
|
Board$(i%,j%)=if$(acc%=0->" ",str$(acc%, "# "))
|
|
}
|
|
End Sub
|
|
Sub OpenCell2()
|
|
Read J%, i%
|
|
If left$(Board$(i%,j%),1)="." then {
|
|
if Right$(Board$(i%,j%),1)="*" then exit
|
|
acc%=0
|
|
used%--
|
|
For n%=i%-1 to i%+1 {
|
|
For m%=j%-1 to j%+1 {
|
|
If Right$(Board$(n%,m%),1)="*" then acc%++
|
|
}
|
|
}
|
|
\\ if cell has no mines around then we check all
|
|
if acc%=0 then
|
|
Local n%, m%
|
|
For n%=i%-1 to i%+1
|
|
For m%=j%-1 to j%+1
|
|
if not (n%=i% and m%=j%) then
|
|
if not Right$(Board$(n%,m%),1)="*" then
|
|
If left$(Board$(n%,m%),1)="." then
|
|
Push n%, m%, "o " ' reverse to stack
|
|
Rem : Print stack.size : Refresh
|
|
End If
|
|
End If
|
|
End If
|
|
Next m%
|
|
Next n%
|
|
End If
|
|
Board$(i%,j%)=if$(acc%=0->" ",str$(acc%, "# "))
|
|
}
|
|
End Sub
|
|
}
|
|
Minesweeper
|