🚀 go-pugleaf

program cadenza(input, output);

(*
This program plays checkers with a human opponent.  The depth of the
search of the game tree is determined by maxply and the game tree is 
searched in minimax fashion with alpha-beta pruning.  The computer always 
plays second and is red.
*)

const

  (* 
  N is the number of rows and columns in the game board.  N must be an odd,
  positive number.
  *)
  n        =  8;

  (* 
  maximum moves available at any one ply - should be equal to 4 times the
  maximum number of pieces of one player.
  *)
  maxmoves = 36;

  (* maximum depth of game tree search *)
  maxply   =  4;

  infinity = maxint;

type

  (* index into a game board *)
  boardindex   = 0..n;

  moverange    = 1..maxmoves;

  plyrange     = -1..maxply;

  onerange     = -1..1;

  piece        = (blackking, redking, blackman, redman, empty);

  piececolor   = (red, black, none);

  boardstatus  = (blackwin, redwin, undefined);

  gameboard    = array[1..n, 1..n] of piece;

  (* Board numbered with standard checkerboard notation. *)
  numbermatrix = array[1..n, 1..n] of integer;

  (* game tree *)
  tree         = ^node;

  (* game tree node *)
  node         = record

                   board    : gameboard;
                   children : array[moverange] of tree;
                   parent   : tree;
                   score    : integer;

                 end;

  (* list of legal moves *)
  list         = ^cell;

  (* cell of legal move list *)
  cell         = record

                   board : gameboard;
                   next  : list;

                 end;

  (* tally of the numbers of different pieces on a game board. *)
  tallyrecord  = record

                   blackkings,
                   blackmen,
                   redkings,
                   redmen      : integer;

                 end;

                  
var
  currentboard      : gameboard;
  nextplayerscolor  : piececolor;
  gamerecord        : text;
  globalnumberboard : numbermatrix;


function colorofpiece(thepiece : piece) : piececolor;

(*
This function returns the color of a piece on a game board.
*)

begin (* colorofpiece *)

  case thepiece of

    blackman  : colorofpiece := black;
    blackking : colorofpiece := black;
    redman    : colorofpiece := red;
    redking   : colorofpiece := red;
    empty     : colorofpiece := none;

  end;

end; (* colorofpiece *)


procedure makenumberboard(var numberboard : numbermatrix);

(*
This procedure returns a matrix representing the standard numbering of
squares used in checkers literature.
*)

var
  row,
  column        : boardindex;
  currentnumber : integer;

begin (* makenumberboard *)

  (* Make all squares on the number board zero. *)
  for row := 1 to n do
    for column := 1 to n do
      numberboard[row, column] := 0;

  (* Prepare to number the squares of the number board. *)
  for column := 1 to n do
    if not odd(column)
      then numberboard[1, column] := column div 2;

  currentnumber := (n div 2) + 1;

  (* Number the squares of the number board. *)
  for row := 2 to n do
    for column := 1 to n do
      if numberboard[row - 1, column] = 0
        then begin

          numberboard[row, column] := currentnumber;
          currentnumber := currentnumber + 1;

        end;

end; (* makenumberboard *)


procedure getnumberboard(var numberboard : numbermatrix);

begin (* getnumberboard *)

  numberboard := globalnumberboard;

end; (* getnumberboard *)


procedure getrowandcolumn(squarenumber : integer; var row, column : 
                                                       boardindex);

(*
This procedure returns the row and column corresponding to a square number.
*)

var
  numberboard : numbermatrix;
  localrow,
  localcolumn : boardindex;

begin (* getrowandcolumn *)

  getnumberboard(numberboard);

  row := 0;
  column := 0;

  for localrow := 1 to n do
    for localcolumn := 1 to n do
      if numberboard[localrow, localcolumn] = squarenumber
        then begin

          row := localrow;
          column := localcolumn;

        end;

end; (* getrowandcolumn *)


procedure tallypieces(currentboard : gameboard; var tally : tallyrecord);


(*
This procedure counts up the different kind of pieces on the game board.
*)

var
  row, 
  column : boardindex;

begin (* tallypieces *)

  with tally do begin

    blackmen := 0;
    blackkings := 0;
    redmen := 0;
    redkings := 0;

    (* Count up the different pieces on the board. *)
    for row := 1 to n do
      for column := 1 to n do
        if currentboard[row, column] <> empty
          then
            case currentboard[row, column] of

              blackman  :  blackmen := blackmen + 1;
              blackking :  blackkings := blackkings + 1;
              redman    :  redmen := redmen + 1;
              redking   :  redkings := redkings + 1;

            end;

  end;

end; (* tallypieces *)


function capturemade(oldboard, newboard : gameboard) : boolean;

(*
This function returns true if the move represented by (oldboard) and
(newboard) was a capture.
*)

var
  oldtally,
  newtally  : tallyrecord;

begin (* capturemade *)

  (* Count the pieces on the two boards. *)
  tallypieces(oldboard, oldtally);
  tallypieces(newboard, newtally);

  (* See if a capture was made. *)
  capturemade := (oldtally.blackmen + oldtally.blackkings +
                  oldtally.redmen   + oldtally.redkings) >
                 (newtally.blackmen + newtally.blackkings +
                  newtally.redmen   + newtally.redkings);

