Παρασκευή 11 Ιανουαρίου 2019

Revision 24 Version 9.6

Revision 24
Some minor bugs removed also.

Revision 23
1. A Stop statement inside source code removed. This stop engage when a gosub statement execute from a Case in a Select Case, and was there for debugging, so now removed.
2. Lcase$() found to trim a string (leading spaces and trailing spaces). This was not as planned, so trim function removed.
3.Addition for Group pointers, when point to a group which have a Set function. A Set function make the group to process in that function something which we assign to it.




This is the Minesweeper (16X16) written for rosettacode.org.



Module Minesweeper {
      Font "Arial Black"
      Bold 0
      Form 88,40
      Refresh 1000
      Def com$, com_label$
      Def x, b_row, b_col, where, top_where
      Def rows=16, columns=16, 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$
            Local loopagain as boolean
            PrintBoard()
            InputCommand()
            do
                  loopagain=true
                  while not empty
                              \\ process game command
                        select case letter$
                        case "q "
                              Print "Quit" : end_game=True : exit
                        case "o "
                              OpenCell()
                        case "n "
                              OpenCell2()
                        case "? "
                              SwapCell()
                        case "c "
                              Exit Sub
                        End Select
                  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

Δεν υπάρχουν σχόλια:

Δημοσίευση σχολίου

You can feel free to write any suggestion, or idea on the subject.