program FoxAndHounds(input,output);
(*
  Program bases upon the BASIC game "Tally Ho!"
  By Jack A. Inman
  Published in Microcomputing, September 1978
*)
const
  OccupiedCh   = 'X';
  HoundCh      = 'H';
  FoxCh        = 'F';
  VacantCh     = 'O';
  FoxLine      = 8;
  FoxColumn    = 5;
  MaxLine      = 9;        (* FoxLine +1 *)
type
  MStr         = string[80];
  ActionState  = (GoForwardRight,GoBack1,GoForwardLeft,GoBackLeft,GoBack2,GoBackRight,FoxReady);
  Tiles        = (Occupied,Hound,Fox,Vacant); (* 1 2 3 4 *)
  State        = (moving,ended);              (* 0 1 *)
var
  RunGame,
  EndGame      : boolean;
  Board        : array[1..MaxLine,1..MaxLine] of Tiles;
  NewLine,
  NewColumn,
  OldLine,
  OldColumn    : integer;
  HoundGo,
  FoxGo        : State;

procedure InKey(var ch:char);
Begin
  repeat until keypressed;
  read(kbd,ch);
  if ch=^C then
  begin
    writeln;
    writeln;
    writeln('** Abort **');
    halt;
  end;
  ch:=upcase(ch);
End;

procedure UpReadln(var res:MStr);
var
  i            : integer;
Begin
  readln(res);
  for i:=1 to length(res) do res[i]:=upcase(res[i]);
End;

function YES(msg:MStr):boolean;
var
  YESNO        : MStr;
Begin
  write(msg,' - TYPE YES OR NO ');
  UpReadln(YESNO);
  YES:=YESNO='YES';
End;

procedure TellFoxMove;
(*** PRINT COMPUTER MOVE ***)
Begin
  if not (OldLine=NewLine) then
  begin
    if (FoxGo=ended) then writeln('I CAN''T MOVE')
                     else
                     begin
                       writeln('I MOVED FROM ',OldLine,' ',OldColumn,' TO ',NewLine,' ',NewColumn);
                       OldLine:=NewLine;
                       OldColumn:=NewColumn;
                     end;
  end;
End;

procedure Instructions;
(*** INSTRUCTIONS ***)

  procedure awaitReturn;
  begin
    write('TYPE A RETURN TO CONTINUE');
    readln;
    writeln;
  end;

  procedure TellRules;
  begin
    writeln;
    writeln('YOU ARE THE HOUNDS.');
    writeln('YOU HAVE 4 PLAYERS (H).');
    writeln('YOU CAN MOVE FORWARD ONLY.');
    writeln;
    writeln('THE COMPUTER IS THE FOX (F).');
    writeln('THE FOX CAN MOVE BACK AND FORWARD.');
    writeln;
    writeln('IF YOU TRAP THE FOX YOU WIN.');
    writeln('IF THE FOX GETS TO LINE 1');
    writeln('THE COMPUTER WINS.');
    awaitReturn;
    writeln('TO PLAY. .WHEN IT IS YOUR MOVE');
    writeln('TYPE IN THE LINE NUMBER');
    writeln('COMMA COLUMN NUMBER OF THE');
    writeln('MAN YOU WANT TO MOVE.');
    writeln;
    writeln('THEN WHEN I ASK TO?');
    writeln('TYPE IN LINE NUMBER');
    writeln('COMMA COLUMN YOU WANT TO');
    writeln('MOVE TO. GOOD LUCK');
    awaitReturn;
  end;

Begin (* Instructions *)
  if YES('WANT INSTRUCTIONS') then TellRules;
End;

procedure MakeBoard;
(* 200 *)
(*** GENERATE BOARD ***)
var
  c,l,i        : integer;

  procedure SetTile(Line:integer);
  begin
    if odd(Line) then
    begin
      Board[Line,c]:=      Occupied;
      Board[Line,succ(c)]:=Vacant;
    end else
    begin
      Board[Line,c]:=      Vacant;
      Board[Line,succ(c)]:=Occupied;
    end;
  end;

Begin (* MakeBoard *)
(*** GENERATE LINE 1 ***)
  c:=1;
  for i:=1 to 8 DIV 2 do
  begin
    Board[1,c]:=      Occupied;
    Board[1,succ(c)]:=Hound;
    c:=succ(succ(c));
  end;
(*** GENERATE LINES 2 THROUGH 8 ***)
  c:=1;
  for i:=1 to 8 DIV 2 do
  begin
    for l:=2 to 8 do SetTile(l);
    c:=succ(succ(c));
  end;
(*** SET UP FOX INITIAL POSITION ***)
    Board[FoxLine,FoxColumn]:=Fox;
(*** LOCATION HOLDERS ***)
  NewLine:=FoxLine;
  NewColumn:=FoxColumn;
  OldLine:=NewLine;
  OldColumn:=NewColumn;
End;

procedure PrintBoard;
var
  l,c,k        : integer;

  procedure Head;
  begin
    write('COL  ');
    for k:=1 to 8 do write(k:1,' ');
    writeln;
  end;