end; (* capturemade *)


function boardsareequal(board1, board2 : gameboard) : boolean;

(*
This function returns true if the two boards (board1) and (board2) are
identical.
*)

var
  row,
  column : boardindex;

begin (* boardsareequal *)

  boardsareequal := true;

  (* Look for differences between the boards. *)

  for row := 1 to n do 
    for column := 1 to n do
      if board1[row, column] <> board2[row, column]
        then boardsareequal := false;

end; (* boardsarequal *)

  
procedure findmovemade(oldboard, newboard : gameboard; var sourcesquare, 
                                                  destsquare : integer);

(*
This procedure examines two successive game boards and returns the move
that changed the first board to the second board.  (sourcesquare)
represents the square that was moved from, and (destsquare) represents
the square that was moved to.
*)

var
  row,
  column : boardindex;
  color  : piececolor;


  function squarenumber(row, column : boardindex) : integer;

  (*
  This function, when given a row and column which index into a game
  board, will return a square number as is used in checkers literature.
  *)

  var
    numberboard : numbermatrix;

  begin (* squarenumber *)

    getnumberboard(numberboard);
  
    squarenumber := numberboard[row, column];

  end; (* squarenumber *)


begin (* findmovemade *)

  if not boardsareequal(oldboard, newboard)
    then begin

      (* Determine the color of the player who moved last. *)
      for row := 1 to n do
        for column := 1 to n do
          if (oldboard[row, column] = empty) and
             (newboard[row, column] <> empty) 
            then color := colorofpiece(newboard[row, column]);

      (* Find the square moved from and the square moved to. *)
      for row := 1 to n do
        for column := 1 to n do
          if (oldboard[row, column] <> newboard[row, column]) and
             ((colorofpiece(oldboard[row, column]) = color) or 
              (colorofpiece(newboard[row, column]) = color))
            then 
              if (oldboard[row, column] = empty) or
                 (newboard[row, column] = empty)
                then begin

                  if oldboard[row, column] = empty
                    then destsquare := squarenumber(row, column);

                  if newboard[row, column] = empty
                    then sourcesquare := squarenumber(row, column);

                end
    
    end
    else begin

      sourcesquare := 0;
      destsquare := 0;

    end;

end; (* findmovemade *)


procedure disposelist(var garbage : list);

(*
This procedure reclaims the storage occupied by a list of legal moves.
*)

var
  templist : list;

begin (* disposelist *)

  while garbage <> nil do begin

    templist := garbage;
    garbage := garbage^.next;
    dispose(templist);

  end;

end; (* disposelist *)


procedure promotemen(var currentboard : gameboard);

(*
This procedure promotes a piece in its king row to a king.
*)

var
  column : boardindex;

begin (* promotemen *)

  for column := 1 to n do begin

    (* Promote any black men in their king row. *)
    if currentboard[n, column] = blackman
      then currentboard[n, column] := blackking;

    (* Promote any red men in their king row. *)
    if currentboard[1, column] = redman
      then currentboard[1, column] := redking;

  end;

end; (* promotemen *)


procedure displayboard(oldboard, newboard : gameboard; var gamerecord : 
                                                                 text);

(*
This procedure displays a game board on the screen and the move that was
made to achieve it (in standard checkers notation).  A numbered checker
board is also printed out to facilitate move entry by the user.
*)

var
  row,
  column      : boardindex;
  dash        : integer;
  numberboard : numbermatrix;


  procedure showmovemade(oldboard, newboard : gameboard; var gamerecord : 
                                                                   text);

  (*
  This procedure examines two boards and then displays the move that
  changed the first (oldboard) into the second (newboard).
  *)

  var
    sourcesquare,
    destsquare    : integer;

  begin (* showmovemade *)

    (* Find out what move changed the first board to the second one. *)
    findmovemade(oldboard, newboard, sourcesquare, destsquare);

    (* If a move was made, print it out. *)
    if (sourcesquare <> 0) and (destsquare <> 0)
      then begin

        writeln(sourcesquare : 4, '-', destsquare : 4);
        writeln(gamerecord, sourcesquare : 4, '-', destsquare : 4);        

      end;

  end; (* showmovemade *)                      


begin (* displayboard *)
  
  writeln;

  showmovemade(oldboard, newboard, gamerecord);

  writeln;

  getnumberboard(numberboard);

  for row := 1 to n do begin

    for dash := 1 to 2 * (2 * n) + 1 do
      write('-');

    write(' ' : 10);

    for dash := 1 to 2 * (2 * n) + 1 do
      write('-');

    writeln(' ');

    (* Display the contents of the current board. *)
    for column := 1 to n do

      case newboard[row, column] of

        blackman  : write('| b ');
        blackking : write('| B ');
        redman    : write('| r ');
        redking   : write('| R ');
        empty     : write('|   ');

      end;

    write('|');

    write(' ' : 10);

    (* Display a numbered checker board. *)
    for column := 1 to n do
      if numberboard[row, column] <> 0
        then write('|', numberboard[row, column] : 3)
        else write('|', ' ' : 3);
      
    writeln('|');

  end;

  for dash := 1 to 2 * (2 * n) + 1 do
    write('-');

  write(' ' : 10);

  for dash := 1 to 2 * (2 * n) + 1 do
    write('-');

  writeln(' ');

