/* This is a chess program written in PL/I.                              */
/* The original was written in Fortran 90 by Dean Menezes.               */
/* This translation by R. A. Vowels, 30 May 2008.                        */
/* Moves are input in this form:                                         */
/* E2-E4 (start square, hyphen, end square).                             */

/* Sources:                                                              */

/* http://ai-depot.com/articles/minimax-explained/                       */
/* http://www.aihorizon.com/essays/chessai/index.htm                     */
/* http://www.ascotti.org/programming/chess/Shannon%20-%20Programming
%20a%20computer%20for%20playing%20chess.pdf */

(SUBRG, SIZE, FOFL, STRINGRANGE, STRINGSIZE):
CHESS: PROCEDURE OPTIONS (MAIN, REORDER);
  /* Global variables: */
  /* level = current recursion level for calculation */
  /* maxlevel = maximum recursion level */
  /* score = current score (evaluation) */
  /* besta, bestb, bestx, besty = holds best moves for each recursion level */
  /* wcksflag, wcqsflag = flags to detemine castling abilities */
  /* board = the 8x8 array to hold chessboard */
   DECLARE ( MAXLEVEL  VALUE ( 5) ) FIXED BINARY;
   DECLARE ( LEVEL, SCORE, BESTA(0:7) ) FIXED BINARY (31);
   DECLARE ( BESTB(1:MAXLEVEL), BESTX(1:MAXLEVEL), BESTY(1:MAXLEVEL) ) FIXED 
      BINARY (31);
   DECLARE ( WCKSFLAG, WCQSFLAG ) BIT(1) ALIGNED;
   DECLARE ( A, B, X, Y, RES ) FIXED BINARY (31);


  /* initialize board to starting position */
   DECLARE BOARD(0:7, 0:7) FIXED BINARY (31) STATIC INITIAL (
   -500, -270, -300, -900, -7500, -300, -270,  -500,
   -100, -100, -100, -100, -100, -100, -100, -100,
      0,    0,    0,    0,    0,    0,    0,    0,
      0,    0,    0,    0,    0,    0,    0,    0,
      0,    0,    0,    0,    0,    0,    0,    0,
      0,    0,    0,    0,    0,    0,    0,    0,
    100,  100,  100,  100,  100,  100,  100,  100,
    500,  270,  300,  900, 5000,  300,  270,  500 );

   LEVEL=0; A=-1; RES=0;
   WCKSFLAG =  '0'B  ; WCQSFLAG =  '0'B;
  /* main loop: get white move from user, calculate black move */
   DO FOREVER;
      SCORE=0;
      CALL IO(A, B, X, Y, RES);
      RES=EVALUATE(-1, 10000);
      A=BESTA(1); B=BESTB(1); X=BESTX(1); Y=BESTY(1);
   END;

/* figure out if white is in check                                       */
INCHECK: PROCEDURE () RETURNS( FIXED BINARY (31)) OPTIONS (REORDER);
   DECLARE (XX(0:26), YY(0:26), CC(0:26)) FIXED BINARY (31);
   DECLARE (I, A, B, X, Y, NDX) FIXED BINARY (31);

   DO B = 0 TO  7;
      DO A = 0 TO  7;
         IF  BOARD(B, A)>=0 THEN
            ITERATE;
         CALL MOVELIST(A, B, XX, YY, CC, NDX);
        /* iterate through move list and see if */
        /* piece can get to king */
         DO I = 0 TO  NDX BY  1;
            X = XX(I);
            Y = YY(I);
            IF  BOARD(Y, X)  = 5000  THEN
                  RETURN (1);
         END;
      END;
   END;
   RETURN (0);
   END INCHECK;