Begin (* PrintBoard *)
(* 410 *)
  Head;
  for l:=1 to 8 do
  begin
    write('L',l:2,'  ');
    for c:=1 to 8 do
    begin
      case Board[l,c] of
        Occupied : write(OccupiedCh);
        Hound    : write(HoundCh);
        Fox      : write(FoxCh);
        Vacant   : write(VacantCh);
      end;
      write(' ');
    end;
    writeln(' L',l:2);
  end;
  Head;
End;

procedure inNum(var n1,n2:integer);
var
  ch           : char;

  function inDigit:integer;
  begin
    repeat
      InKey(ch);
    until ch in ['1'..'8'];
    inDigit:=ord(ch)-ord('0');
  end;

Begin (* inNum *)
  n1:=inDigit;
  write(' ',n1,', ');
  n2:=inDigit;
  write(n2);
End;

procedure HoundMove;
(* 600 *)
(*** HUMAN MOVES ***)
var
  validmove    : boolean;
  FromLine,
  FromColumn,
  ToLine,
  ToColumn     : integer;
Begin
  validmove:=false;
  repeat
    write('YOUR MOVE FROM (LINE,COLUMN)');
    inNum(FromLine,FromColumn);
    write(' TO ');
    inNum(ToLine,ToColumn);
    writeln;
(*** TEST FOR VALID MOVE ***)
    if ToLine<FromLine then writeln('YOU CAN''T MOVE BACKWARDS')
    else begin
           if ((ToLine-FromLine)=1)              and
              (Board[FromLine,FromColumn]=Hound) and
              (Board[ToLine,ToColumn]=Vacant) then validmove:=true
                                              else writeln('INVALID MOVE');
         end;
  until validmove;
(*** MOVE IS VALID-MOVE PLAYER ***)
  Board[ToLine,ToColumn]:=Hound;
  Board[FromLine,FromColumn]:=Vacant;
End;

procedure FoxMove;
(* 900 *)
(*** COMPUTER MOVES ***)
var
  Guess,Try    : integer;
  Action       : ActionState;

  function Foxnotmoved(adir,bdir:integer):boolean;
  begin
    NewLine:=NewLine+adir;
    NewColumn:=NewColumn+bdir;
    Try:=succ(Try);
    if Board[NewLine,NewColumn]=Vacant then Board[NewLine,NewColumn]:=Fox;
    if Board[NewLine,NewColumn]=Fox    then Board[NewLine-adir,NewColumn-bdir]:=Vacant;
    Foxnotmoved:=Board[NewLine,NewColumn]<>Fox;
  end;
      
  procedure TestBackLeft;
  (*** TEST (1)BACK (1) LEFT ***)
  begin
    Action:=FoxReady;
    if Foxnotmoved(+1,-1) then if Try<4 then Action:=GoBackRight
                                        else FoxGo:=ended;
  end;

  procedure TestBackRight;
  (*** TEST (1) BACK (1) RIGHT ***)
  begin
    Action:=FoxReady;
    if Foxnotmoved(+1,+1) then if Try<4 then Action:=GoBackLeft
                                        else FoxGo:=ended;
  end;

  procedure TestForwardRight;
  (*** TEST (1) FORWARD (1) RIGHT ***)
  begin
    Action:=FoxReady;
    if Foxnotmoved(-1,+1) then if Try<2 then Action:=GoForwardLeft
                                        else if Try=2 then Action:=GoBack2;
  end;

  procedure TestForwardLeft;
  (*** TEST (1) FORWARD:(1) LEFT ***)
  begin
    Action:=FoxReady;
    if Foxnotmoved(-1,-1) then if Try<>2 then Action:=GoForwardRight
                                         else if Try=2 then Action:=GoBack2;
  end;

  procedure TestBack;
  (*** TEST (1)BACK (1) LEFT ***)
  begin
    if Guess=1 then TestBackRight
               else TestBackLeft;
  end;

Begin (* FoxMove *)
  Try:=0;
  Guess:=random(2);
  if Guess=0 then TestForwardRight
             else TestForwardLeft;
  while Action<>FoxReady do
  begin
    case Action of
      GoForwardRight : TestForwardRight;
      GoBack1        : TestBack;
      GoForwardLeft  : TestForwardLeft;
      GoBackLeft     : TestBackLeft;
      GoBack2        : TestBack;
      GoBackRight    : TestBackRight;
    end;
  end;
End;

BEGIN (* MAIN *)
  HoundGo:=moving;
  FoxGo:=moving;
  EndGame:=false;
  Instructions;
  repeat
    MakeBoard;
    RunGame:=true;
    while RunGame do
    begin
      TellFoxMove;
      PrintBoard;
      if (HoundGo=ended) or (FoxGo=ended) then RunGame:=false;
      if RunGame then
      begin
        HoundMove;
        FoxMove;
        if NewLine=1 then HoundGo:=ended;
      end;
    end;
    if FoxGo=ended then write('YOU');
    if HoundGo=ended then write('I');
    EndGame:=not (YES(' WIN...WANT TO PLAY AGAIN'));
  until EndGame;
END.