Find Chess960 starting position identifier: Difference between revisions

Content added Content deleted
(→‎{{header|Julia}}: Correct algorithm.)
(→‎{{header|Commodore BASIC}}: read demo data instead of prompting user)
Line 30: Line 30:


<lang basic>100 REM DERIVE SP-ID FROM CHESS960 POS
<lang basic>100 REM DERIVE SP-ID FROM CHESS960 POS
110 READ A$: IF A$="" THEN END
110 PRINT "ENTER START ARRAY AS SEEN BY WHITE."
120 PRINT: PRINT "STARTING ARRAY:";
120 PRINT A$":";
130 GOSUB 170
130 OPEN 1,0: INPUT#1, AR$: CLOSE 1: PRINT
140 PRINT SP
140 IF LEN(AR$)=0 THEN END
150 GOTO 110
150 IF LEN(AR$)=8 THEN 170
160 DATA QNRBBNKR, RNBQKBNR, RQNBBKRN, RNQBBKRN,
160 PRINT "ARRAY MUST BE 8 PIECES.": GOTO 120
170 FOR I=1 TO 8
170 IF LEN(A$)=8 THEN 190
180 PRINT "ARRAY MUST BE 8 PIECES.": SP=-1: RETURN
180 : P$=MID$(AR$,I,1)
190 : IF P$="Q" THEN Q(Q)=I: Q=Q+1: GOTO 250
190 K=0:Q=0:B=0:N=0:R=0
200 FOR I=0 TO 7
200 : IF P$="K" THEN K(K)=I: K=K+1: GOTO 250
210 : IF P$="B" THEN B(B)=I: B=B+1: GOTO 250
210 : K(I)=0:Q(I)=0:B(I)=0:N(I)=0:R(I)=0
220 NEXT I
220 : IF P$="N" THEN N(N)=I: N=N+1: GOTO 250
230 : IF P$="R" THEN R(R)=I: R=R+1: GOTO 250
230 FOR I=1 TO 8
240 : P$=MID$(A$,I,1)
240 : PRINT "ILLEGAL PIECE '"P$"'.": GOTO 120
250 : IF P$="Q" THEN Q(Q)=I: Q=Q+1: GOTO 310
250 NEXT I
260 IF K<>1 THEN PRINT "THERE MUST BE EXACTLY ONE KING.": GOTO 120
260 : IF P$="K" THEN K(K)=I: K=K+1: GOTO 310
270 IF Q<>1 THEN PRINT "THERE MUST BE EXACTLY ONE QUEEN.": GOTO 120
270 : IF P$="B" THEN B(B)=I: B=B+1: GOTO 310
280 IF B<>2 THEN PRINT "THERE MUST BE EXACTLY TWO BISHOPS.": GOTO 120
280 : IF P$="N" THEN N(N)=I: N=N+1: GOTO 310
290 IF N<>2 THEN PRINT "THERE MUST BE EXACTLY TWO KNIGHTS.": GOTO 120
290 : IF P$="R" THEN R(R)=I: R=R+1: GOTO 310
300 IF R<>2 THEN PRINT "THERE MUST BE EXACTLY TWO ROOKS.": GOTO 120
300 : PRINT "ILLEGAL PIECE '"P$"'.": SP=-1: RETURN
310 NEXT I
310 IF (K(0) > R(0)) AND (K(0) < R(1)) THEN 330
320 PRINT "KING MUST BE BETWEEN THE ROOKS.": GOTO 120
320 IF K<>1 THEN PRINT "THERE MUST BE EXACTLY ONE KING.": SP=-1: RETURN
330 IF Q<>1 THEN PRINT "THERE MUST BE EXACTLY ONE QUEEN.": SP=-1: RETURN
330 IF (B(0) AND 1) <> (B(1) AND 1) THEN 350
340 PRINT "BISHOPS MUST BE ON OPPOSITE COLORS.": GOTO 120
340 IF B<>2 THEN PRINT "THERE MUST BE EXACTLY TWO BISHOPS.": SP=-1: RETURN
350 IF N<>2 THEN PRINT "THERE MUST BE EXACTLY TWO KNIGHTS.": SP=-1: RETURN
350 FOR I=0 TO 1
360 IF R<>2 THEN PRINT "THERE MUST BE EXACTLY TWO ROOKS.": SP=-1: RETURN
360 : N=N(I)
370 : IF N(I)>Q(I) THEN N=N-1
370 IF (K(0) > R(0)) AND (K(0) < R(1)) THEN 390
380 PRINT "KING MUST BE BETWEEN THE ROOKS.": SP=-1: RETURN
380 : FOR J=0 TO 1
390 : IF N(I)>B(J) THEN N=N-1
390 IF (B(0) AND 1) <> (B(1) AND 1) THEN 410
400 PRINT "BISHOPS MUST BE ON OPPOSITE COLORS.": SP=-1: RETURN
400 : NEXT J
410 : N(I)=N
410 FOR I=0 TO 1
420 NEXT I
420 : N=N(I)
430 N0=1: N1=2
430 : IF N(I)>Q(I) THEN N=N-1
440 FOR N=0 TO 9
440 : FOR J=0 TO 1
450 : IF N0=N(0) AND N1=N(1) THEN 490
450 : IF N(I)>B(J) THEN N=N-1
460 : N1=N1+1
460 : NEXT J
470 : N(I)=N
470 : IF N1>5 THEN N0=N0+1: N1=N0+1
480 NEXT N
480 NEXT I
490 Q=Q(0)-1
490 N0=1: N1=2
500 FOR I=0 TO 1
500 FOR N=0 TO 9
510 : IF Q(0)>B(I) THEN Q=Q-1
510 : IF N0=N(0) AND N1=N(1) THEN 550
520 NEXT I
520 : N1=N1+1
530 FOR I=0 TO 1
530 : IF N1>5 THEN N0=N0+1: N1=N0+1
540 : B=B(I)-1
540 NEXT N
550 : IF B AND 1 THEN L=INT(B/2)
550 Q=Q(0)-1
560 : IF (B AND 1)=0 THEN D=B/2
560 FOR I=0 TO 1
570 : IF Q(0)>B(I) THEN Q=Q-1
570 NEXT I
580 NEXT I
580 PRINT "SPID ="; 96*N+16*Q+4*D+L</lang>
590 FOR I=0 TO 1
600 : B=B(I)-1
610 : IF B AND 1 THEN L=INT(B/2)
620 : IF (B AND 1)=0 THEN D=B/2
630 NEXT I
640 SP = 96*N+16*Q+4*D+L
650 RETURN</lang>


{{Out}}
{{Out}}
<pre>READY.
<pre>READY.
RUN
RUN
QNRBBNKR: 105
ENTER START ARRAY AS SEEN BY WHITE.
RNBQKBNR: 518

RQNBBKRN: 601
STARTING ARRAY:RNBQKBNR
RNQBBKRN: 617
SPID = 518

READY.
RUN
ENTER START ARRAY AS SEEN BY WHITE.

STARTING ARRAY:QNRBBNKR
SPID = 105


READY.</pre>
READY.</pre>