EVALUATE: PROCEDURE (ID, PRUNE) RETURNS ( FIXED BINARY (31) ) RECURSIVE;
   DECLARE ( ID, PRUNE ) FIXED BINARY (31);
   /* local variables. */
   DECLARE ( XX(0:26), YY(0:26), CC(0:26) ) FIXED BINARY (31);
   DECLARE ( A, B, X, Y, C, OLDSCORE, BESTSCORE, MOVER, TARG, NDX,
      I ) FIXED BINARY (31);

   LEVEL=LEVEL+1;
   BESTSCORE=10000*ID;
   DO B=7 TO 0 BY  -1;
      DO A=7 TO 0 BY  -1;
        /* generate the moves for all the pieces */
        /* and iterate through them */
         IF  SIGN(BOARD(B,A))^=ID THEN
            ITERATE;
         CALL MOVELIST (A, B, XX, YY, CC, NDX);
         DO I=0 TO NDX BY 1;
            X=XX(I); Y=YY(I); C=CC(I);
            OLDSCORE=SCORE; MOVER=BOARD(B,A); TARG=BOARD(Y,X);
           /* make the move and evaluate the new position */
           /* recursively. Targ holds the relative value of the piece */
           /* allowing use to calculate material gain/loss */
            CALL MAKEMOVE (A, B, X, Y, C);
            IF  LEVEL<MAXLEVEL  THEN
               DO;
                  SCORE=SCORE+EVALUATE(-ID,
                     BESTSCORE-TARG+ID*(8-ABS(4-X)-ABS(4-Y)));
               END;
            SCORE=SCORE+TARG-ID*(8-ABS(4-X)-ABS(4-Y));
           /* we want to minimize the maximum possible loss */
           /* for black */
            IF  (ID<0   &   SCORE>BESTSCORE)  | (ID>0 & SCORE<BESTSCORE) THEN
               DO;
                  BESTA(LEVEL)=A; BESTB(LEVEL)=B;
                  BESTX(LEVEL)=X; BESTY(LEVEL)=Y;
                  BESTSCORE=SCORE;
                  IF  (ID<0   &   BESTSCORE>=PRUNE)  | (ID>0 & BESTSCORE<=PRUNE)  THEN
                     DO;
                        BOARD(B,A)=MOVER; BOARD(Y,X)=TARG; SCORE=OLDSCORE;
                        LEVEL=LEVEL-1;
                        RETURN (BESTSCORE);
                     END;
               END;
            BOARD(B,A)=MOVER; BOARD(Y,X)=TARG; SCORE=OLDSCORE;
         END;
      END;
   END;
   LEVEL=LEVEL-1;
   RETURN (BESTSCORE);
   END EVALUATE;

/* make a move given the start square and end square                     */
/* currently always promotes to queen                                    */
/* Moves from position (A, B) to position (X,Y).                         */

MAKEMOVE: PROCEDURE  (A, B, X, Y, C) OPTIONS (REORDER);                                             
   DECLARE (A, B, X, Y, C) FIXED BINARY (31);
   DECLARE (XX(0:26), YY(0:26)) FIXED BINARY (31);

   BOARD(Y, X)=BOARD(B, A); BOARD(B, A)=0;
   IF  Y  = 0   &   BOARD(Y, X)  =  100 THEN
      BOARD(Y, X)=  C;
   IF  Y  = 7   &   BOARD(Y, X)  = -100 THEN
      BOARD(Y, X)=  C;
   RETURN;
   END MAKEMOVE;

/* select appropriate subprogram to populate xx and yy arrays            */
/* with piece moves                                                      */
/* xx = x coordinates                                                    */
/* yy = y coordinates                                                    */
/* cc = pawn promotion if applicable                                     */
/* ndx = index into xx, yy, cc arrays showing the number of              */
/*       elements that the arrays have been populated with               */
MOVELIST: PROCEDURE  (A, B, XX, YY, CC, NDX) OPTIONS (REORDER);                                     
   DECLARE (A, B) FIXED BINARY (31);
   DECLARE (XX(0:26), YY(0:26), CC(0:26)) FIXED BINARY (31);
   DECLARE (NDX) FIXED BINARY (31);
   DECLARE (PIECE) FIXED BINARY (31);

   PIECE=ABS(BOARD(B, A)); NDX=-1;
   SELECT (PIECE);
      WHEN (100) CALL PAWN(A, B, XX, YY, CC, NDX);
      WHEN (270) CALL KNIGHT(A, B, XX, YY, NDX);
      WHEN (300) CALL BISHOP(A, B, XX, YY, NDX);
      WHEN (500) CALL ROOK(A, B, XX, YY, NDX);
      WHEN (900) CALL QUEEN(A, B, XX, YY, NDX);
      OTHERWISE  CALL KING(A, B, XX, YY, NDX);
   END;
   RETURN;
   END MOVELIST;

