program B97q2st1;
{ Problem statement:

  See BIO exam paper.

  This program implements strategy 1.
}

{ See copyright notice at the end of this file. }

{ For Delphi or Turbo Pascal for Windows, include this line }
{uses WinCrt;}
{ otherwise comment it out }

type
  TPiece = (Blank, White, Black);
  TBoard = array[1..8, 1..8] of TPiece;

const
  Symbol: array[TPiece] of Char = ('.', '0', '*');

var
  CurrentBoard, OldBoard: TBoard;
  NWhite, NBlack, N, Turned: Integer;
  Player: TPiece;


procedure ReadBoard(var Board: TBoard);
{ Read in 4x4 board as specified.  TestBoard is defined for
  fast testing without inputting data. }
const
  TestBoard: TBoard =
    (
     (Blank, Blank, Blank, Blank, Blank, Blank, Blank, Blank),
     (Blank, Blank, Blank, Blank, Blank, Blank, Blank, Blank),
     (Blank, Blank, White, White, White, Blank, Blank, Blank),
     (Blank, Blank, Black, White, Blank, White, Blank, Blank),
     (Blank, Blank, Blank, White, Blank, Black, Blank, Blank),
     (Blank, Blank, White, White, White, Blank, Blank, Blank),
     (Blank, Blank, Blank, Blank, Blank, Blank, Blank, Blank),
     (Blank, Blank, Blank, Blank, Blank, Blank, Blank, Blank)
    );
var
  x, y: Integer;
  c: Char;
begin
{  Board := TestBoard; }

  for x := 1 to 8 do for y := 1 to 8 do Board[x,y] := Blank;
  for y := 6 downto 3 do
  begin
    for x := 3 to 6 do
    begin
      Read(c);
      case c of
        '.': Board[x,y] := Blank;
        '0': Board[x,y] := White;
        '*': Board[x,y] := Black;
      else
        begin
          WriteLn('Invalid character ', c, ' taken as blank');
          Board[x,y] := Blank;
        end;
      end;
    end;
    ReadLn;
  end;
end;

procedure ShowBoard(var Board: TBoard);
{ Display the board in the required format }
var
  x, y: Integer;
begin
  for y := 8 downto 1 do
  begin
    for x := 1 to 8 do
      Write(Symbol[Board[x,y]]);
    WriteLn;
  end;
  WriteLn;
end;

function Enemy(Piece: TPiece): TPiece;
begin
  if (Piece = Black) then
    Enemy := White
  else if (Piece = White) then
    Enemy := Black
  else
    Enemy := Blank;
end;

function HasNeighbour(x, y: Integer): Boolean;
var
  Found: Boolean;
begin
  Found := False;
  if (x > 1) and (y > 1) then
    if (CurrentBoard[x-1, y-1] <> Blank) then Found := True;
  if (x > 1) then
    if (CurrentBoard[x-1, y  ] <> Blank) then Found := True;
  if (x > 1) and (y < 8) then
    if (CurrentBoard[x-1, y+1] <> Blank) then Found := True;
  if (y < 8) then
    if (CurrentBoard[x  , y+1] <> Blank) then Found := True;
  if (x < 8) and (y < 8) then
    if (CurrentBoard[x+1, y+1] <> Blank) then Found := True;
  if (x < 8)  then
    if (CurrentBoard[x+1, y  ] <> Blank) then Found := True;
  if (x < 8) and (y > 1) then
    if (CurrentBoard[x+1, y-1] <> Blank) then Found := True;
  if (y > 1) then
    if (CurrentBoard[x  , y-1] <> Blank) then Found := True;
  HasNeighbour := Found;
end;

procedure Move(x, y: Integer);
{ Make a move on CurrentBoard, turning pieces over as necessary.  The
  number of pieces turned over is counted in global variable Turned. }

  procedure CheckSwap(dx, dy: Integer);
  var
    Search: Boolean;
    Found: Boolean;
    x1, y1: Integer;
  begin
    x1 := x + dx;
    y1 := y + dy;
    Search := (x1 >= 1) and (x1 <= 8) and (y1 >= 1) and (y1 <= 8);
    if Search then Search := (CurrentBoard[x1, y1] = Enemy(Player));
    Found := False;
    while Search do
    begin
      x1 := x1 + dx;
      y1 := y1 + dy;
      Search := (x1 >= 1) and (x1 <= 8) and (y1 >= 1) and (y1 <= 8);
      if Search then
      begin
        Search := (CurrentBoard[x1, y1] = Enemy(Player));
        Found := (CurrentBoard[x1, y1] = Player);
      end;
    end;
    if Found then
    begin
      while (x1 <> x) or (y1 <> y) do
      begin
        x1 := x1 - dx;
        y1 := y1 - dy;
        CurrentBoard[x1, y1] := Player;
        Inc(Turned);
      end;
      Dec(Turned);  { Corrects for counting the piece placed }
    end;
  end;

