RosettaCodeData/Task/Generate-random-chess-position/FreeBASIC/generate-random-chess-posit...

72 lines
1.6 KiB
Plaintext

Dim Shared As Byte grid(8, 8), r, c
Sub placeKings()
Dim As Byte r1, r2, c1, c2
Do
r1 = Int(Rnd*8)
c1 = Int(Rnd*8)
r2 = Int(Rnd*8)
c2 = Int(Rnd*8)
If (r1 <> r2 And Abs(r1 - r2) > 1 And Abs(c1 - c2) > 1) Then
grid(r1, c1) = Asc("K")
grid(r2, c2) = Asc("k")
Return
End If
Loop
End Sub
Sub placePieces(pieces As String, isPawn As Byte)
Dim numToPlace As Byte = Int(Rnd*(Len(pieces)))
For n As Byte = 0 To numToPlace-1
Do
r = Int(Rnd*8)
c = Int(Rnd*8)
Loop Until(Not(grid(r, c) Or (isPawn And (r = 7 Or r = 0))))
grid(r, c) = Asc(Mid(pieces, n, 1))
Next n
End Sub
Sub toFen()
Dim As Byte ch, countEmpty = 0
Dim As String fen
For r = 0 To 8-1
For c = 0 To 8-1
ch = grid(r, c)
If ch <> 0 Then
Print " " & Chr(ch);
Else
Print " .";
End If
If ch = 0 Then
countEmpty += 1
Else
If countEmpty > 0 Then
fen += Chr(countEmpty + 48)
countEmpty = 0
End If
fen += Chr(ch)
End If
Next c
If countEmpty > 0 Then
fen += Chr(countEmpty + 48)
countEmpty = 0
End If
fen += "/"
Print
Next r
fen += " w - - 0 1"
Print fen
End Sub
Randomize Timer
placeKings()
placePieces("PPPPPPPP", True)
placePieces("pppppppp", True)
placePieces("RNBQBNR", False)
placePieces("rnbqbnr", False)
toFen()
Sleep