/* queen is a combination of rook and bishop                             */
QUEEN: PROCEDURE  (A, B, XX, YY, NDX) OPTIONS (REORDER);                                            
   DECLARE (A, B) FIXED BINARY (31);
   DECLARE (XX(0:26), YY(0:26)) FIXED BINARY (31);
   DECLARE NDX FIXED BINARY (31);

   CALL ROOK(A, B, XX, YY, NDX);
   CALL BISHOP(A, B, XX, YY, NDX);
   RETURN;
   END QUEEN;


KING: PROCEDURE  (A, B, XX, YY, NDX) OPTIONS (REORDER);                                             
   DECLARE (A, B) FIXED BINARY (31);
   DECLARE (XX(0:26), YY(0:26)) FIXED BINARY (31);
   DECLARE NDX FIXED BINARY (31);
   DECLARE (ID, DX, DY) FIXED BINARY (31);

   ID=SIGN(BOARD(B, A));
  /* negative = left or up */
  /* positive = right or down */
  /* zero = no change */
   DO DY=-1 TO  1;
      IF  B+DY<0  |   B+DY>7 THEN
         ITERATE;
      DO DX=-1 TO  1;
         IF  A+DX<0  |   A+DX>7 THEN
            ITERATE;
         IF  ID^=SIGN(BOARD(B+DY,A+DX))  THEN
            DO;
               NDX=NDX+1; XX(NDX)=A+DX; YY(NDX)=B+DY;
            END;
      END;
   END;
   RETURN;
   END KING;


PAWN: PROCEDURE  (A, B, XX, YY, CC, NDX) OPTIONS (REORDER);                                         
   DECLARE (A, B) FIXED BINARY (31);
   DECLARE (XX(0:26), YY(0:26), CC(0:26)) FIXED BINARY (31);
   DECLARE NDX FIXED BINARY (31);
   DECLARE (I, ID) FIXED BINARY (31);

   ID = SIGN(BOARD(B, A));
   IF  ((A - 1) >= 0)   &   ((A - 1) <= 7)   & ((B - ID) >= 0) & ((B - 
      ID) <= 7)  THEN
      DO;
         IF  SIGN(BOARD((B - ID), (A - 1)))  = -ID  THEN
            DO;
               IF  ((ID<0)   &   (B  = 6))  |   ((ID>0)   & (B = 1))  THEN
                  DO;
                     CC(NDX+1) = 270*ID;
                     CC(NDX+2) = 300*ID;
                     CC(NDX+3) = 500*ID;
                     CC(NDX+4) = 900*ID;
                     DO I=1 TO  4;
                        NDX = NDX + 1;
                        XX(NDX) = A - 1;
                        YY(NDX) = B - ID;
                     END;
                  END;
               ELSE
                  DO;
                     NDX = NDX + 1;
                     XX(NDX) = A - 1;
                     YY(NDX) = B - ID;
                  END;
            END;
      END;
   IF  ((A + 1) >= 0)   &   ((A + 1) <= 7)   &   ((B - ID) >= 0) & ((B 
      - ID) <= 7)  THEN
      DO;
         IF  SIGN(BOARD((B - ID), (A + 1)))  = -ID  THEN
            DO;
               IF  ((ID<0)   &   (B  = 6))  |   ((ID>0)   & (B = 1))  THEN
                  DO;
                     CC(NDX+1) = 270*ID;
                     CC(NDX+2) = 300*ID;
                     CC(NDX+3) = 500*ID;
                     CC(NDX+4) = 900*ID;
                     DO I=1 TO  4;
                        NDX = NDX + 1;
                        XX(NDX) = A + 1;
                        YY(NDX) = B - ID;
                     END;
                  END;
               ELSE
                  DO;
                     NDX = NDX + 1;
                     XX(NDX) = A + 1;
                     YY(NDX) = B - ID;
                  END;
            END;
      END;
   IF  (A >= 0)   &   (A <= 7)   &   ((B - ID) >= 0)   & ((B - ID) <= 7)  THEN
      DO;
         IF  BOARD((B - ID), A)  = 0  THEN
            DO;
               IF  ((ID<0)   &   (B  = 6))  |   ((ID>0)   & (B = 1))  THEN
                  DO;
                     CC(NDX+1) = 270*ID;
                     CC(NDX+2) = 300*ID;
                     CC(NDX+3) = 500*ID;
                     CC(NDX+4) = 900*ID;
                     DO I=1 TO  4;
                        NDX = NDX + 1;
                        XX(NDX) = A;
                        YY(NDX) = B - ID;
                     END;
                  END;
               ELSE
                  DO;
                     NDX = NDX + 1;
                     XX(NDX) = A;
                     YY(NDX) = B - ID;
                  END;
               IF  ((ID < 0)   &   (B  = 1))  |   ((ID > 0)   & (B = 6))  THEN
                  DO;
                     IF  BOARD((B - ID - ID), A)  = 0  THEN
                        DO;
                           NDX = NDX + 1;
                           XX(NDX) = A;
                           YY(NDX) = B - ID - ID;
                        END;
                  END;
            END;
      END;
   END PAWN;


