{$CHECK-    this disables subscript and subrange checking }

{$BOX

  This program plays a weak game of chess.
  It will accept moves from the player and check them for legality before it
  allows the move.  When the user is asked for a move, he may also change the
  skill level, swap sides, get help, or quit.  The computer will then take its
  turn after the person has entered a legal move.  Before each move, the
  program will check for a stalemate or checkmate situation.

  ROOM FOR IMPROVEMENT:
  The en passant move could be checked for and allowed as input.
  Also, the computer doesn't consider this move when it is deciding what to
  play.  The game could keep track of moves so the game could be printed out
  when it's over or perhaps moves could be taken back and replayed.  Finally,
  the program is very weak (read 'random') when it is ahead in the end game.
  A different scoring mechanism would be needed to have the program make moves
  intelligently as it uses purely material scoring now.
  
$EBOX}

{$BOX

  The program uses the "terminal independent" routines which appear in the
  .sys:virtualterm.pascal file to do all terminal output.  This allows chess
  to be played on H1510s, H1500s, Omrons, etc.  All the output is done 
  through procedures which will place messages at the proper place on the
  screen.  For instance, there is a procedure to output a message to the
  line which is dedicated to printing error messages.  Once the chess board
  is drawn initially (or after a board SWAP) the board isn't redrawn; only
  squares which are affected by a move are redrawn.

$EBOX}

program chess(input,output);  { oh no! }

const BOARDLINE    =  2;  { origin of upper-left part of chess board }
      BOARDCOL     =  0;
      PLAYERLINE   = 16;  { origin of player prompt area }
      PLAYERCOL    = 45;
      COMPUTERLINE =  5;  { origin of computer response area }
      COMPUTERCOL  = 45;
      LEVELLINE    = 10;  { line which skill level is printed on }
      LEVELCOL     = 45;
      CHECKLINE    = 20;  { line which check status is printed on }
      ERRORLINE    = 21;  { line which error info is printed on }

      DISABLEECHO  =  0;  { disable auto echo operation }
      ENABLEECHO   =  3;  { normal echo operation }

type colortype = (black, white, none);
     kindtype  = (King, Queen, Rook, Bishop, Knight, Pawn);

     piecetype = record
                    color : colortype;
                    kind  : kindtype;
                 end; { piecetype }

     boardtype = array [1..8, 1..8] of piecetype;

     stringType  = string[80];
{ Terminal 'independent' routines }

TYPE TerminalType               = (Omron, Omron4, DM1521, H1510, H1500,
                                          TV920C, TV925, MicroB1, Undefined);

  