end; (* displayboard *)


function legalboardindex(row, column : integer) : boolean;

(*
This function returns true if (row) and (column) are together a legal
index into a game board.
*)

begin (* legalboardindex *)

  legalboardindex := (row in [1..n]) and (column in [1..n]);

end; (* legalboardindex *)


procedure addtolist(currentboard : gameboard; var legallist : list);

(*
This procedure adds a game board to a list of legal moves.
*)

var
  newcell : list;

begin (* addtolist *)

  (* Allocate a new list cell. *)
  new(newcell);

  (* Initialize the new cell. *)
  newcell^.board := currentboard;

  (* Add the new cell to the list. *)
  newcell^.next := legallist;
  legallist := newcell;

end; (* addtolist *)


procedure addcaptures(currentboard : gameboard; row, column : boardindex;
                                                   var legallist : list);

(*
This procedure adds all legal moves involving captures into the list of
legal moves. 
*)

var
  currentpiece : piece;

 
  function piecesareopposite(piece1, piece2 : piece) : boolean;

  (* 
  This function returns true if (piece1) and (piece2) are of
  opposite colors. 
  *)

  begin (* piecesareopposite *)

    if (colorofpiece(piece1) <> colorofpiece(piece2)) and 
       ((colorofpiece(piece1) <> none) and 
        (colorofpiece(piece2) <> none))
      then piecesareopposite := true
      else piecesareopposite := false;

  end; (* piecesareopposite *)


  procedure addonecapture(currentboard : gameboard; row, column :
                    boardindex; rowdelta, columndelta : onerange;
                     var legallist : list; currentpiece : piece);

  (* 
  This procedure adds the capture produced by jumping in the direction
  indicated by (rowdelta) and (columndelta) to the list of legal moves 
  if it is legal.
  *)

  var
    newboard : gameboard;

  begin (* addonecapture *)

    if legalboardindex(row + 2 * rowdelta, column + 2 * columndelta)
      then
        if (currentboard[row + 2 * rowdelta, column + 2 * columndelta] 
                                                          = empty) and
           (piecesareopposite(
           currentboard[row + rowdelta, column + columndelta], 
                                                currentpiece))
          then begin

            (* Capture the piece. *)
            newboard := currentboard;

            (* Jump over the piece to be captured. *)
            newboard[row + 2 * rowdelta, column + 2 * columndelta] 
            := currentpiece;
            newboard[row, column] := empty;

            (* Remove the captured piece from the board. *)
            newboard[row + rowdelta, column + columndelta] := empty;

            (* Insert the new board into the list of legal moves. *)
            addtolist(newboard, legallist);

          end;

  end; (* addonecapture *)


begin (* addcaptures *)

  currentpiece := currentboard[row, column];

  if currentpiece <> empty
    then begin

      if currentpiece in [blackman, blackking, redking]
        then begin
        
          (* Try to capture the south-west piece. *)
          addonecapture(currentboard, row, column, +1, -1, legallist,
                                                       currentpiece);
 
          (* Try to capture the south-east piece. *)
          addonecapture(currentboard, row, column, +1, +1, legallist,
                                                       currentpiece);
           
        end;

      if currentpiece in [redman, blackking, redking]
        then begin

          (* Try to capture the north-west piece. *)
          addonecapture(currentboard, row, column, -1, -1, legallist,
                                                       currentpiece);

          (* Try to capture the north-east piece. *)
          addonecapture(currentboard, row, column, -1, +1, legallist,
                                                       currentpiece);

        end;

    end;

end; (* addcaptures *)


function canmoveagain(oldboard, newboard : gameboard) : boolean;

(*
This function returns true if the player who made the move that 
changoard) to (moveboard) made a capture and can make another
capture with the same piece.
*)

var
  legallist     : list;
  row,
  column        : boardindex;
  sourcesquare,
  destsquare    : integer;


  function piececrowned(oldboard, newboard : gameboard) : boolean;

  (*
  This function returns true if the move represented by (oldboard) and
  (newboard) involved a crowning of a piece.
  *)

  var
    oldtally,
    newtally  : tallyrecord;

  begin (* piececrowned *)

    (* Count the different pieces on the two boards. *)
    tallypieces(oldboard, oldtally);
    tallypieces(newboard, newtally);

    piececrowned :=  (oldtally.redkings   < newtally.redkings) or
                     (oldtally.blackkings < newtally.blackkings);

  end; (* piececrowned *)


begin (* canmoveagain *)

  canmoveagain := false;
  
  (* 
  If the player who moved last made a capture, see if he can make  
  another with the same piece.
  *)

  if (capturemade(oldboard, newboard)) and
     (not piececrowned(oldboard, newboard))
    then begin

      (* 
      Find the location of the piece that performed the last capture. 
      *)

      findmovemade(oldboard, newboard, sourcesquare, destsquare);
      getrowandcolumn(destsquare, row, column);

      (* See if that piece can perform another capture. *)

      legallist := nil;
      addcaptures(newboard, row, column, legallist);

      if legallist <> nil
        then canmoveagain := true;

      disposelist(legallist);

    end;