BISHOP: PROCEDURE  (A, B, XX, YY, NDX) OPTIONS (REORDER);                                           
   DECLARE (A, B) FIXED BINARY (31);
   DECLARE (XX(0:26), YY(0:26)) FIXED BINARY (31);
   DECLARE NDX FIXED BINARY (31);
   DECLARE (ID, DXY, X, Y) FIXED BINARY;

   ID=SIGN(BOARD(B, A));
/* four diagonal directions                                              */
   DO DXY=1 TO  7;
      X=A-DXY; IF (X<0) THEN LEAVE;
      Y=B+DXY; IF (Y>7) THEN LEAVE;
      IF  ID^=SIGN(BOARD(Y, X))  THEN /*  cannot capture piece of same color */
         DO;
            NDX=NDX+1; XX(NDX)=X; YY(NDX)=Y;
         END;
      IF  BOARD(Y, X)^=0 THEN
         LEAVE   /*  cannot jump over pieces */;
   END;
   DO DXY=1 TO  7;
      X=A+DXY; IF (X>7) THEN LEAVE;
      Y=B+DXY; IF (Y>7) THEN LEAVE;
      IF  ID^=SIGN(BOARD(Y, X))  THEN
         DO;
            NDX=NDX+1; XX(NDX)=X; YY(NDX)=Y;
         END;
      IF  BOARD(Y, X)^=0 THEN
         LEAVE;
   END;
   DO DXY=1 TO  7;
      X=A-DXY; IF (X<0) THEN LEAVE;
      Y=B-DXY; IF (Y<0) THEN LEAVE;
      IF  ID^=SIGN(BOARD(Y, X))  THEN
         DO;
            NDX=NDX+1; XX(NDX)=X; YY(NDX)=Y;
         END;
      IF  BOARD(Y, X)^=0 THEN
         LEAVE;
   END;
   DO DXY=1 TO  7;
      X=A+DXY; IF (X>7) THEN LEAVE;
      Y=B-DXY; IF (Y<0) THEN LEAVE;
      IF  ID^=SIGN(BOARD(Y, X))  THEN
         DO;
            NDX=NDX+1; XX(NDX)=X; YY(NDX)=Y;
         END;
      IF  BOARD(Y, X)^=0 THEN
         LEAVE;
   END;
   END BISHOP;

ROOK: PROCEDURE  (A, B, XX, YY, NDX) OPTIONS (REORDER);                                             
   DECLARE (A, B) FIXED BINARY (31);
   DECLARE (XX(0:26), YY(0:26)) FIXED BINARY (31);
   DECLARE NDX FIXED BINARY (31);
   DECLARE (ID, X, Y) FIXED BINARY (31);

   ID=SIGN(BOARD(B, A));
