Data commit

Task/Generate-random-chess-position/FreeBASIC/generate-random-chess-position.basic

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