end; (* canmoveagain *)


function legalmoves(oldboard, currentboard : gameboard; playerscolor : 
                                                   piececolor) : list;

(*
This function returns a list of all of the legal moves from the current 
game board.
*)

var
  row,
  column           : boardindex;
  legallist        : list;
  lastplayerscolor : piececolor;


  procedure promotelist(legallist : list);

  (*
  This procedure promotes all pieces in all the boards in a list of legal
  moves if they are in their own king row.
  *)

  begin (* promotelist *)

    if legallist <> nil
      then begin

        promotemen(legallist^.board);
        promotelist(legallist^.next);

      end;

  end; (* promotelist *)


  procedure addsimplemoves(currentboard : gameboard; 
    row, column : boardindex; var legallist : list);

  (*
  This procedure adds all legal simple moves (moves not involving captures)
  to the list of legal moves. 
  *)

  var
    currentpiece : piece;


    procedure addonemove(currentboard : gameboard; row, column :
                   boardindex; rowdelta, columndelta : onerange;
                    var legallist : list; currentpiece : piece);

    (*
    This procedure adds a simple move in the direction indicated by
    (rowdelta) and (columndelta) to the list of legal moves if such a 
    move is possible and legal.
    *)

    var
      newboard : gameboard;

    begin (* addonemove *)

      (* Try to make the requested move. *)
      if legalboardindex(row + rowdelta, column + columndelta)
        then
          if currentboard[row + rowdelta, column + columndelta] = empty
            then begin

              (* Move the piece. *)
              newboard := currentboard;
              newboard[row + rowdelta, column + columndelta] 
              := currentpiece;
              newboard[row, column] := empty;
                  
              (* Insert the new board into the list of legal moves. *)
              addtolist(newboard, legallist);

            end;

    end; (* addonemove *)


  begin (* addsimplemoves *)

    currentpiece := currentboard[row, column];

    if currentpiece <> empty
      then begin

        if currentpiece in [blackman, blackking, redking]
          then begin
        
            (* Try to move south-west. *)
            addonemove(currentboard, row, column, +1, -1, legallist,
                                                      currentpiece);

            (* Try to move south-east. *)
            addonemove(currentboard, row, column, +1, +1, legallist,
                                                      currentpiece);

          end;

        if currentpiece in [redman, blackking, redking]
          then begin
        
            (* Try to move north-west. *)
            addonemove(currentboard, row, column, -1, -1, legallist,
                                                      currentpiece); 

            (* Try to move north-east. *)
            addonemove(currentboard, row, column, -1, +1, legallist,
                                                      currentpiece);

          end;

      end;

  end; (* addsimplemoves *)


  function iteratedcaptures(oldboard, newboard : gameboard) : list;

  (*
  This function returns the list of legal moves for a player who is
  performing an iterated capture.
  *)

  var
    legallist     : list;
    sourcesquare,
    destsquare    : integer;
    row,
    column        : boardindex;

  begin (* iteratedcaptures *)

    (* 
    If the move is an iterated capture, find the legal
    captures involving the piece that made the previous capture.
    *)

    findmovemade(oldboard, newboard, sourcesquare, destsquare);

    getrowandcolumn(destsquare, row, column);

    legallist := nil;

    addcaptures(newboard, row, column, legallist);

    (* Promote any pieces that made it to their king rows. *)
    promotelist(legallist);

    iteratedcaptures := legallist;

  end; (* iteratedcaptures *)


  function whomoved(oldboard, newboard : gameboard) : piececolor;

  (*
  This function returns the color of the player whose move changed 
  (oldboard) to (newboard). 
  *)

  var
    sourcesquare, 
    destsquare    : integer;
    row,
    column        : boardindex;

  begin (* whomoved *)

    findmovemade(oldboard, newboard, sourcesquare, destsquare);

    if (sourcesquare = 0) and (destsquare = 0)
      then whomoved := none
      else begin

        getrowandcolumn(sourcesquare, row, column);
        whomoved := colorofpiece(oldboard[row, column]);

      end;

  end; (* whomoved *)


begin (* legalmoves *)

  (* Determine the color of the player who made the last move. *)
  lastplayerscolor := whomoved(oldboard, currentboard);

  (* 
  If the player who made the last move can move again, return a list of
  the legal moves available to him.
  *)

  if canmoveagain(oldboard, currentboard)
    then legalmoves := iteratedcaptures(oldboard, currentboard)
    else begin

      (* 
      Since the player who moved last cannot make another move, return
      a list of the legal moves available to the other player.
      *)

      case lastplayerscolor of

        none  : playerscolor := playerscolor;
        red   : playerscolor := black;
        black : playerscolor := red;

      end;
      
      legallist := nil;

      (* Add any possible captures to the list of legal moves. *)
      for row := 1 to n do
        for column := 1 to n do
          if colorofpiece(currentboard[row, column]) = playerscolor
            then addcaptures(currentboard, row, column, legallist);

      (* 
      If no captures are possible, add simple moves to the list of legal
      moves.
      *)

      if legallist = nil
        then
          for row := 1 to n do
            for column := 1 to n do
              if colorofpiece(currentboard[row, column]) = playerscolor
                then addsimplemoves(currentboard, row, column, legallist);

      (* Promote any men in their king rows in the list of legal moves. *)
      promotelist(legallist);

      legalmoves := legallist;

    end;