/* four different orthagonal directions                                  */
   DO X = A-1 TO  0 BY  -1;
      IF  ID^=SIGN(BOARD(B, X))  THEN
         DO;
            NDX=NDX+1; XX(NDX)=X; YY(NDX)=B;
         END;
      IF  BOARD(B, X)^=0 THEN
         LEAVE;
   END;
   DO X = A+1 TO  7 BY  1;
      IF  ID^=SIGN(BOARD(B, X))  THEN
         DO;
            NDX=NDX+1; XX(NDX)=X; YY(NDX)=B;
         END;
      IF  BOARD(B, X)^=0 THEN
         LEAVE;
   END;
   DO Y = B-1 TO  0 BY  -1;
      IF  ID^=SIGN(BOARD(Y, A))  THEN
         DO;
            NDX=NDX+1; XX(NDX)=A; YY(NDX)=Y;
         END;
      IF  BOARD(Y, A)^=0 THEN
         LEAVE;
   END;
   DO Y = B+1 TO  7 BY  1;
      IF  ID^=SIGN(BOARD(Y, A))  THEN
         DO;
            NDX=NDX+1; XX(NDX)=A; YY(NDX)=Y;
         END;
      IF  BOARD(Y, A)^=0 THEN
         LEAVE;
   END;
   RETURN;
   END ROOK;


KNIGHT: PROCEDURE  (A, B, XX, YY, NDX) OPTIONS (REORDER);                                           
   DECLARE (A, B) FIXED BINARY (31);
   DECLARE (XX(0:26), YY(0:26)) FIXED BINARY (31);
   DECLARE NDX FIXED BINARY (31);
   DECLARE (ID, X, Y) FIXED BINARY (31);

   ID=SIGN(BOARD(B, A));
/* 2 vertical, 1 horizontal                                              */
/* or 2 horizontal, 1 vertical                                           */
   X=A-1; Y=B-2;
   IF  X>=0   &   Y>=0  THEN
      DO;
         IF  ID^=SIGN(BOARD(Y, X))  THEN
            DO;
               NDX=NDX+1; XX(NDX)=X; YY(NDX)=Y;
            END;
      END;
   X=A-2; Y=B-1;
   IF  X>=0   &   Y>=0  THEN
      DO;
         IF  ID^=SIGN(BOARD(Y, X))  THEN
            DO;
               NDX=NDX+1; XX(NDX)=X; YY(NDX)=Y;
            END;
      END;
   X=A+1; Y=B-2;
   IF  X<=7   &   Y>=0  THEN
      DO;
         IF  ID^=SIGN(BOARD(Y, X))  THEN
            DO;
               NDX=NDX+1; XX(NDX)=X; YY(NDX)=Y;
            END;
      END;
   X=A+2; Y=B-1;
   IF  X<=7   &   Y>=0  THEN
      DO;
         IF  ID^=SIGN(BOARD(Y, X))  THEN
            DO;
               NDX=NDX+1; XX(NDX)=X; YY(NDX)=Y;
            END;
      END;
   X=A-1; Y=B+2;
   IF  X>=0   &   Y<=7  THEN
      DO;
         IF  ID^=SIGN(BOARD(Y, X))  THEN
            DO;
               NDX=NDX+1; XX(NDX)=X; YY(NDX)=Y;
            END;
      END;
   X=A-2; Y=B+1;
   IF  X>=0   &   Y<=7  THEN
      DO;
         IF  ID^=SIGN(BOARD(Y, X))  THEN
            DO;
               NDX=NDX+1; XX(NDX)=X; YY(NDX)=Y;
            END;
      END;
   X=A+1; Y=B+2;
   IF  X<=7   &   Y<=7  THEN
      DO;
         IF  ID^=SIGN(BOARD(Y, X))  THEN
            DO;
               NDX=NDX+1; XX(NDX)=X; YY(NDX)=Y;
            END;
      END;
   X=A+2; Y=B+1;
   IF  X<=7   &   Y<=7  THEN
      DO;
         IF  ID^=SIGN(BOARD(Y, X))  THEN
            DO;
               NDX=NDX+1; XX(NDX)=X; YY(NDX)=Y;
            END;
      END;
   RETURN;
   END KNIGHT;

