RosettaCodeData/Task/Generate-random-chess-position/Action-/generate-random-chess-position.action
2023-07-01 13:44:08 -04:00

120 lines
1.9 KiB
Text

DEFINE BOARDSIZE="64"
DEFINE EMPTY="'."
BYTE FUNC AbsDist(BYTE a,b)
IF a>b THEN RETURN (a-b) FI
RETURN (b-a)
BYTE FUNC GetPiece(BYTE ARRAY board BYTE x,y)
RETURN (board(x+y*8))
PROC PutPiece(BYTE ARRAY board BYTE x,y,piece)
board(x+y*8)=piece
RETURN
PROC PrintBoard(BYTE ARRAY board)
BYTE i,j,c
FOR j=0 TO 7
DO
FOR i=0 TO 7
DO
c=GetPiece(board,i,j)
Put(c)
OD
PutE()
OD
RETURN
PROC Append(CHAR ARRAY s CHAR c)
s(0)==+1
s(s(0))=c
RETURN
PROC ExportToFen(BYTE ARRAY board CHAR ARRAY fen)
CHAR ARRAY s=" w - - 0 1"
INT x,y
BYTE count,p
fen(0)=0
FOR y=0 TO 7
DO
x=0
WHILE x<8
DO
count=0
WHILE x<8 AND GetPiece(board,x,y)=EMPTY
DO
x==+1 count==+1
OD
IF count>0 THEN
Append(fen,'0+count)
ELSE
p=GetPiece(board,x,y)
Append(fen,p)
x==+1
FI
OD
IF y<7 THEN
Append(fen,'/)
FI
OD
FOR x=1 TO s(0)
DO
Append(fen,s(x))
OD
RETURN
PROC PutKings(BYTE ARRAY board)
BYTE x1,y1,x2,y2
DO
x1=Rand(8) y1=Rand(8)
x2=Rand(8) y2=Rand(8)
IF AbsDist(x1,x2)>1 AND AbsDist(y1,y2)>1 THEN
PutPiece(board,x1,y1,'K)
PutPiece(board,x2,y2,'k)
RETURN
FI
OD
RETURN
PROC PutPieces(BYTE ARRAY board CHAR ARRAY pieces)
BYTE i,x,y,p
FOR i=1 TO pieces(0)
DO
p=pieces(i)
DO
x=Rand(8)
IF p='P OR p='p THEN
y=Rand(6)+1
ELSE
y=Rand(8)
FI
UNTIL GetPiece(board,x,y)=EMPTY
OD
PutPiece(board,x,y,p)
OD
RETURN
PROC Generate(BYTE ARRAY board CHAR ARRAY pieces)
SetBlock(board,BOARDSIZE,EMPTY)
PutKings(board)
PutPieces(board,pieces)
RETURN
PROC Test(CHAR ARRAY pieces)
BYTE ARRAY board(BOARDSIZE)
CHAR ARRAY fen(256)
Generate(board,pieces)
PrintBoard(board)
ExportToFen(board,fen)
PrintE(fen) PutE()
RETURN
PROC Main()
Test("PPPPPPPPBBNNQRRppppppppbbnnqrr")
Test("PPBNQRppbnqr")
RETURN