PROCEDURE Beep(Var OutputFile : Text);
BEGIN { Beep}
   { The following line contains a control-G }
   format(output,'*'); { don't cause linefeed }
   Writeln('');
END; { Beep }


PROCEDURE Capitalize(VAR InputString              : StringType);
  VAR CharIndex                                   : Integer;
  BEGIN  {Capitalize}
    FOR CharIndex := 1 to Length(InputString) DO
      IF (InputString[CharIndex] >= 'a') and (InputString[CharIndex] <= 'z')
         THEN InputString[CharIndex] :=
                 CHR( ORD(InputString[CharIndex]) + ORD('A') - ORD('a') );
  END;   {Capitalize}


PROCEDURE GetKindOfTerminal(VAR OutputType          : TerminalType;
                            VAR InputFile           : Text;
                            VAR OutputFile          : Text);


  VAR InputString                                   : StringType;

  BEGIN  {GetKindOfTerminal}
    GetSessionVar('TerminalName',InputString);
    OutputType := Undefined;
    LOOP  {Loop until valid terminal found}
      Capitalize(InputString);
      IF InputString = 'TV920C' THEN OutputType := TV920C;
      IF InputString = 'TV925' THEN OutputType := TV925;
      IF InputString = 'OMRON' THEN OutputType := Omron;
      IF InputString = 'OMRON4' THEN OutputType := Omron4;
      IF InputString = 'H1510' THEN OutputType := H1510;
      IF InputString = 'H1500' THEN OutputType := H1500;
      IF (InputString = 'MICROB') OR (InputString = 'MICROB1') THEN OutputType := MicroB1;
      IF InputString = 'DM1521' THEN OutputType := DM1521;
      WHEN OutputType <> Undefined EXIT;
      writeln(OutputFile,'Valid terminal types are DM1521, H1500, H1510, MicroB1, Omron, Omron4,');
      writeln(OutputFile,'         TV920C, and TV925.');
      Format(OutputFile,'*');
      writeln(OutputFile,'What is the terminal type? ');
      Readln(InputFile,InputString);
      WHEN InputString = '' EXIT;
    END;  {Loop until valid terminal found}
  END;   {GetKindOfTerminal}

PROCEDURE SetEchoMode(VAR OutputFileName        : Text;
                          NewEchoMode           : Integer);

  CONST FrTSetEcho = 16#118;   {FREQ code for setting terminal echo mode}

  VAR R0, R1, R2, R3                            : Integer;
      TerminalUnitNumber                        : Integer;

  BEGIN  {SetEchoMode}
    GetUnit(OutputFileName,TerminalUnitNumber);
    R0 := FrTSetEcho;
    R1 := NewEchoMode;
    Freq(R0,R1,R2,R3,TerminalUnitNumber);
  END;   {SetEchoMode}

PROCEDURE TerminalOutputDelay(    MillisecondsToDelay     : Integer;
                              VAR OutputFile              : Text);

  CONST FRTDelay   = 16#1B4;
  VAR R0, R1, R2, R3                            : Integer;
      OutputFileUnitNum                         : Integer;
   
  BEGIN  {TerminalOutputDelay}
    GetUnit(OutputFile,OutputFileUnitNum);
    R0 := FRTDelay;
    R1 := MillisecondsToDelay;
    Freq(R0, R1, R2, R3, OutputFileUnitNum);
  END;   {TerminalOutputDelay}

PROCEDURE HomeAndClearScreen(    InputTermType         : TerminalType;
                             VAR OutputFile            : Text);
  BEGIN  {HomeAndClearScreen}
    format(OutputFile,'*');
    CASE InputTermType OF
      DM1521        : writeln(OutputFile,'');
      H1500         : writeln(OutputFile,'~','');
      H1510         : writeln(OutputFile,'','');
      MicroB1       : writeln(OutputFile,'','H','','J');
      TV920C, TV925 : BEGIN
                         writeln(OutputFile,Chr(30),'Y');
                         TerminalOutputDelay(10,OutputFile);
                      END;
      Omron, Omron4 : BEGIN
                         writeln(OutputFile,'','H');
                         TerminalOutputDelay(40,OutputFile);
                         format(OutputFile,'*');
                         writeln(OutputFile,'','J');
                         TerminalOutputDelay(175,OutputFile);
                      END
    END;  {case}
  END;   {HomeAndClearScreen}

PROCEDURE TerminalInitialClear(    InputTermType         : TerminalType;
                               VAR OutputFile            : Text);

  BEGIN  {TerminalInitialClear}
    CASE InputTermType OF
      DM1521        : ;
      H1500         : ;
      H1510         : ;
      MicroB1       : ;
      TV920C, TV925 : ;
      Omron         : BEGIN 
                        format(OutputFile,'*');
                        write(OutputFile,'','V','','U');
                        TerminalOutputDelay(30,OutputFile);
                      END;
      Omron4        : BEGIN
                        format(OutputFile,'*');
                        writeln(OutputFile,'','V','','V','','V',
                                           '','U','','U','','U');
                        TerminalOutputDelay(250,OutputFile);
                      END
    END;  {case}
    HomeAndClearScreen(InputTermType,OutputFile);
  END;   {TerminalInitialClear}

PROCEDURE ClearToEndOfLine(    InputTermType         : TerminalType;
                           VAR OutputFile            : Text);
  BEGIN  {ClearToEndOfLine}
    format(OutputFile,'*');
    CASE InputTermType OF
      DM1521        : writeln(OutputFile,'');
      H1500         : BEGIN
                        writeln(OutputFile,'~','');
                        TerminalOutputDelay(5,OutputFile);
                      END;
      H1510         : BEGIN
                        writeln(OutputFile,'','');
                        TerminalOutputDelay(4,OutputFile);
                      END;
      MicroB1       : writeln(OutputFile,'','K');
      TV925, TV920c : BEGIN
                        writeln(OutputFile,'','T');
                        TerminalOutputDelay(10,OutputFile);
                      END;
      Omron, Omron4 : BEGIN
                        writeln(OutputFile,'','K');
                        TerminalOutputDelay(2,OutputFile);
                      END
    END;  {case}
  END;   {ClearToEndOfLine}

PROCEDURE PositionCursor(    InputTermType              : TerminalType;
                         VAR OutputFile                 : Text;
                             LineNumber                 : Integer;
                             ColumnNumber               : Integer);
  BEGIN {PositionCursor}
    format(OutputFile,'*');
    CASE InputTermType OF
      DM1521        : writeln(OutputFile,'',CHR(ColumnNumber+32),CHR(LineNumber+32));
      H1500         : writeln(OutputFile,'~','',CHR(ColumnNumber),CHR(LineNumber));
      H1510         : writeln(OutputFile,'','',CHR(ColumnNumber),CHR(LineNumber));
      MicroB1       : writeln(OutputFile,'','Y',CHR(ColumnNumber+32),CHR(LineNumber+32));
      TV920C, TV925 : writeln(OutputFile,'','=',CHR(ColumnNumber+32),CHR(LineNumber+32));
      Omron         : BEGIN
                        LineNumber := LineNumber+25;
                        ColumnNumber := ColumnNumber+1;
                        writeln(OutputFile,'','}',
                                  CHR(64+(LineNumber div 16)),CHR(64+(LineNumber mod 16)),
                                  CHR(64+(ColumnNumber div 16)),CHR(64+(ColumnNumber mod 16)));
                      END;
      Omron4        : BEGIN
                        LineNumber := LineNumber+73;
                        ColumnNumber := ColumnNumber+1;
                        writeln(OutputFile,'','}',
                                  CHR(64+(LineNumber div 16)),CHR(64+(LineNumber mod 16)),
                                  CHR(64+(ColumnNumber div 16)),CHR(64+(ColumnNumber mod 16)));
                      END
    END; {case}
  END;  {PositionCursor}
{ global variables }

var
     pieceWeight : array[King..Pawn] of integer;
     { pieceWeight is used to give value to a piece.  
       It is used by the scoring mechanism to evaluate board strength. }

     MAXDEPTH : integer;
     { MAXDEPTH is used to tell the program when to stop searching
       the game tree.  MAXDEPTH is usually 1 to 4, although there is
       no upper limit (it would just take too long). }

     NumberOfMoves : integer;
     { NumberOfMoves is used to keep track of how many moves have been
       considered while looking for the best.  It was used initially for
       debugging but has been kept for trivia's sake. }

     TypeOfTerminal : TerminalType;
     { This is an enumerated type which the "terminal independent" routines
       need.  It contains the type of terminal, eg. H1510 }

     ColumnName : array[1..8] of char;
     { This is used to map a column index to its user name ('A'..'H').
       It is used only for outputting. }

     var WhiteCastleInfo, BlackCastleInfo, TempCastleInfo
              : record
                   RookAMovedYet, RookHMovedYet, KingMovedYet : boolean;
                end; { record }
{ unbuffered I/O }

{ This routine accepts one character as a parameter and prints it at
  the current cursor location.  It will leave the cursor one position
  beyond where it came in. }

Procedure putchar(ch : char);
begin
   format(output,'*');
   writeln(ch);
end; { procedure putchar }


{ This routine will return a single character read from the keyboard.
  The routine will return without having to wait for a CR (eol).  It
  works by defining all characters to be line terminators; thus, any
  character typed will cause the buffer to be flushed.                 }

Procedure getchar(var ch : char);

const SetTCS_Number = 16#011B;  { FRTSETTCS - set terminals terminating chars }
      SetTCG_Number = 16#011A;  { FRTSETTCG - set term terminating char group }
      ReadB_Number  = 16#0031;  { FRREADB - read a binary record              }
      UNIT_Number   = 201;      { This unit is the keyboard                   }
      
type string8 = string[32];
     stringptr = ^string8;

var strptr : stringptr;
    i      : integer;
    RR0    : integer;                   { Corresponds to hardware register R0 }
    RR1    : integer;                   { Corresponds to hardware register R1 }
    RR2    : integer;                   { Corresponds to hardware register R2 }
    RR3    : integer;                   { Corresponds to hardware register R3 }

begin
   new(strptr);
   for i := 1 to 32 do
      strptr^[i] := char(255);          { Initialize the buffer to all ones   }
   RR0 := SetTCS_Number;                { Load RR0 with FRTSETTCS number      }
   RR1 := ord(strptr) + 1;              { Load RR1 with address of string     }
   RR2 := 0;                            { Register is not used for this XREQ  }
   RR3 := 0;                            { Register is not used for this XREQ  }
   freq(RR0,RR1,RR2,RR3,UNIT_Number);   { Invoke the file executive request   }

   RR0 := SetTCG_Number;                { Load RR0 with FRTSETTCG number      }
   RR1 := 3;                            { Select user defined term char group }
   RR2 := 0;                            { Register is not used for this XREQ  } 
   RR3 := 0;                            { Register is not used for this XREQ  }
   freq(RR0,RR1,RR2,RR3,UNIT_Number);   { Invoke the file executive request   }

   RR0 := ReadB_Number;                 { Load RR0 with FReadB number         }
   RR1 := 32;                           { Load RR1 with # of bytes in string  }
   RR2 := ord(strptr) + 1;              { Load RR2 with address of string     }
   RR3 := 0;                            { Register is not used for this XREQ  }
   freq(RR0,RR1,RR2,RR3,UNIT_Number);   { Invoke the file executive request   }
   ch := char(RR2 iand 127);            { Convert terminator to a character   }

   dispose(strptr); { return space to heap }

end; { Procedure getchar }
{ various functions }

{ this function returns -1 if a<0, 0 if a=0, and +1 if a>0 }

function Sign( a : integer ) : integer;
begin
   If (a < 0) then      Sign := -1
   else If (a = 0) then Sign := 0
   else                 Sign := 1;
end; { function Sign }


{ this function returns the maximum of two integers }

function Max(a,b : integer) : integer;
begin
   If (a < b) then Max := b
              else Max := a;
end; { function Max }


{ This procedure reads up to MaxLen characters of input and returns
  them in Str.  It uses unbuffered input while it is reading the string.
  It is used to prevent the user from entering strings so long that it
  clobbers another part of the formatted display.                       }

procedure ReadLine(var Str : StringType; MaxLen : integer);

const BACKSPACE = 8;   { ascii value for backspace }
      CARRET    = 13;  { ascii value for carriage return }

var len : integer;
    done : boolean;
    ch : char;

begin
   len := 0;
   Str := '';  { initially empty }
   done := false;
   while (not done) do begin
      getchar(ch);

      if (ord(ch) = CARRET) then
         done := true

      else if (ord(ch) = BACKSPACE) then
         if (len > 0) then begin         { if the line isn't already empty }
            putchar(chr(BACKSPACE));     { then erase the last character   }
            putchar(' ');
            putchar(chr(BACKSPACE));
            If len=1 then Str := ''      { null string requires special handling }
                     else Str := Str[1..(len-1)];
            len := len - 1;
         end
         else { there is nothing to backspace over; do nothing }

      { accept only numbers or letters }
      else if ((((ch >= 'a') and (ch <= 'z')) or
              ((ch >= 'A') and (ch <= 'Z'))) or
              ((ch >= '0') and (ch <= '9'))) and
              (len < MaxLen)  then begin
                 len := len + 1;        { string is now one longer }
                 Str[len] := ch;        { add char to end of string }
                 putchar(ch);           { echo it }
           end;

   end; { while }

end; { procedure ReadLine }
{ formatted output routines }

{=======================================================================}

{ this routine simply puts the cursor in the upper left part of the screen }

procedure HomeCursor;

begin
   PositionCursor(TypeOfTerminal,output,0,0);
end; { procedure HomeCursor }

{=======================================================================}

{ This procedure prints the string passed to it at the Error message line.
  If the second parameter (bell) is TRUE, a bell will also be sent. }

procedure ErrorMessage(Message : StringType; bell : boolean);

begin
   PositionCursor(TypeOfTerminal,output,ERRORLINE,0);
   ClearToEndOfLine(TypeOfTerminal,output);
   writeln(Message);
   if bell then
      Beep(Output);
end; { procedure ErrorMessage }

{=======================================================================}

{ This procedure prints the message on the first player prompt line.
  If the cursor should stay at the end of the message, the second
  parameter (hold) should be true.  If it is false, the cursor will  
  go to the upper left corner of the screen.                        }

procedure PlayerPrompt1(Message : StringType; hold : boolean);
begin
   PositionCursor(TypeOfTerminal,output,PLAYERLINE,PLAYERCOL);
   ClearToEndOfLine(TypeOfTerminal,output);
   if hold then
      format(output,'*');
   writeln(Message);
   if not hold then
      HomeCursor;
end; { procedure PlayerPrompt1 }

{=======================================================================}

{ This procedure prints the message on the second player prompt line.
  If the cursor should stay at the end of the message, the second
  parameter (hold) should be true.  If it is false, the cursor will  
  go to the upper left corner of the screen.                        }

procedure PlayerPrompt2(Message : StringType; hold : boolean);
begin
   PositionCursor(TypeOfTerminal,output,PLAYERLINE+1,PLAYERCOL);
   ClearToEndOfLine(TypeOfTerminal,output);
   if hold then
      format(output,'*');
   writeln(Message);
   if not hold then
      HomeCursor;
end; { procedure PlayerPrompt2 }

{=======================================================================}

{ This procedure prints the string passed to it at the CheckStatus line.
  If the second parameter (bell) is TRUE, a bell will also be sent. }

procedure CheckStatus(Message : StringType; bell : boolean);

begin
   PositionCursor(TypeOfTerminal,output,CHECKLINE,0);
   ClearToEndOfLine(TypeOfTerminal,output);
   writeln(Message);
   if bell then
      Beep(Output);
end; { procedure CheckStatus }

{=======================================================================}

{ This procedure prints the message on the computer's first prompt line.
  If the cursor should stay at the end of the message, the second
  parameter (hold) should be true.  If it is false, the cursor will  
  go to the upper left corner of the screen.                        }

procedure OurStatus1(Message : StringType; hold : boolean);
begin
   PositionCursor(TypeOfTerminal,output,COMPUTERLINE,COMPUTERCOL);
   ClearToEndOfLine(TypeOfTerminal,output);
   if hold then
      format(output,'*');
   writeln(Message);
   if not hold then
      HomeCursor;
end; { procedure OurStatus1 }

{=======================================================================}

{ This procedure prints the message on the computer's first prompt line.
  If the cursor should stay at the end of the message, the second
  parameter (hold) should be true.  If it is false, the cursor will  
  go to the upper left corner of the screen.                        }

procedure OurStatus2(Message : StringType; hold : boolean);
begin
   PositionCursor(TypeOfTerminal,output,COMPUTERLINE+1,COMPUTERCOL);
   ClearToEndOfLine(TypeOfTerminal,output);
   if hold then
      format(output,'*');
   writeln(Message);
   if not hold then
      HomeCursor;
end; { procedure OurStatus2 }

{=======================================================================}

{ This procedure prints the current skill level at the proper place }

procedure PrintLevel(level : integer);
begin
   PositionCursor(TypeOfTerminal,output,LEVELLINE,LEVELCOL);
   ClearToEndOfLine(TypeOfTerminal,output);
   writeln('Skill Level = ',level:1);
end; { procedure PrintLevel }
procedure HelpThePoorSap;

{ This simply fills one screen with help info and waits for the user
  to hit carriage return. }

const CARRET = 13; { ascii carriage return }

var ch : char;     { used to wait for carriage return }

begin
   HomeAndClearScreen(TypeOfTerminal,output);
   writeln('I have to assume you know the basic rules of chess.');
   writeln('This version of chess plays at a mediocre level because it is');
   writeln('written in Pascal and is therefore slow.  You have the option of');
   writeln('trading speed for intelligence at any point.');
   writeln('Level 1<1 second, level 2=3 seconds, level 3=45 seconds, level 4=15 minutes.');
   writeln('The actual amount of time will vary on the complexity of the situation.');
   writeln;
   writeln('The COMMANDS are:');
   writeln;
   writeln('HELP, COMMANDS      --- to get this message');
   writeln('L1, L2, L3 or L4    --- to change the skill level');
   writeln('SWAP                --- to change sides');
   writeln('QUIT, EXIT          --- to end the game early');
   writeln('c1r1c2r2            --- to move from column1,row1 to column2,row2');
   writeln;
   writeln('c1 and c2 are entered by the letter appearing above the desired column.');
   writeln('r1 and r2 are entered by the number appearing to the left of the desired row.');
   writeln('For instance, you might move "d7d5" to open the game.');
   writeln('To castle just enter the coordinates for the king''s move.');
   writeln;

   format(output,'*');
   writeln('(Hit a <CR> to resume the game)');
   { wait for a carriage return }
   repeat
      getchar(ch)
   until (ord(ch) = CARRET);

end; { procedure HelpThePoorSap }
procedure Initialize(var board : boardtype);

var index : 1..8;
    inner : 3..6;
    seed  : real;

begin

   { do the things we need to do for terminal independence }
   GetKindOfTerminal(TypeOfTerminal,input,output);
   SetEchoMode(output,DISABLEECHO); { turn of auto echo }
   TerminalInitialClear(TypeOfTerminal,output);

   { set up the game board }
   for index := 1 to 8 do begin
      board[1,index].color := black;
      board[2,index].color := black;
      board[2,index].kind  := Pawn;
      board[3,index].color := none;
      board[4,index].color := none;
      board[5,index].color := none;
      board[6,index].color := none;
      board[7,index].kind  := Pawn;
      board[7,index].color := white;
      board[8,index].color := white;
   end; { for index }

   board[1,1].kind := Rook;        board[8,1].kind := Rook;
   board[1,2].kind := Knight;      board[8,2].kind := Knight;
   board[1,3].kind := Bishop;      board[8,3].kind := Bishop;
   board[1,4].kind := Queen;       board[8,4].kind := Queen;
   board[1,5].kind := King;        board[8,5].kind := King;
   board[1,6].kind := Bishop;      board[8,6].kind := Bishop;
   board[1,7].kind := Knight;      board[8,7].kind := Knight;
   board[1,8].kind := Rook;        board[8,8].kind := Rook;

   { set up piece weights based for scoring function }
   pieceWeight[King]   :=20000;
   pieceWeight[Queen]  :=    9;
   pieceWeight[Bishop] :=    3;
   pieceWeight[Knight] :=    3;
   pieceWeight[Rook  ] :=    5;
   pieceWeight[Pawn  ] :=    1;

   { initialize castling info }
   with WhiteCastleInfo do begin
      RookAMovedYet := false;
      RookHMovedYet := false;
      KingMovedYet  := false;
      end;

   with BlackCastleInfo do begin
      RookAMovedYet := false;
      RookHMovedYet := false;
      KingMovedYet  := false;
      end;

   { initialize the random number generator }
   GetRawDate(seed);
   seed := Random(seed);

   { set up default depth }
   MAXDEPTH := 2;

   { set up the column name array }
   ColumnName[1] := 'A';
   ColumnName[2] := 'B';
   ColumnName[3] := 'C';
   ColumnName[4] := 'D';
   ColumnName[5] := 'E';
   ColumnName[6] := 'F';
   ColumnName[7] := 'G';
   ColumnName[8] := 'H';

end; { procedure Initialize }
procedure WritePiece(piece : piecetype);

{ This procedure will print out the color and piece type of the piece
  passed to it, e.g. if piece.color = black and piece.kind = bishop the
  this routine will print out 'BB'.                                    }

begin

   case piece.color of
      black : write('B');
      white : write('W');
      none  : write('  ');
   end; { case }

   If (piece.color <> none) then
      case piece.kind of
          King   : write('K');
          Queen  : write('Q');
          Rook   : write('R');
          Bishop : write('B');
          Knight : write('N');
          Pawn   : write('P');
      end; { case }

end; { procedure WritePiece }
procedure WriteSquare(board : boardtype; row,col : integer);

{ This procedure simply prints the contents of the specified board location
  at the proper location on the screen }

begin

   PositionCursor(TypeOfTerminal,output,BOARDLINE+row*2,BOARDCOL-1+5*col);
   WritePiece(board[row,col]);
   writeln; { this is because the output buffer isn't flushed until writeln }

end; { procedure WriteSquare }
procedure PrintBoard(board : boardtype);

{ This procedure clears the screen and prints out the entire contents of
  the board. }

var row, col : 1..8;  { loop indexes }

begin

   HomeAndClearScreen(TypeOfTerminal,output);
   PositionCursor(TypeOfTerminal,output,0,22);
   writeln('==== The Ancient Game of Chess ====');

   PositionCursor(TypeOfTerminal,output,BOARDLINE,BOARDCOL);
   writeln('     A    B    C    D    E    F    G    H');
   writeln('  +----+----+----+----+----+----+----+----+');
   for row := 1 to 8 do begin
       write(row:1,' | ');
       for col := 1 to 8 do begin
           WritePiece(board[row,col]);
           write(' | ')
       end; { for col }
       writeln;
       writeln('  +----+----+----+----+----+----+----+----+');
   end; { for row }

end; { procedure PrintBoard }
procedure SwapSides(var board : boardtype);

{ This procedure switches the sides the white and black pieces are on.
  The move is done by exchanging pieces as if a mirror were running 
  between rows 4 and 5.  The reason the board isn't rotated is that
  the queen should initially be on her own color.  If the board was
  rotated the white queen would end up on black and vice versa.       }

var newboard : boardtype;  { used during the swap as a temporary }
    row, col : integer;    { loop indexes }

begin

   for row := 1 to 8 do
      for col := 1 to 8 do

         case board[row,col].color of

            black : begin
                       newboard[9-row,col].color := white;
                       newboard[9-row,col].kind  := board[row,col].kind;
                    end;

            white : begin
                       newboard[9-row,col].color := black;
                       newboard[9-row,col].kind  := board[row,col].kind;
                    end;

            none  : newboard[9-row,col].color := none;

         end; { case }

   board := newboard;

   { swap castling info }
   TempCastleInfo := WhiteCastleInfo;
   WhiteCastleInfo := BlackCastleInfo;
   BlackCastleInfo := TempCastleInfo;

end;  { procedure SwapSides }
procedure ChangeLevel(Command : StringType);

{ This procedure accepts a command to change the level of intelligence.
  It checks to see that the command is well formed and in bounds.  The
  constraint that level<=4 is hardwired. }

var level : integer;

begin

   If (length(Command) <> 2) then
      ErrorMessage('Level command is of form: L<level>, level=1,2,3 or 4)',true)

   else begin
      level := ord(Command[2])-ord('0');
      if (level < 1) or (level > 4) then
         ErrorMessage('Level command is of form: L<level>, level=1,2,3 or 4)',true)
      else
         MAXDEPTH := level;  { change the search depth }
   end;

end; { procedure ChangeLevel }
procedure Move(var board : boardtype;
               FromRow, FromCol, ToRow, ToCol : integer;
               var score : integer);

{ This will move a piece from one square to another.  It does not do any
  checking of legality.

  For the sake of speed, score is kept while the moves are made.  Rather than
  totaling up the pieces when we are at the bottom of the game tree, we
  adjust the score as pieces are removed.  This is much quicker. }

begin

   { adjust score }
   with board[ToRow,ToCol] do
      case color of
         { note : the signs are reversed for black and white because
                  this piece is being removed from the board }

         black : score := score + pieceWeight[kind];

         white : score := score - pieceWeight[kind];

         none  : { who cares } ;

      end; { case of color }

   { reward pawn promotions }
   if (ToRow = 8) and (board[FromRow,FromCol].kind = pawn) then { pawn promotion }
      score := score - pieceWeight[queen]
   else if (ToRow = 1) and (board[FromRow,FromCol].kind = pawn) then { pawn promotion }
      score := score + pieceWeight[queen];

   { make the move }
   board[ToRow,ToCol].color := board[FromRow,FromCol].color;
   board[ToRow,ToCol].kind  := board[FromRow,FromCol].kind;
   board[FromRow,FromCol].color := none;

   { Increment global move counter; used for trivia only }
   NumberOfMoves := NumberOfMoves + 1;

end; { procedure Move }
procedure VisualMove(var board : boardtype;
               FromRow, FromCol, ToRow, ToCol : integer);

{ This will move a piece from one square to another.  It does not do any
  checking of legality.  It displays the move on the screen. }

begin

   { update status as to whether or not white can castle (black never tries) }
   If (FromRow = 8) and (FromCol = 1) then 
      WhiteCastleInfo.RookAMovedYet := true;
   If (FromRow = 8) and (FromCol = 8) then 
      WhiteCastleInfo.RookHMovedYet := true;
   If (FromRow = 8) and (FromCol = 5) then 
      WhiteCastleInfo.KingMovedYet := true;
   { We must also check dest because black could take a rook and white's
     other rook could move there.  It would then appear that castling to
     that side is still OK. }
   If (ToRow = 8) and (ToCol = 1) then 
      WhiteCastleInfo.RookAMovedYet := true;
   If (ToRow = 8) and (ToCol = 8) then 
      WhiteCastleInfo.RookHMovedYet := true;

   board[ToRow,ToCol].color := board[FromRow,FromCol].color;
   board[ToRow,ToCol].kind  := board[FromRow,FromCol].kind;
   board[FromRow,FromCol].color := none;

   WriteSquare(board,FromRow,FromCol);    { erase FROM square }
   WriteSquare(board,ToRow,ToCol);        { update TO square }

   { move the cursor out of the way }
   HomeCursor;


end; { procedure VisualMove }
function InCheck(board:boardtype; KingColor : colortype) : boolean;

{ This function will return true if the king with KingColor color is
  in check and false otherwise. }

var KingRow, KingCol : integer;      { location of king with KingColor color }
    row, col : integer;              { coordinates of pieces which might attack }
    check, done : boolean;
    opponent : colortype;            { color opposite of KingColor }
    delta : integer;                 { direction of moves for KingColor pawns }
    deltaRow, deltaCol : integer;    { direction vectors }
    rookMove, bishopMove : boolean;  { flags to indicate if vector is of
                                       the type for that piece }
begin

   check := false;

   If (KingColor = white) then begin
      opponent := black;
      delta := -1;
      end
   else begin
      opponent := white;
      delta := +1;
   end; { if }

   { find out where the king with KingColor color is }
   for row := 1 to 8 do
      for col := 1 to 8 do
         if (board[row,col].color = KingColor ) then
            if (board[row,col].kind = king ) then
               begin
                  KingRow := row;
                  KingCol := col;
               end;

   { Rather than moving all the opponent's pieces in all legal moves to
     see if one of them is attacking the KingColor king, it is easier to
     work backwards from the KingColor king to see if there is a piece
     attacking it.  This is the general method used by all the following 
     routines. }

   { See if any queens, rooks, or bishops can attack.

     deltaRow and deltaCol generate all the 8 direction vectors away from
     the king (the 0,0 vector is excluded).  This vector is added repetatively
     until it leads off the board or a piece is reached.  If a piece is
     reached and it is the opponent color and it can travel the path that 
     deltaRow and deltaCol traced out then the king is in check. }

   for deltaRow := -1 to 1 do
      for deltaCol := -1 to 1 do
         if (deltaRow <> 0) or (deltaCol <> 0) then begin
            rookMove := (deltaRow*deltaCol = 0);
            bishopMove := (deltaRow <> 0) and (deltaCol <> 0);
            row := KingRow;
            col := KingCol;
            done := ((row+deltaRow < 1) or (row+deltaRow > 8)) or
                    ((col+deltaCol < 1) or (col+deltaCol > 8));
            while (not done) do begin
               row := row + deltaRow;
               col := col + deltaCol;
               with board[row,col] do begin
                  done := (((row+deltaRow < 1) or (row+deltaRow > 8)) or
                          ((col+deltaCol < 1) or (col+deltaCol > 8))) or
                          (color <> none);
                  if (color = opponent) then
                     if (kind = queen) then
                        check := true
                     else if (kind = rook) and rookMove then
                        check := true
                     else if (kind = bishop) and bishopMove then
                        check := true
               end; { with }
            end; { while }
         end; { if }


   { Check if any knights can attack }
   for deltaRow := -2 to 2 do
      for deltaCol := -2 to 2 do
         if (deltaRow*deltaCol <> 0) and (ABS(deltaRow) <> ABS(deltaCol))
            then begin
               row := KingRow + deltaRow;
               col := KingCol + deltaCol;
               if ((row >= 1) and (row <= 8)) and
                  ((col >= 1) and (col <= 8)) then
                  with board[row,col] do
                     if (color = opponent) then
                        check := check or (kind = knight);
            end; { if }


   { See if a pawn is attacking (only on diagonal) }
   row := KingRow + delta;
   col := KingCol - 1;
   If (col >= 1) and ((row >= 1) and (row <=8)) then
      with board[row,col] do
         if (color = opponent) then
            check := check or (kind = pawn);

   row := KingRow + delta;
   col := KingCol + 1;
   If (col <= 8) and ((row >= 1) and (row <=8)) then
      with board[row,col] do
         if (color = opponent) then
            check := check or (kind = pawn);


   { Finally, see if the other king is attacking }
   for row := KingRow-1 to KingRow+1 do
      for col := KingCol-1 to KingCol+1 do
         If ((row >= 1) and (row <= 8)) and ((col >= 1) and (col <= 8)) then
            with board[row,col] do
               if (color = opponent) then
                  check := check or (kind = king);


   InCheck := check;

end; { function InCheck }
function LegalMove(board : boardtype;
                   FromRow, FromCol, ToRow, ToCol : integer;
                   var Reason : StringType;
                   var castling : boolean) : boolean;

{ This function returns true if the move from (FromRow,FromCol) to
  (ToRow,ToCol) can be made legally on board 'board'.  If the move is
  illegal, then the function returns false and the reason why the move
  is illegal is returned in the Reason string. }

{==========================================================================}
{ these are the functions to evaluate the legality depending on piece type }

function CheckLegalKing(board : boardtype;
                     FromRow, FromCol, ToRow, ToCol : integer;
                     var Reason : StringType;
                     var castling : boolean) : boolean;

var NoGood : boolean;
    localboard : boardtype;
    dummy : integer;

begin

   NoGood := false;
   castling := false; { default }

   { see if it is a castling move }
   If ((FromRow = 8) and (FromCol = 5))
    and ((ToRow = 8) and (ABS(FromCol-ToCol) = 2)) then begin
      castling := true;
      If (WhiteCastleInfo.KingMovedYet) then begin
         NoGood := true;
         Reason := 'King has already moved';
         end;
      { see if king is in check }
      If InCheck(board,white) then begin
         NoGood := true;
         Reason := 'You are currently in check';
         end;
      { see if king moves through check }
      localboard := board;
      Move(localboard,8,5,8,5+Sign(ToCol-FromCol),dummy); { one square away }
      If InCheck(localboard,white) then begin
         NoGood := true;
         Reason := 'You would be moving through check';
         end;
      { now check if the move is to the left }
      If (ToCol = 3) then begin
         If (WhiteCastleInfo.RookAMovedYet) then begin
            NoGood := true;
            Reason := 'Rook on that side has already moved';
            end;
         If (board[8,2].color <> none) or (board[8,4].color <> none) then begin
            NoGood := true;
            Reason := 'There is an interposing piece';
            end;
         Move(board,8,5,8,3,dummy);  { move the king }
         Move(board,8,1,8,4,dummy);  { move the rook }
      end; { to the left side }

      If (ToCol = 7) then begin
         If (WhiteCastleInfo.RookHMovedYet) then begin
            NoGood := true;
            Reason := 'Rook on that side has already moved';
            end;
         If (board[8,6].color <> none) then begin
            NoGood := true;
            Reason := 'There is an interposing piece';
            end;
         Move(board,8,5,8,7,dummy);  { move the king }
         Move(board,8,1,8,6,dummy);  { move the rook }
      end; { to the right side }

   end; { checking for castle }

   if ((ABS(FromRow-ToRow) > 1) or (ABS(FromCol-ToCol) > 1)) and
      (not castling) then begin
      NoGood := true;
      Reason := 'Kings can only move one square';
   end;

   CheckLegalKing := NoGood;

end; { function CheckLegalKing }

{========================================================================}

function CheckLegalQueen(board : boardtype;
                     FromRow, FromCol, ToRow, ToCol : integer;
                     var Reason : StringType) : boolean;

var NoGood : boolean;
    DeltaRow, DeltaCol, Steps, index : integer;

begin

   NoGood := false;

   { see that delta row = delta col on a diagonal move }
   If (FromRow <> ToRow) and (FromCol <> ToCol) then
      If (ABS(FromRow-ToRow) <> ABS(FromCol-ToCol)) then begin
         NoGood := true;
         Reason := 'That is not a diagonal move';
      end;

   { see that there are no pieces between here and there }
   If not NoGood then begin
      DeltaRow := Sign(ToRow-FromRow);
      DeltaCol := Sign(ToCol-FromCol);
      Steps    := Max(ABS(FromRow-ToRow),ABS(FromCol-ToCol))-1;

      for index := 1 to Steps do
         If (board[FromRow+DeltaRow*index, FromCol+DeltaCol*index].color
                  <> none)
            then begin
                    NoGood := true;
                    Reason := 'There is a piece between FROM and TO';
                 end;

   end; { if not NoGood }

   CheckLegalQueen := NoGood;

end; { function CheckLegalQueen }

{========================================================================}

function CheckLegalBishop(board : boardtype;
                     FromRow, FromCol, ToRow, ToCol : integer;
                     var Reason : StringType) : boolean;

var NoGood : boolean;
    DeltaRow, DeltaCol, Steps, index : integer;

begin

   NoGood := false;

   { see that delta row = delta col on a diagonal move }
   If (ABS(FromRow-ToRow) <> ABS(FromCol-ToCol)) then begin
      NoGood := true;
      Reason := 'Bishops can only move diagonally';
   end;

   { see that there are no pieces between here and there }
   If not NoGood then begin
      DeltaRow := Sign(ToRow-FromRow);
      DeltaCol := Sign(ToCol-FromCol);
      Steps    := Max(ABS(FromRow-ToRow),ABS(FromCol-ToCol))-1;

      for index := 1 to Steps do
         If (board[FromRow+DeltaRow*index, FromCol+DeltaCol*index].color
                   <> none)
            then begin
                    NoGood := true;
                    Reason := 'There is a piece between FROM and TO';
                 end;

   end; { if not NoGood }

   CheckLegalBishop := NoGood;

end; { function CheckLegalBishop }

{========================================================================}

function CheckLegalRook(board : boardtype;
                     FromRow, FromCol, ToRow, ToCol : integer;
                     var Reason : StringType) : boolean;

var NoGood : boolean;
    DeltaRow, DeltaCol, Steps, index : integer;

begin

   NoGood := false;

   { see that this isn't a diagonal move }
   If ((FromRow <> ToRow) and (FromCol <> ToCol)) then begin
      NoGood := true;
      Reason := 'Rooks can only move along a row or column';
   end;

   { see that there are no pieces between here and there }
   If not NoGood then begin
      DeltaRow := Sign(ToRow-FromRow);
      DeltaCol := Sign(ToCol-FromCol);
      Steps    := Max(ABS(FromRow-ToRow),ABS(FromCol-ToCol))-1;

      for index := 1 to Steps do
         If (board[FromRow+DeltaRow*index, FromCol+DeltaCol*index].color
                   <> none)
            then begin
                    NoGood := true;
                    Reason := 'There is a piece between FROM and TO';
                 end;

   end; { if not NoGood }

   CheckLegalRook := NoGood;

end; { function CheckLegalRook }

{========================================================================}

function CheckLegalKnight(board : boardtype;
                     FromRow, FromCol, ToRow, ToCol : integer;
                     var Reason : StringType) : boolean;

var NoGood : boolean;

begin

   NoGood := false;

   If not (((ABS(FromCol-ToCol) = 2) and (ABS(FromRow-ToRow) = 1)) or
      ((ABS(FromCol-ToCol) = 1) and (ABS(FromRow-ToRow) = 2))) then begin
        NoGood := true;
        Reason := 'Knights move in a (+/- 1,+/- 2) or (+/- 2,+/- 1) pattern';
   end;

   CheckLegalKnight := NoGood;

end; { function CheckLegalKnight }

{========================================================================}

function CheckLegalPawn(board : boardtype;
                     FromRow, FromCol, ToRow, ToCol : integer;
                     var Reason : StringType) : boolean;

var NoGood : boolean;
    DeltaRow : integer;

begin

   NoGood := false;

   If (board[FromRow,FromCol].color = white ) then
      DeltaRow := -1
   else
      DeltaRow := +1;
   
   If (Sign(ToRow-FromRow) <> DeltaRow) then begin
      NoGood := true;
      Reason := 'You are moving that pawn backwards';
   end;

   If (not NoGood) and (FromCol <> ToCol) then
      { check capture legality }
      If (ABS(FromCol-ToCol) <> 1) then begin
         NoGood := true;
         Reason := 'Pawns can capture only on a single-square diagonal move';
      end
      else If (board[ToRow,ToCol].color = none) then begin
         NoGood := true;
         Reason := 'Pawns can move diagonally only on a capture';
      end;

   { check for advance of one square }
   If ((not NoGood) and (ABS(FromRow-ToRow) = 1)) and (FromCol = ToCol) then
      If (board[ToRow,ToCol].color <> none) then begin
         NoGood := true;
         Reason := 'Pawns can capture only on a single-square diagonal move';
      end;

   If (not NoGood) and (ABS(FromRow-ToRow) > 2) then begin
      NoGood := true;
      Reason := 'Pawns can only advance 1, sometimes 2, rows';
   end;

   If (not NoGood) and (ABS(FromRow-ToRow) = 2) then
      { make sure double advances only occur from original row }
      { Orig. row = 7 for white and 2 for black }
      If (((FromRow=2) and (ToRow<>4)) or ((FromRow=7) and (ToRow<>5))) or
         ((FromRow <> 2) and (FromRow <> 7)) then begin
            NoGood := true;
            Reason := 'Double advances are legal only from the start row';
      end
      { make sure there is no interposing piece on a double jump }
      else If (board[FromRow+DeltaRow,FromCol].color <> none) then begin
         NoGood := true;
         Reason := 'There is a piece between FROM and TO';
      end;

   CheckLegalPawn := NoGood;

end; { function CheckLegalPawn }

{========================================================================}
{ this is the main body of LegalMove                                     }

var NoGood : boolean;
    dummy  : integer;

begin

   dummy := 0; { make it defined }
   NoGood := false;

{ First check for gross errors }

   If ((FromRow < 1) or (FromRow > 8)) or ((FromCol < 1) or (FromCol > 8)) then begin
      NoGood := true;
      Reason := 'FROM is off the board';
   end;

   If ((ToRow < 1) or (ToRow > 8)) or ((ToCol < 1) or (ToCol > 8)) then begin
      NoGood := true;
      Reason := 'TO is off the board';
   end;

   If (FromRow = ToRow) and (FromCol = ToCol) then begin
      NoGood := true;
      Reason := 'FROM and TO are the same; i.e., you didn''t move anything';
   end;

   If not NoGood then
      If (board[FromRow,FromCol].color <> white) then begin
         NoGood := true;
         Reason := 'You don''t have a piece at FROM location';
      end;

   If not NoGood then
      If (board[ToRow,ToCol].color = board[FromRow,FromCol].color) then begin
         NoGood := true;
         Reason := 'You can''t capture your own piece!';
      end;

{ Now see if move is legal for that particular piece }
   castling := false;
   If not NoGood then begin
      case board[FromRow,FromCol].kind of
         King   : NoGood := CheckLegalKing(board,FromRow,FromCol,ToRow,ToCol,Reason,castling);
         Queen  : NoGood := CheckLegalQueen(board,FromRow,FromCol,ToRow,ToCol,Reason);
         Bishop : NoGood := CheckLegalBishop(board,FromRow,FromCol,ToRow,ToCol,Reason);
         Knight : NoGood := CheckLegalKnight(board,FromRow,FromCol,ToRow,ToCol,Reason);
         Rook   : NoGood := CheckLegalRook(board,FromRow,FromCol,ToRow,ToCol,Reason);
         Pawn   : NoGood := CheckLegalPawn(board,FromRow,FromCol,ToRow,ToCol,Reason);
      end; { case of not NoGood }
   end; { if not NoGood }

   { see if player will be in check after move }
   If not NoGood then begin
      Move(board,FromRow,FromCol,ToRow,ToCol,dummy);
      { if it was a castle we must do more }
      If Castling then
         if (ToCol = 3) then Move(board,8,1,8,4,dummy)
                        else Move(board,8,8,8,6,dummy);
      If InCheck(board,board[ToRow,ToCol].color) then begin
         NoGood := true;
         Reason := 'That move would leave you in check';
      end;
   end; { if not NoGood }

   LegalMove := not NoGood;

end; { function LegalMove }
function Evaluate(board : boardtype) : integer;

{ Simple material-based scoring function.  This function could be used at
  the bottom of the game tree but it would be too time consuming.  This
  function is instead used at the top and the score is modified as pieces
  get removed in the search.  In fact, this routine could be removed and
  then the scored kept would be a deltaScore; the same results would be had
  but since it is only called once and it works now, why mess with it?     }

var row, col : integer;   { indexes }
    score : integer;      { partial score }

begin

   score := 0;

   for row := 1 to 8 do
      for col := 1 to 8 do
         with board[row,col] do
            case color of
               black : score := score - pieceWeight[kind];
               white : score := score + pieceWeight[kind];
               none  : { who cares }
            end; { case of color }

   Evaluate := score;

end; { function Evaluate }
procedure PromotePlayer(var board : boardtype;
                        row,col   : integer);

{ This procedure is called when the player has advanced a pawn to the back
  row.  It is then the player's choice of what piece he wants it replaced
  with.  This routine will repeatedly prompt the player until a valid
  piece type is entered.  The pawn is then replaced by the requested piece. }

var done : boolean;
    promote : char;

begin

   done := false;

   while not done do begin

      Beep(output);
      PlayerPrompt1('What do you want your pawn to be:',false);
      PlayerPrompt2('(Q)ueen,(R)ook,k(N)ignt,(B)ishop?',true);
      getchar(promote);  { read one unbuffered character }
      putchar(promote);  { echo that character }

      if (promote >= 'a') and (promote <= 'z') then
         { make uppercase }
         promote := chr( ord(promote) - ord('a') + ord('A') );

      done := true;
      case promote of
         'Q' : board[row,col].kind := queen;
         'R' : board[row,col].kind := rook;
         'B' : board[row,col].kind := bishop;
         'N' : board[row,col].kind := knight;
         otherwise done := false { it was a bad input }
      end; { case }

   end; { while not done }

end; { procedure PromotePlayer }
procedure InterpretMove(var board : boardtype;
                        Command   : StringType;
                        var done  : boolean);  { returns true if good move }

{ This procedure accepts the Command string and interprets it as a move.
  If the move is legal then the move is made on the board and the variable
  done returns as true.

  It is assumed that 'Command' has already been capitalized. }

var FromRow,FromCol,ToRow,ToCol : integer;
    Reason : StringType;
    castling : boolean;

begin
   done := false;

   if (length(Command)<>4) then 
      ErrorMessage('Command should be in form c1r1c2r2',true)
   else begin
      FromCol := ord(Command[1]) - ord('A') + 1;
      FromRow := ord(Command[2]) - ord('0');
      if ((FromRow < 1) or (FromRow > 8)) or ((FromCol < 1) or (FromCol > 8))
         then begin { assume col and row are backwards }
            FromRow := ord(Command[1]) - ord('0');
            FromCol := ord(Command[2]) - ord('A') + 1;
         end;
      ToCol := ord(Command[3]) - ord('A') + 1;
      ToRow := ord(Command[4]) - ord('0');
      if ((ToRow < 1) or (ToRow > 8)) or ((ToCol < 1) or (ToCol > 8))
         then begin { assume col and row are backwards }
            ToRow := ord(Command[3]) - ord('0');
            ToCol := ord(Command[4]) - ord('A') + 1;
         end;

      { check the legality of the move }
      done := LegalMove(board,FromRow,FromCol,ToRow,ToCol,Reason,castling);

      If not done then
         ErrorMessage(Reason,true)
      else begin
         done := true;
         VisualMove(board, FromRow,FromCol,ToRow,ToCol);
         If castling then
            if (ToCol = 3) then VisualMove(board,8,1,8,4)
                           else VisualMove(board,8,8,8,6);

         { check for pawn promotion }
         If (ToRow = 1) and (board[ToRow,ToCol].kind = pawn) then begin
            PromotePlayer(board,ToRow,ToCol);
            WriteSquare(board,ToRow,ToCol);  { update board with new kind }
         end;

      end;
   end;

end; { procedure InterpretMove }
procedure FindMove(board : boardtype;
                   Us, opponent : colortype;
                   var FromRow, FromCol, ToRow, ToCol : integer;
                   var score,finalscore : integer;
                   PruningScore : integer;
                   depthLim : integer;
                   depth : integer;
                   WeAreInCheck : boolean);

{ FindMove is a recursive procedure that returns the best move it can find
  for the Us color.  It also returns the score that the best move leads to.
  The algorithm employed is a classical game tree using the min-max strategy
  with alpha-beta pruning.  In the case of two moves leading to the same
  score, one is picked at random.  Scoring is a simple material-based score. }

const ListMax = 150;

type listtype = record
                   FromRow : array[1..ListMax] of 1..8;
                   FromCol : array[1..ListMax] of 1..8;
                   ToRow   : array[1..ListMax] of 1..8;
                   ToCol   : array[1..ListMax] of 1..8;
                   Pointer : 0..ListMax;
                end; { type listtype }

{===========================================================================}
{ This procedure collects the legal moves generated by the Generators }

procedure Enter(var MoveList : listtype;  FR,FC,TR,TC : integer);
begin
   with MoveList do begin
      pointer := pointer + 1;
      FromRow[pointer] := FR;
      FromCol[pointer] := FC;
      ToRow[pointer]   := TR;
      ToCol[pointer]   := TC;
   end; { with }
end; { procedure Enter }
   

{===========================================================================}
{ Here are the subprocedures for generating and checking the various moves. }

procedure GenerateKing(board : boardtype; Us : colortype;
                       FromRow,FromCol : integer;
                       var MoveList : listtype);

var row, col, deltaRow, deltaCol : integer;
    done : boolean;

begin

   for row := FromRow-1 to FromRow+1 do
      for col := FromCol-1 to FromCol+1 do
         If ((row <> FromRow) or (col <> FromCol)) and
           (((row >= 1) and (row <= 8)) and ((col >= 1) and (col <= 8))) then
              If (board[row,col].color <> Us) then
                 Enter(MoveList,FromRow,FromCol,row,col);

end; { procedure GenerateKing }

{===========================================================================}

procedure GenerateQueen(board : boardtype; Us : colortype;
                       FromRow,FromCol : integer;
                       var MoveList : listtype);

var row, col, deltaRow, deltaCol : integer;
    done : boolean;

begin

   for deltaRow := -1 to 1 do
      for deltaCol := -1 to 1 do
         if (deltaRow <> 0) or (deltaCol <> 0) then begin
            row := FromRow; col := FromCol;
            done := ((row+deltaRow < 1) or (row+deltaRow > 8)) or
                    ((col+deltaCol < 1) or (col+deltaCol > 8));
            while (not done) do begin
               row := row + deltaRow; col := col + deltaCol;
               done := (((row+deltaRow < 1) or (row+deltaRow > 8)) or
                       ((col+deltaCol < 1) or (col+deltaCol > 8))) or
                       (board[row,col].color <> none);
               if (board[row,col].color <> Us) then
                  Enter(MoveList,FromRow,FromCol,row,col);
            end; { while }
         end; { if }

end; { procedure GenerateQueen }

{===========================================================================}

procedure GenerateBishop(board : boardtype; Us : colortype;
                       FromRow,FromCol : integer;
                       var MoveList : listtype);

var row, col, deltaRow, deltaCol : integer;
    done : boolean;

begin

   for deltaRow := -1 to 1 do
      for deltaCol := -1 to 1 do
         if (deltaRow <> 0) and (deltaCol <> 0) then begin
            row := FromRow; col := FromCol;
            done := ((row+deltaRow < 1) or (row+deltaRow > 8)) or
                    ((col+deltaCol < 1) or (col+deltaCol > 8));
            while (not done) do begin
               row := row + deltaRow; col := col + deltaCol;
               done := (((row+deltaRow < 1) or (row+deltaRow > 8)) or
                       ((col+deltaCol < 1) or (col+deltaCol > 8))) or
                       (board[row,col].color <> none);
               if (board[row,col].color <> Us) then
                  Enter(MoveList,FromRow,FromCol,row,col);
            end; { while }
         end; { if }

end; { procedure GenerateBishop }

{===========================================================================}

procedure GenerateRook(board : boardtype; Us : colortype;
                       FromRow,FromCol : integer;
                       var MoveList : listtype);

var row, col, deltaRow, deltaCol : integer;
    done : boolean;

begin

   for deltaRow := -1 to 1 do
      for deltaCol := -1 to 1 do
         if (deltaRow*deltaCol = 0) and (deltaRow+deltaCol <> 0) then begin
            row := FromRow; col := FromCol;
            done := ((row+deltaRow < 1) or (row+deltaRow > 8)) or
                    ((col+deltaCol < 1) or (col+deltaCol > 8));
            while (not done) do begin
               row := row + deltaRow; col := col + deltaCol;
               done := (((row+deltaRow < 1) or (row+deltaRow > 8)) or
                       ((col+deltaCol < 1) or (col+deltaCol > 8))) or
                       (board[row,col].color <> none);
               if (board[row,col].color <> Us) then
                  Enter(MoveList,FromRow,FromCol,row,col);
            end; { while }
         end; { if }

end; { procedure GenerateRook }

{===========================================================================}

procedure GenerateKnight(board : boardtype; Us : colortype;
                       FromRow,FromCol : integer;
                       var MoveList : listtype);

var row, col, deltaRow, deltaCol : integer;
    done : boolean;

begin

   for deltaRow := -2 to 2 do
      for deltaCol := -2 to 2 do
         if (deltaRow*deltaCol <> 0) and (ABS(deltaRow) <> ABS(deltaCol)) then begin
            row := FromRow; col := FromCol;
            done := ((row+deltaRow < 1) or (row+deltaRow > 8)) or
                    ((col+deltaCol < 1) or (col+deltaCol > 8));
            if (not done) then begin
               row := row + deltaRow; col := col + deltaCol;
               if (board[row,col].color <> Us) then
                  Enter(MoveList,FromRow,FromCol,row,col);
            end; { if not done }
         end; { if }

end; { procedure GenerateKnight }

{===========================================================================}

procedure GeneratePawn(board : boardtype; Us : colortype;
                       FromRow,FromCol : integer;
                       var MoveList : listtype);

var row, col : integer;
    delta : integer;

begin

   if (Us = white) then delta := -1
                   else delta := +1;

   { check if we can make a double advance from start row with white }
   if ((Us = white) and (FromRow = 7)) and ((board[6,FromCol].color = none)
      and (board[5,FromCol].color = none)) then
         Enter(MoveList,FromRow,FromCol,5,FromCol);

   { check if we can make a double advance from start row with black }
   if ((Us = black) and (FromRow = 2)) and ((board[3,FromCol].color = none)
      and (board[4,FromCol].color = none)) then
         Enter(MoveList,FromRow,FromCol,4,FromCol);

   { check if we can move up one square }
   row := FromRow+delta; col := Fromcol;
   if (row >= 1) and (row <= 8) then
      if (board[row,col].color = none) then
         Enter(MoveList,FromRow,FromCol,row,col);

   { check if we can capture to the left }
   row := FromRow+delta; col := Fromcol-1;
   if ((row >= 1) and (row <= 8)) and (col >= 1) then
      if (board[row,col].color = opponent) then
         Enter(MoveList,FromRow,FromCol,row,col);

   { check if we can capture to the right }
   row := FromRow+delta; col := Fromcol+1;
   if ((row >= 1) and (row <= 8)) and (col <= 8) then
      if (board[row,col].color = opponent) then
         Enter(MoveList,FromRow,FromCol,row,col);

end; { procedure GeneratePawn }

{===========================================================================}
{ Here is the body of the procedure FindMove }

var bestScore, bestFR, bestFC, bestTR, bestTC : integer; { best move so far }
    MoveList : listtype; { a list of all legal moves }
    row, col : integer;
    FR,FC,TR,TC : integer; { temps for FromRow, FromCol,ToRow,ToCol }
    BScore : integer;
    listindex : integer;   { a pointer to the next move on the list to try }
    D1,D2,D3,D4 : integer; { dummies }
    localboard : boardtype;{ used for trying out legal moves }
    localscore : integer;  { score generated by trying out possible move }
    done : boolean;
    SkipThisMove : boolean;{ used if the 'legal' move would actually leave 
                             the king in check.  It is used only if the depth
                             search is one.  If the search depth is greater
                             then the program will not leave itself in check
                             as it would be taken and produce a terrible score}

begin

   depth := depth + 1;

   If (depth > depthLim) then
      finalscore := score { return junk for other parameters }

   else begin

      if (Us = white) then
         bestScore := -1000  { white tries to maximize }
      else
         bestScore := +1000; { black tries to minimize }

      { collect a list of legal moves for that piece }
      MoveList.pointer := 0; { make an empty list }

      { search the board for our pieces }
      for row := 1 to 8 do
         for col := 1 to 8 do
            if (board[row,col].color = Us) then
               case board[row,col].kind of
                  King   : GenerateKing(board,Us,row,col,MoveList);
                  Queen  : GenerateQueen(board,Us,row,col,MoveList);
                  Bishop : GenerateBishop(board,Us,row,col,MoveList);
                  Knight : GenerateKnight(board,Us,row,col,MoveList);
                  Rook   : GenerateRook(board,Us,row,col,MoveList);
                  Pawn   : GeneratePawn(board,Us,row,col,MoveList);
               end; { case }


      { The list of legal moves is now all in MoveList.  Evaluate
        them one by one and find the one with the best score. }

      listindex := 0;
      done := (MoveList.pointer = 0);

      while (not done) do begin
         { make the next move on the list and see what happens }
         listindex := listindex + 1;
         FR := MoveList.FromRow[listindex];
         FC := MoveList.FromCol[listindex];
         TR := MoveList.ToRow[listindex];
         TC := MoveList.ToCol[listindex];
         localboard := board;
         localscore := score;
         Move(localboard,FR,FC,TR,TC,localscore);
         If ((depth = 1) and (depthLim > 2)) then begin
            OurStatus1('I am trying ',true);
            writeln(ColumnName[FC]:1,FR:1,'-',ColumnName[TC]:1,TR:1);
            OurStatus2('',true);
            writeln((movelist.pointer-listindex):1,' moves left.  ');
            HomeCursor;
         end; { if depth=1 }

         { If this is the first level and we're in check, don't try to
           make any moves that will leave us in check.  This is because
           the program would rather trade kings than loose his.  Also check
           if we are only searching 1 deep because we don't see check coming }
         SkipThisMove := false;
         If WeAreInCheck or (depthLim = 1) then
            SkipThisMove := InCheck(localboard,Us);
         If not SkipThisMove then begin
            FindMove(localboard,opponent,Us,D1,D2,D3,D4,
                     localscore,Bscore,bestScore,depthLim,depth,false);

            if ((Us = white) and (BScore > bestScore)) or
               ((Us = black) and (BScore < bestScore)) then begin
               bestScore := BScore;
               bestFR := FR;
               bestFC := FC;
               bestTR := TR;
               bestTC := TC;
               { use alpha-beta pruning to exit early if we can }
               if ((Us = white) and (PruningScore < bestScore)) or
                  ((Us = black) and (PruningScore > bestScore)) then
                  done := true
            end
            else if (BScore = bestScore) then
               { if this move is about as good as any up to this point,
                 pick it a certain amount of the time.  This will make
                 the start game a little less regular (boring)         }
               if (Trunc(random * MoveList.pointer) < 2) then begin
                  bestScore := BScore;
                  bestFR := FR;
                  bestFC := FC;
                  bestTR := TR;
                  bestTC := TC;
               end; { if }

            end; { if not SkipThisMove }

         done := done or (listindex = MoveList.pointer);

      end; { while not done }

      { done searching.  Return best move }
      FromRow := bestFR;
      FromCol := bestFC;
      ToRow   := bestTR;
      ToCol   := bestTC;
      finalscore := bestScore;

   end; { if depth > Maxdepth }

end; { procedure FindMove }
function EndOfGame(board : boardtype; OurColor : colortype) : boolean;

{ This function determines if the OurColor side doesn't have any alternatives
  because it is a checkmate or stalemate situation. True means there are no
  alternatives, false means the OurColor side has legal moves. }

const InitialDepth = 0;
      SearchDepth  = 1;
      CheckForCheck = true;

var score,bestscore : integer;
    d1,d2,d3,d4 : integer; { dummies }

begin

   score := Evaluate(board);

   if (OurColor = black) then begin
      FindMove(board,black,white,d1,d2,d3,d4,
               score,bestscore,-1000000,SearchDepth,InitialDepth,CheckForCheck);
      EndOfGame := (bestscore = 1000);
   end

   else begin
      FindMove(board,white,black,d1,d2,d3,d4,
               score,bestscore,1000000,SearchDepth,InitialDepth,CheckForCheck);
      EndOfGame := (bestscore = -1000);
   end

end; { function EndOfGame }
procedure GetPlayerMove(var board : boardtype; var over,quit : boolean);

{ This procedure first checks to see if the player has any legal moves open
  and exits if he doesn't.  Next the player is told if he is in check and
  then the player is asked for a command.  The commands are interpreted and
  the procedure ends when the sides are SWAPped, the player QUITs or the
  player enters a legal move. }

var Command : StringType;
    done : boolean;

begin

   quit := false;   { signifies that player has resigned }
   over := false;   { signifies that game is over for one reason or another }
   done := false;   { local loop variable }

   if EndOfGame(board,white) then
      over := true

   else Repeat

      { inform player if he is in check }
      If InCheck(board,white) then 
         CheckStatus('  ********* White king is in check ********',true)
      else { clear the line }
         CheckStatus('',false);

      { prompt user for move }
      PlayerPrompt2('',false);  { clear second line }
      PlayerPrompt1('Your move:',true);
      ReadLine(Command,10); { unbuffered input routine }
      Capitalize(Command);  { turn lower case to upper case }

      { erase line about illegal move info }
      ErrorMessage('',false);

      if (length(Command) = 0) then
         { don't do anything }

      else if (Command = 'EXIT') or (Command = 'QUIT') then begin
         done := true;
         over := true;
         quit := true;
      end

      else if ((Command = 'HELP') or (Command = '?')) or (Command = 'COMMANDS')
      then begin
         HelpThePoorSap;       { print game rules }
         PrintBoard(board);    { redraw the screen }
         PrintLevel(MAXDEPTH); { print skill level }
      end

      else if (Command = 'SWAP') then begin
         SwapSides(board);     { trade white and black pieces }
         PrintBoard(board);    { redraw the screen }
         PrintLevel(MAXDEPTH); { print skill level }
         done := true;         { since it was white's turn, now it is black's }
      end

      else if (Command[1] = 'L') then begin
         ChangeLevel(Command);
         PrintLevel(MAXDEPTH); { print skill level }
      end

      else  { assume it is a command to make a move }
         InterpretMove(board,Command,done);

   Until done;

   { erase line dedicated to telling about check }
   CheckStatus('',false);

end; { procedure GetPlayerMove }
procedure MakeOurMove(var board : boardtype; var over : boolean);

{ This procedure will first check if it has any legal moves and exits if
  it doesn't.  Next it gets the best (ha!) move available and does it. }

var FromRow, Fromcol, ToRow, ToCol : integer;
    score,bestscore : integer;
    WeAreInCheck : boolean;

begin

   over := false;
   WeAreInCheck := InCheck(board,black);

   { inform player if we are in check }
   If WeAreInCheck then
      CheckStatus('  ********* Black king is in check ********',true)
   else { clear off line }
      CheckStatus('',false);

   if EndOfGame(board,black) then
      over := true

   else begin
      NumberOfMoves := 0;
      score := Evaluate(board);
      { now search for the best move }
      FindMove(board,black,white,FromRow,FromCol,ToRow,ToCol,
               score,bestscore,-1000000,MAXDEPTH,0,WeAreInCheck);

      { inform the player of our move }
      OurStatus1('I looked at ',true);
      writeln(NumberOfMoves:1,' moves.');
      OurStatus2('I move ',true);
      writeln(ColumnName[FromCol]:1,FromRow:1,'-',ColumnName[ToCol]:1,ToRow:1);

      { if pawn has advanced to last row then make it a queen }
      if (ToRow = 8) and (board[FromRow,FromCol].kind = pawn) then
         board[FromRow,FromCol].kind := queen;

      { display our move }
      VisualMove(board,FromRow,FromCol,ToRow,ToCol);

   end; { if ... else begin }

end; { procedure MakeOurMove }
{ *********   Main program   ************ }

var GameBoard : boardtype;
    done,quit  : boolean;

begin

   Initialize(GameBoard);

   { draw the chess board }
   PrintBoard(GameBoard);
   PrintLevel(MAXDEPTH);

   { print the help hint where error message usually is }
   ErrorMessage('Type ''HELP'' to get help',false);

   Repeat
      GetPlayerMove(GameBoard,done,quit);
      If not done then
         MakeOurMove(GameBoard, done);
   Until done;

   { if the game is over, print why }
   PrintBoard(GameBoard);
   if not quit then
      if InCheck(GameBoard,white) then
         CheckStatus('    **** Checkmate --- I win ****',true)
      else if InCheck(GameBoard,black) then
         CheckStatus('    **** Checkmate --- You win ****',true)
      else 
         CheckStatus('    **** Stalemate ****',true);

   { turn auto echo back on }
   SetEchoMode(output,ENABLEECHO);

end.