/* display chessboard                                                    */
SHOW: PROCEDURE OPTIONS (REORDER);                                                                  
   DECLARE (A, B) FIXED BINARY (31);

   DO B=0 TO  7;
      PUT SKIP EDIT ( '   +---+---+---+---+---+---+---+---+' )(COL(20), A);
      PUT SKIP EDIT ( 8-B, '  |' )(COL(20), F(1), A);
      DO A=0 TO  7;
         SELECT (BOARD(B, A));
            WHEN (-7500) PUT EDIT ( ' *k|' )(A);
            WHEN (-900)  PUT EDIT ( ' *q|' )(A);
            WHEN (-500)  PUT EDIT ( ' *r|' )(A);
            WHEN (-300)  PUT EDIT ( ' *b|' )(A);
            WHEN (-270)  PUT EDIT ( ' *n|' )(A);
            WHEN (-100)  PUT EDIT ( ' *p|' )(A);
            WHEN (0)     PUT EDIT ( '   |' )(A);
            WHEN (100)   PUT EDIT ( ' P |' )(A);
            WHEN (270)   PUT EDIT ( ' N |' )(A);
            WHEN (300)   PUT EDIT ( ' B |' )(A);
            WHEN (500)   PUT EDIT ( ' R |' )(A);
            WHEN (900)   PUT EDIT ( ' Q |' )(A);
            WHEN (5000)  PUT EDIT ( ' K |' )(A);
         END;
      END;
   END;
   PUT SKIP EDIT ( '   +---+---+---+---+---+---+---+---+' )(COL(20), A);
   PUT SKIP EDIT ( '     A   B   C   D   E   F   G   H'   )(COL(20), A);
   RETURN;
   END SHOW;

/* io -- input/output:                                                   */
/* display black move and get white move                                 */
IO: PROCEDURE  (A, B, X, Y, RES) OPTIONS (REORDER);                                                 
   DECLARE (A, B, X, Y, RES) FIXED BINARY (31);
   DECLARE ( INPUT ) CHARACTER (10);
   DECLARE (XX(0:26), YY(0:26), CC(0:26)) FIXED BINARY (31);
   DECLARE (I, K, NDX, PIECE, TARG, MOVER, C) FIXED BINARY (31);
   DECLARE NULL FIXED BINARY; /* This variable is assigned but never used. */
   DECLARE LETTER (0:7) CHAR (1) STATIC INITIAL
            ('A', 'B', 'C', 'D', 'E', 'F', 'G', 'H');

   DECLARE SL FIXED BINARY;

/* >>>>>>>>> CAUTION - WATCH FOR UNINITIALIZED XX, YY <<<<<<<<<<< */
   DECLARE ( WCKSOLD, WCQSOLD ) BIT(1) ALIGNED;

   ON ERROR SNAP BEGIN;
      PUT SKIP LIST ('at line ' || TRIM(SL) );
   END;

   SL = SOURCELINE();

   IF  A>=0  THEN
      DO;
         IF  RES<-2500  THEN
            DO;
               PUT SKIP LIST ( 'I RESIGN');
               CALL SHOW;
               PUT SKIP;
               STOP;
            END;
         PIECE=BOARD(Y, X);
         CALL MAKEMOVE(A, B, X, Y, C);
         PUT SKIP EDIT ( 'MY MOVE:  ' )(A);
         PUT      EDIT ( LETTER(A), 8-B, '-', LETTER(X), 8-Y)
            (A, F(1), A, A, F(1));

         SELECT (PIECE);
            WHEN (100)  PUT SKIP LIST ( 'I TOOK YOUR PAWN');
            WHEN (270)  PUT SKIP LIST ( 'I TOOK YOUR KNIGHT');
            WHEN (300)  PUT SKIP LIST ( 'I TOOK YOUR BISHOP');
            WHEN (500)  PUT SKIP LIST ( 'I TOOK YOUR ROOK');
            WHEN (900)  PUT SKIP LIST ( 'I TOOK YOUR QUEEN');
            WHEN (5000) PUT SKIP LIST ( 'I TOOK YOUR KING');
            OTHERWISE ;
         END;
      END;
DO_FOREVER1:
   DO FOREVER;
      CALL SHOW;
      PUT SKIP EDIT ( 'YOUR MOVE:  ' )(A);