end; (* legalmoves *)


function lengthoflist(thelist : list) : integer;

(*
This function returns the number of cells in a list.
*)

begin (* lengthoflist *)

  if thelist = nil
    then lengthoflist := 0
    else lengthoflist := 1 + lengthoflist(thelist^.next);

end; (* lengthoflist *)


function status(currentboard : gameboard; nextplayerscolor : piececolor) : 
                                                              boardstatus;

(*
This function returns the status of a gameboard.  This will be either
a win by black, a win by red, a draw, or undefined (if the game is not 
yet over).
*)

var
  tally  : tallyrecord;
  result : boardstatus;


  function mobility(currentboard : gameboard; color : piececolor) : 
                                                           integer;

  (*
  This function returns the number of legal moves available to a player
  of color (color) with a given board (currentboard) if he is the next
  to move.
  *)

  var
    legallist : list;


  begin (* mobility *)

    (* 
    See how many moves are available to the player if he were to
    play next.
    *)
    legallist := legalmoves(currentboard, currentboard, color);

    mobility := lengthoflist(legallist);

    disposelist(legallist);

  end; (* mobility *)


begin (* status *)

  tallypieces(currentboard, tally);

  result := undefined;

  with tally do begin

    (* Check to see if red has captured all of black's pieces. *)
    if (blackkings + blackmen = 0) and (redkings + redmen <> 0)
      then result := redwin;

    if result = undefined
      then
        (* Check to see if black has captured all of red's pieces. *)
        if (redkings + redmen = 0) and (blackkings + blackmen <> 0)
          then result := blackwin;

    if result = undefined
      then begin

        (* Check to see if black cannot move. *)
        if (mobility(currentboard, black) = 0) and 
           (nextplayerscolor = black)
          then result := redwin;

        (* Check to see if red cannot move. *)
        if (mobility(currentboard, red) = 0) and
           (nextplayerscolor = red)
          then result := blackwin;

      end;

    status := result;

  end;

end; (* status *)


procedure initializeboard(var currentboard : gameboard);

(*
This procedure makes a game board ready for use at the beginning of a game.
*)

var
  row,
  column        : boardindex;
  numberboard   : numbermatrix;


begin (* initializeboard *)

  getnumberboard(numberboard);

  for row := 1 to n do
    for column := 1 to n do
      currentboard[row, column] := empty;

  (* Put black men on the game board. *)
  for row := 1 to (n div 2) - 1 do
    for column := 1 to n do
      if numberboard[row, column] <> 0
        then currentboard[row, column] := blackman;

  (* Place the red men on the board. *)
  for row := n downto n - (n div 2) + 2 do
    for column := 1 to n do
      if numberboard[row, column] <> 0
        then currentboard[row, column] := redman;

end; (* initializeboard *)


procedure playermove(var currentboard : gameboard; previousboard : 
                                gameboard; var gamerecord : text);

(*
This procedure prompts the player for his move and makes the move if it
is legal.
*)

var 
  oldboard,
  newboard         : gameboard;
  oldsquare,
  newsquare,
  maxsquarenumber  : integer;
  legallist        : list;
  error,
  legalmovemade    : boolean;


  function boardinlist(newboard : gameboard; legallist : list) : boolean;


  begin (* boardinlist *)

    if legallist = nil
      then boardinlist := false
      else 
        if boardsareequal(legallist^.board, newboard)
          then boardinlist := true
          else boardinlist := boardinlist(newboard, legallist^.next);

  end; (* boardinlist *)


  procedure makemove(currentboard : gameboard; var newboard : gameboard;
                                        oldsquare, newsquare : integer);

  (*
  This procedure makes a move requested by the user (regardless of whether
  it is legal or not).
  *)

  var
    oldrow,
    oldcolumn,
    newrow,
    newcolumn  : boardindex;

  begin (* makemove *)

    newboard := currentboard;

    (* 
    Get the row and column numbers corresponding to the square numbers. 
    *)
    getrowandcolumn(oldsquare, oldrow, oldcolumn);
    getrowandcolumn(newsquare, newrow, newcolumn);

    (* If the requested move is a jump, make the move. *)
    if ((oldrow = newrow + 2) or (oldrow = newrow - 2)) and
       ((oldcolumn = newcolumn + 2) or (oldcolumn = newcolumn - 2))
      then begin

        (* Jump. *)
        newboard[newrow, newcolumn] := newboard[oldrow, oldcolumn];
        newboard[oldrow, oldcolumn] := empty;

        (* Perform the capture. *)
        newboard[(oldrow + newrow) div 2, (oldcolumn + newcolumn) div 2] 
                                                               := empty;
      end
      else begin

        (* Make the simple move *)
        newboard[newrow, newcolumn] := newboard[oldrow, oldcolumn];
        newboard[oldrow, oldcolumn] := empty;

      end;

    (* If the move requires a promotion, make it. *)
    promotemen(newboard);

  end; (* makemove *)


  procedure readnumber(var number : integer; var error : boolean);

  (*
  Attempt to read in an unsigned integer.  If the read is successful,
  return its value in number.  Otherwise, set the error flag.
  *)

  var
    tempstring,
    digitstring : string;
    i           : integer;

  begin

    readln(tempstring);
    digitstring := '';

    (* Make sure the number string has only digits. *)
    for i := 1 to length(tempstring) do
      if tempstring[i] in ['0'..'9']
        then digitstring := concat(digitstring, tempstring[i]);

    error := digitstring = '';

    if not error
      then begin

        (* Convert number string into the corresponding integer. *)
        number := 0;

        for i := 1 to length(digitstring) do
          number := 10 * number + ord(digitstring[i]) - ord('0');

      end;

  end; (* readnumber *)


begin (* playermove *)

  maxsquarenumber := (n * n) div 2;
  oldboard := currentboard;

  repeat 

    repeat

      writeln('Square numbers must be between 1 and ', 
                                 maxsquarenumber : 3);
      writeln;
      write('Enter square to move from:  ');
      readnumber(oldsquare, error);

      if error
        then oldsquare := 0;
 
      write('Enter square to move to:    ');
      readnumber(newsquare, error);

      if error
        then newsquare := 0;

      if not ((oldsquare in [1..maxsquarenumber]) and
              (newsquare in [1..maxsquarenumber]))
        then begin

          writeln('Square number out of range');
          displayboard(currentboard, currentboard, gamerecord);

        end;

    until (oldsquare in [1..maxsquarenumber]) and
          (newsquare in [1..maxsquarenumber]);

    makemove(currentboard, newboard, oldsquare, newsquare);

    legallist := legalmoves(previousboard, currentboard, black);

    (* 
    If the requested move was not legal, read in another move request. 
    *)
    if not boardinlist(newboard, legallist)
      then begin

        writeln('Illegal move, try again');
        legalmovemade := false;
        displayboard(currentboard, currentboard, gamerecord);

      end

      else begin

        (* Make the requested (legal) move. *)
        displayboard(currentboard, newboard, gamerecord);
        currentboard := newboard;
        legalmovemade := true;
    
      end;

    (* Discard the list of legal moves generated earlier. *)
    disposelist(legallist);

  until legalmovemade;

  (* 
  Move again if a capture was made and another capture can be made,
  and a man was not promoted to a king.
  *)
  if canmoveagain(oldboard, currentboard)
     then playermove(currentboard, oldboard, gamerecord);

end; (* playermove *)


procedure computermove(var currentboard : gameboard; previousboard : 
               gameboard; maxply : plyrange; var gamerecord : text);

(*
This procedure searches the game tree and choses the best move for the
computer.
*)

var
  bestmove  : gameboard;
  legallist : list;


  procedure linkupnewnode(var parentnode : tree; board : gameboard;
                                    currentply, maxply : plyrange);

  (*
  This procedure links up a new game board onto the game tree as a
  child of a parent node.  If the parent node is nil, it will point to
  the new game board.
  *)

  var
    index   : moverange;
    newnode : tree;  


    function evaluation(currentboard : gameboard) : integer;

    (*
    This function returns an evaluation of the desirability of a given
    board.  The computer seeks a board with a high score, and its opponent
    seeks a board with a low score.
    *)

    var
      tally : tallyrecord;


      function uncapturablepieces(color : piececolor; currentboard : 
                                               gameboard) : integer;

      (*
      This function returns the number of pieces of color (color) which
      cannot be captured because they reside on an outer edge of the 
      game board.
      *)

      var
        i      : boardindex;
        result : integer;

      begin (* uncapturablepieces *)

        result := 0;

        (* Count up all the uncapturable pieces. *)
        for i := 1 to n do begin

          if colorofpiece(currentboard[1, i]) = color
            then result := result + 1;

          if colorofpiece(currentboard[i, 1]) = color
            then result := result + 1;

          if colorofpiece(currentboard[n, i]) = color
            then result := result + 1;

          if colorofpiece(currentboard[i, n]) = color
            then result := result + 1;

        end;
 
        uncapturablepieces := result;

      end; (* uncapturablepieces *)


    begin (* evaluation *)

      (* Find out about the number and kinds of pieces on the board. *)
      tallypieces(currentboard, tally);

      with tally do
        if blackkings + blackmen = 0
          then evaluation := infinity
          else 
            if redkings + redmen = 0
              then evaluation := -infinity
              else evaluation := 
                   round((redmen + redkings) / (blackmen + blackkings) * 
                   (16 * (redmen + (redkings * 1.5)))) + 
                   uncapturablepieces(red,   currentboard) -
                   round((blackmen + blackkings) / (redmen + redkings) * 
                   (16 * (blackmen + (blackkings * 1.5)))) +
                   uncapturablepieces(black, currentboard);

    end; (* evaluation *)


  begin (* linkupnewnode *)

    (* Get a new node. *)
    new(newnode);

    (* Initialize the node. *)
    newnode^.parent := parentnode;
    newnode^.board := board;

    if currentply = maxply
      then newnode^.score := evaluation(newnode^.board)
      else
        if odd(currentply)
          then newnode^.score := infinity
          else newnode^.score := -infinity;

    for index := 1 to maxmoves do
      newnode^.children[index] := nil;

    if parentnode <> nil
      then begin

        (* Link up the new node as a child of the parent. *)
        index := 1;

        while parentnode^.children[index] <> nil do
          index := index + 1;

        parentnode^.children[index] := newnode;

      end
      else parentnode := newnode;

  end; (* linkupnewnode *)


  procedure findbestmove(maxply : plyrange; previousboard : gameboard; 
                                            var bestmove : gameboard);

  (*
  This procedure searches the game tree to depth (maxply) for the
  best move to be made by the computer. 
  *)

  var
    rootnode : tree;


    procedure expand(var currentnode : tree; currentply : plyrange;
                                        previousboard : gameboard);

    (*
    This procedure expands (gives children to) a node of the game tree.
    *)

    var
      index     : moverange;
      legallist,
      garbage   : list;

    begin (* expand *)

      (*
      Get all of the boards of the children of the node to be expanded.
      *)

      (* 
      If the current node is the root node, then the appropriate previous
      board for the legal move generator is the previous game board.
      *)
      
      if currentply = 0
        then legallist := 
             legalmoves(previousboard, currentnode^.board, red)

        (* 
        If the current node is not the root node, then the appropriate
        previous board for the legal move generator is that of its 
        parent.
        *)
        else legallist := 
             legalmoves(currentnode^.parent^.board, 
                         currentnode^.board, none);    

      (* Link the current node to its children. *)
      garbage := legallist;

      index := 1;
      while legallist <> nil do begin

        (* 
        Give the children their game boards and initial scores and link 
        them to their parent. 
        *)    

        linkupnewnode(currentnode, legallist^.board, currentply + 1, 
                                                            maxply); 

        legallist := legallist^.next;
        index := index + 1;

      end;

      if index < maxmoves
        then
          for index := index to maxmoves do
            currentnode^.children[index] := nil;

      (* Discard the list of legal moves. *)
      disposelist(garbage);

    end; (* expand *)


    procedure searchforbestmove(maxply, currentply : plyrange;
               currentnode : tree; previousboard : gameboard);

    (*
    Exhaustively search the game tree to a depth of maxply.  Use the
    minimax algorithm to find the best move.  Use alpha-beta pruning
    to shorten the search.
    *)

    var
      currentchild : integer;
      pruned       : boolean;


      function min(a, b : integer) : integer;

      (*
      This function returns the lesser of its two arguments.
      *)

      begin (* min *)

        if a < b
          then min := a
          else min := b;

      end; (* min *)


      function max(a, b : integer) : integer;

      (*
      This function returns the greater of its two arguments.
      *)

      begin (* max *)
 
        if a > b
          then max := a
          else max := b;

      end; (* max *)


      function childsposition(child, parent : tree) : moverange;

      var
        position : moverange;

      begin (* childsposition *)

        position := 1;
        while parent^.children[position] <> child do
          position := position + 1;
      
        childsposition := position;

      end; (* childsposition *)


    begin (* searchforbestmove *)

      if currentply < maxply
        then begin

          expand(currentnode, currentply, previousboard);

          currentchild := 1;
          while currentchild <= maxmoves do begin

            if currentnode^.children[currentchild] <> nil
              then searchforbestmove(maxply, currentply + 1,
                   currentnode^.children[currentchild], previousboard);

            currentchild := currentchild + 1;

          end;

          (* Update best next move if found. *)
          if currentply = 1
            then 
              if currentnode^.score > currentnode^.parent^.score
                then currentnode^.parent^.board := currentnode^.board;

        end;

        (* Back up the child's score. *)
        if (currentply <> 0)
          then begin

            if odd(currentply)
              then currentnode^.parent^.score := 
                   max(currentnode^.parent^.score, currentnode^.score)
              else currentnode^.parent^.score := 
                   min(currentnode^.parent^.score, currentnode^.score);

            pruned := false;

            (* Perform alpha-beta pruning if possible. *)
            if currentply >= 2
              then
                if (odd(currentply) and 
                    (currentnode^.parent^.score >=
                     currentnode^.parent^.parent^.score)) or
                   (not odd(currentply) and
                    (currentnode^.parent^.score <= 
                     currentnode^.parent^.parent^.score))
                  then begin

                    pruned := true;
 
                    for currentchild := childsposition(currentnode,
                                   currentnode^.parent) to maxmoves do
                      if currentnode^.parent^.children[currentchild] <> nil
                        then begin

                          dispose(currentnode^.parent^.
                               children[currentchild]);
                          currentnode^.parent^.children[currentchild] := nil;

                        end;  

                  end;

            if not pruned
              then dispose(currentnode);

          end;

    end; (* searchforbestmove *)


  begin (* findbestmove *)

    (* Get the root node of the game tree to be searched. *)
    rootnode := nil;

    linkupnewnode(rootnode, currentboard, 0, maxply);

    (* Search the game tree for the best move. *)
    searchforbestmove(maxply, 0, rootnode, previousboard);

    bestmove := rootnode^.board;
    dispose(rootnode);

  end; (* findbestmove *)


begin (* computermove *)

  (* If there is only one legal move available then make it. *)

  legallist := legalmoves(previousboard, currentboard, red);

  if lengthoflist(legallist) = 1
    then begin

      (* Make the only legal move move. *)
      previousboard := currentboard;
      currentboard := legallist^.board;

    end

    (* If there is more than one move available then choose the best one. *)

    else begin

      (* Find the best move in the game tree. *)
      findbestmove(maxply, previousboard, bestmove);

      (* Make the best move. *)
      previousboard := currentboard;
      currentboard := bestmove;
  
    end;

    disposelist(legallist);

  (* Display the selected move. *)
  displayboard(previousboard, currentboard, gamerecord);

  (* If the move made was an iterated capture, take another move. *)
  if canmoveagain(previousboard, currentboard)
    then begin

      write('Press <RETURN> to continue');
      readln;
      computermove(currentboard, previousboard, maxply, gamerecord);

    end;

end; (* computermove *)


procedure tellboardstatus(currentboard : gameboard; nextplayerscolor :
                                   piececolor; var gamerecord : text);

(*
This procedure reveals the status of the game board when a game is
over.
*)

begin (* tellboardstatus *)

  writeln;
  writeln(gamerecord);
  writeln;
  writeln(gamerecord);

  case status(currentboard, nextplayerscolor) of

     blackwin : begin
                  
                  writeln('You win!!!');
                  writeln(gamerecord, 'You win!!!');

                end;

     redwin   : begin

                  writeln('The computer wins.');
                  writeln(gamerecord, 'The computer wins.');

                end;
        
  end;

end; (* tellboardstatus *)


procedure introduceprogram;

(*
Place a dialog box introducing the program on the screen.  Then wait until the
mouse button is pressed.
*)

const
  {$i gemconst.pas}

type
  {$i gemtype.pas}

{$i gemsubs.pas}

  procedure dodialogbox;

  var
    intro_box : dialog_ptr;
    line_1,
    line_2,
    line_3,
    line_4,
    line_5,
    button    : integer;
    dialog    : tree_index;

  begin

    (* Make mouse shape an arrow. *)
    init_mouse;
    set_mouse(m_arrow);

    (* Get a dialog box. *)
    intro_box := new_dialog(5, 0, 0, 70, 17);

    (* Add text lines and mouse button to the dialog box. *)
    line_1 := add_ditem(intro_box, g_string, none, 4,  2, 0, 0, 0, 0);
    line_2 := add_ditem(intro_box, g_string, none, 4,  4, 0, 0, 0, 0);
    line_3 := add_ditem(intro_box, g_string, none, 4,  6, 0, 0, 0, 0);
    line_4 := add_ditem(intro_box, g_string, none, 4,  8, 0, 0, 0, 0);
    line_5 := add_ditem(intro_box, g_string, none, 4, 10, 0, 0, 0, 0);
    button := add_ditem(intro_box, g_button, selectable | exit_btn | default,
                        30, 12, 7, 3, 2, black);

    (* Place text and mouse button in the proper places in the dialog box. *)
    set_dtext(intro_box, line_1,
    '               Cadenza - A Checkers Program', system_font, te_center);

    set_dtext(intro_box, line_2,
    '              Written by Eric Bergman-Terrell', system_font, te_center);

    set_dtext(intro_box, line_3,
    'Portions of this product are Copyright (c) 1986, OSS and CCD.',
    small_font, te_center);

    set_dtext(intro_box, line_4,
    '                  Used by permission of OSS.',
    small_font, te_center);

    set_dtext(intro_box, line_5,
    '     This software has been placed in the public domain.',
    system_font, te_center);

    set_dtext(intro_box, button, 'BEGIN', system_font, te_center);

    (* Dialog box will be placed in the center of the screen. *)
    center_dialog(intro_box);

    {
    Place the dialog box on the screen and wait for mouse button to be
    pressed.
    }
    dialog := do_dialog(intro_box, 0);

    { Remove the dialog box from the screen and delete it. }
    end_dialog(intro_box);
    delete_dialog(intro_box);

  end; (* dodialogbox *)


begin

  if init_gem >= 0
    then begin

      dodialogbox;
      exit_gem;
      hide_mouse;

    end;

end; (* introduceprogram *)


begin (* cadenza *)

  (* Prepare the game record file. *)
  rewrite(gamerecord, 'gamerec.txt');

  introduceprogram;

  page(output);

  writeln('You are black.');
  writeln(gamerecord, 'You are black.');

  writeln('The computer is red.');
  writeln(gamerecord, 'The computer is red.');

  writeln(gamerecord);  

  (* Initialize the global number board. *)
  makenumberboard(globalnumberboard);

  initializeboard(currentboard);  
  displayboard(currentboard, currentboard, gamerecord);

  repeat

    nextplayerscolor := black;

    (* If the game is not over, have the player make his next move. *)
    if status(currentboard, nextplayerscolor) = undefined
      then begin

        playermove(currentboard, currentboard, gamerecord);
        writeln(gamerecord);
        nextplayerscolor := red;

        (* 
        If the game is not over, have the computer make its next move. 
        *)
        if status(currentboard, nextplayerscolor) = undefined
          then begin

            computermove(currentboard, currentboard, maxply, gamerecord);
            writeln(gamerecord);

          end;

      end;

  until status(currentboard, nextplayerscolor) <> undefined;

  tellboardstatus(currentboard, nextplayerscolor, gamerecord);

  close(gamerecord);

end. (* cadenza *)