begin
  Turned := 0;
  CurrentBoard[x, y] := Player;
  CheckSwap(1, -1);
  CheckSwap(1, 0);
  CheckSwap(1, 1);
  CheckSwap(0, 1);
  CheckSwap(-1, 1);
  CheckSwap(-1, 0);
  CheckSwap(-1, -1);
  CheckSwap(0, -1);
end;

procedure FindBestMove_1(var x, y: Integer);
{ Implements strategy 1.
  Selection between equal best moves is performed by
  trying moves in the required order. }
var
  x1, y1: Integer;
  tb, xb, yb: Integer;
begin
  OldBoard := CurrentBoard;
  tb := -1;
  for y1 := 1 to 8 do for x1 := 8 downto 1 do
    if CurrentBoard[x1, y1] = Blank then if HasNeighbour(x1, y1) then
    begin
      Move(x1, y1);
      if Turned > tb then
      begin
        xb := x1;
        yb := y1;
        tb := Turned;
      end;
      CurrentBoard := OldBoard;
    end;
  x := xb;
  y := yb;
end;

procedure Play;
var
  x, y: Integer;
  Action: Integer;
begin
  NWhite := 0;
  NBlack := 0;
  for x := 1 to 8 do for y := 1 to 8 do
    case CurrentBoard[x,y] of
      White: Inc(NWhite);
      Black: Inc(NBlack);
    end;
  N := NWhite + NBlack;
  Player := White;

  Action := 0;
  if (N < 64) then
    repeat
      ReadLn(Action);
      if (Action > -1) then
      begin
        if (Action = 0) then
        begin
          ReadLn(x, y);
          if (x < 1) or (x > 8) or (y < 1) or (y > 8) then
            WriteLn('Expected a location between (1,1) and (8,8)')
          else if (CurrentBoard[x,y] <> Blank) then
            WriteLn('That square is occupied!')
          else if not (HasNeighbour(x, y)) then
            WriteLn('That square has no neighbour')
          else
            Move(x, y);
          ShowBoard(CurrentBoard);
          Player := Enemy(Player);
          NWhite := 0;
          NBlack := 0;
          for x := 1 to 8 do for y := 1 to 8 do
            case CurrentBoard[x,y] of
              White: Inc(NWhite);
              Black: Inc(NBlack);
            end;
          N := NWhite + NBlack;
        end
        else
        begin
          while (Action > 0) and (N < 64) do
          begin
            FindBestMove_1(x, y);
            Move(x, y);
            Player := Enemy(Player);
            Dec(Action);
            Inc(N);
          end;
          ShowBoard(CurrentBoard);
          NWhite := 0;
          NBlack := 0;
          for x := 1 to 8 do for y := 1 to 8 do
            case CurrentBoard[x,y] of
              White: Inc(NWhite);
              Black: Inc(NBlack);
            end;
          N := NWhite + NBlack;
        end;
      end;
    until (N = 64) or (Action = -1);

  if (N = 64) then
  begin
    if (NWhite > NBlack) then
      WriteLn('White wins by ', NWhite-NBlack:1, '.')
    else if (NWhite < NBlack) then
      WriteLn('Black wins by ', NBlack-NWhite:1, '.')
    else
      WriteLn('Black and White draw.');
  end;
end;

begin
  WriteLn('BIO''97 Question 2.');
  WriteLn('Enter 4x4 board with "." representing blank, "0" white and "*" black:');
  ReadBoard(CurrentBoard);
  WriteLn;
  WriteLn('Strategy 1');
  ShowBoard(CurrentBoard);

  Play;
  WriteLn('Closing program.');
end.
{ Solution copyright (c) 1997 The British Informatics Olympiad (BIO).

  This program may be freely copied by persons or organisations
  involved in the British Informatics Olympiad or the International
  Olympiad in Informatics, on condition that no changes are made and
  this notice is not altered. Distribution for profit is forbidden
  unless permission is first obtained in writing from the BIO.

  This program is for educational purposes only and comes with no
  warranty, implied or otherwise, as to its fitness for any purpose.

  Author:   Antony Rix
  Internet: http://www.christs.cam.ac.uk/bio/
  E-mail:   a.rix@lineone.net
  S-mail:   The British Informatics Olympiad
            Christ's College
            Cambridge CB2 3BU
            United Kingdom
}