RETRY_MOVE:
      GET EDIT (INPUT) (L);
      CALL UPCASE(INPUT);
      IF  (INPUT  = 'QUIT')  |   (INPUT  = 'BYE')  |   (INPUT  = 'EXIT')  THEN
         STOP;
      /* castling                                                        */
      IF  (INPUT = 'O-O')  |   (INPUT = '0-0')  THEN
         DO;
            IF  INCHECK() ^= 0 THEN
               ITERATE DO_FOREVER1; /*  cannot castle out of check */
            IF  WCKSFLAG THEN
               ITERATE DO_FOREVER1;
            IF  BOARD(7, 7) ^= 500 THEN
               ITERATE DO_FOREVER1;
            IF  (BOARD (7,6) ^= 0)  |   (BOARD(7,5) ^=0) THEN
               ITERATE DO_FOREVER1;
            BOARD(7, 4) = 0;
            BOARD(7, 5) = 5000;
            IF  INCHECK() ^= 0  THEN /*  cannot castle through check */
               DO;
                  BOARD(7, 4) = 5000;
                  BOARD(7, 5) = 0;
                  ITERATE DO_FOREVER1;
               END;
            ELSE
               DO;
                  BOARD(7, 4) = 5000;
                  BOARD(7, 5) = 0;
               END;
            BOARD(7, 6) = 5000;
            BOARD(7, 4) = 0;
            BOARD(7, 5) = 500;
            BOARD(7, 7) = 0;
            IF  INCHECK() ^= 0  THEN /*  cannot castle into check */
               DO;
                  BOARD(7, 6) = 0;
                  BOARD(7, 4) = 5000;
                  BOARD(7, 5) = 0;
                  BOARD(7, 7) = 500;
                  ITERATE DO_FOREVER1;
               END;
            ELSE
               DO;
                  WCKSFLAG =  '1'B;
                  WCQSFLAG =  '1'B;
                  RETURN;
               END;
         END;
      IF  (INPUT  = 'O-O-O')  |   (INPUT  = '0-0-0')  THEN
         DO;
            IF  INCHECK() ^= 0 THEN
               ITERATE DO_FOREVER1; /*  cannot castle out of check */
            IF  WCQSFLAG THEN
               ITERATE DO_FOREVER1;
            IF  BOARD(7,0) ^= 500 THEN
               ITERATE DO_FOREVER1;
            IF  (BOARD(7,1) ^= 0)  |   (BOARD(7,2) ^= 0)  | (BOARD(7,3) ^= 0) THEN
               ITERATE DO_FOREVER1;
            BOARD(7, 4) = 0;
            BOARD(7, 3) = 5000;
            IF  INCHECK() ^= 0  THEN /*  cannot castle through check */
               DO;
                  BOARD(7, 4) = 5000;
                  BOARD(7, 3) = 0;
                  ITERATE DO_FOREVER1;
               END;
            ELSE
               DO;
                  BOARD(7, 4) = 5000;
                  BOARD(7, 3) = 0;
               END;
            BOARD(7, 2) = 5000;
            BOARD(7, 4) = 0;
            BOARD(7, 3) = 500;
            BOARD(7, 0) = 0;
            IF  INCHECK() ^= 0  THEN /*  cannot castle into check */
               DO;
                  BOARD(7, 2) = 0;
                  BOARD(7, 4) = 5000;
                  BOARD(7, 3) = 0;
                  BOARD(7, 0) = 500;
                  ITERATE DO_FOREVER1;
               END;
            ELSE
               DO;
                  WCKSFLAG =  '1'B;
                  WCQSFLAG =  '1'B;
                  RETURN;
               END;
         END;

      /* Check that only the proper letters A-H etc are used. */
      /* (this does not check that the letters are in their correct columns.) */
      I = VERIFY (TRIM(INPUT), 'ABCDEFGHO0-12345678');
      IF I > 0 THEN
         DO;
            PUT SKIP LIST ('That move was invalid. Please try again:');
            GO TO RETRY_MOVE;
         END;

      SL = SOURCELINE();

      /* (A,B) are co-ordinates of the from position.        */
      /* (X,Y) are co-ordinates of the destination position. */

      /* Translate algebraic notation to co-ordinates. */

      B = 8 - INDEX ('12345678', SUBSTR(INPUT, 2, 1) );
      A = INDEX ('ABCDEFGH', SUBSTR(INPUT, 1, 1) ) - 1;
      X = INDEX ('ABCDEFGH', SUBSTR(INPUT, 4, 1) ) - 1;
      Y = 8 - INDEX ('12345678', SUBSTR(INPUT, 5, 1) );

      PUT SKIP DATA (A, B);
      PUT SKIP DATA (X, Y);
      STOP;
      IF  B>7 | B<0 | A>7 | A<0 | X>7 | X<0 | Y>7 | Y<0 THEN
         DO;
            PUT SKIP LIST ('Illegal move. Please try again');
            ITERATE DO_FOREVER1;
         END;
      IF  BOARD(B,A)<=0 THEN
         ITERATE DO_FOREVER1;
      /* en passant capture                                              */
      IF  (Y  = 2)   &   (B  = 3)   &   ((X  = A-1)  |   (X  = A+1))  THEN
         DO;
            IF (BOARD(B,A) = 100) & (BOARD(Y,X) = 0) & (BOARD(Y+1,X) =-100) THEN
               DO;
                  IF  (BESTB(1)  = 1)   &   (BESTA(1)  = X)  THEN
                     DO;
                        MOVER = BOARD(B,A);
                        TARG = BOARD(Y,X);
                        CALL MAKEMOVE(A,B,X,Y,C);
                        BOARD(Y+1,X)=0;
                        IF  (INCHECK())  = 0 THEN
                           RETURN;
                        BOARD(B,A) = MOVER;
                        BOARD(Y, X) = TARG;
                        BOARD(Y+1,X) = -100;
                        ITERATE DO_FOREVER1;
                     END;
               END;
         END;
     /* check if selected white move is on list of moves */
      CALL MOVELIST(A, B, XX, YY, CC, NDX);
DOK_LOOP:
      DO K = 0 TO  NDX BY  1;
         IF  (X  = XX(K))   &   (Y  = YY(K))  THEN
            DO;
               MOVER = BOARD(B, A);
               TARG = BOARD(Y, X);
               IF  Y  = 0  THEN
FOREVER_LOOP:
                  DO FOREVER;
                     PUT SKIP EDIT ( 'PROMOTION PIECE: ' )(A);
                     GET EDIT (INPUT) (L);
                     CALL UPCASE(INPUT);
                     SELECT (INPUT);
                        WHEN ('N', 'KT', 'KNIGHT', 'HORSE') C = 270;
                        WHEN ('B', 'BISHOP')                C = 300;
                        WHEN ('R', 'ROOK')                  C = 500;
                        WHEN ('Q', 'QUEEN')                 C = 900;
                        OTHERWISE ITERATE;
                     END;
                     LEAVE FOREVER_LOOP;
                  END;
               CALL MAKEMOVE(A, B, X, Y, C);
               IF  MOVER  = 5000  THEN
                  DO;
                     WCQSOLD = WCQSFLAG;
                     WCKSOLD = WCKSFLAG;
                     WCKSFLAG =  '1'B;
                     WCQSFLAG =  '1'B;
                  END;
               IF  (A  = 0)   &   (B  = 7)   &   (MOVER  = 500)  THEN
                  DO;
                     WCQSOLD = WCQSFLAG;
                     WCQSFLAG =  '1'B;
                  END;
               IF  (A  = 7)   &   (B  = 7)   &   (MOVER  = 500)  THEN
                  DO;
                     WCKSOLD = WCKSFLAG;
                     WCKSFLAG =  '1'B;
                  END;
               IF  INCHECK()  = 0 THEN
                  RETURN;
               BOARD(B, A) = MOVER;
               BOARD(Y, X) = TARG;
               IF  MOVER  = 5000  THEN
                  DO;
                     WCQSFLAG = WCQSOLD;
                     WCKSFLAG = WCKSOLD;
                  END;
               IF  (A  = 0)   &   (B  = 7)   &   (MOVER  = 500)  THEN
                  WCQSFLAG = WCQSOLD;
               IF  (A  = 7)   &   (B  = 7)   &   (MOVER  = 500)  THEN
                  WCKSFLAG = WCKSOLD;
               LEAVE DOK_LOOP;
            END;
      END;
   END;
END IO;

/* convert string to uppercase                                           */
UPCASE: PROCEDURE  (STRING) OPTIONS (REORDER);                                                      
   DECLARE ( STRING ) CHARACTER (*);

   STRING = TRANSLATE (STRING, 'ABCDEFGHIJKLMNOPQRSTUVWXYZ',
                               'abcdefghijklmnopqrstuvwxyz' );

END UPCASE;

END CHESS;