program Squares;
{ Borland Pascal 6.0/7.0/Delphi }

{ Refer to the BIO website (http://www.christs.cam.ac.uk/bio/) for
  a descripton of this program. }

{ See the end of this file for copyright notice and disclaimer. }

{ use the following if compiling for Windows }
{ uses WinCrt; }

{ otherwise }
uses Crt;

const
  OutFile = 'BIO95R2.OUT';

{ Test if a given square is on the board. }
function OnBoard(x, y: Integer): Boolean;
begin
  OnBoard := (x >= 1) and (x <= 5) and (y >= 1) and (y <= 5);
end;

{ Solves (A) }
procedure ProblemA;
var
  x, y: Integer;
  Out: Text;

  { This procedure is used to test if a possible next square is
    on the board, and if so, print its coordinates. }
  procedure TestShow(x, y: Integer);
  begin
    if OnBoard(x, y) then
    begin
      WriteLn('(', x:1, ', ', y:1, ')');
      WriteLn(Out, '(', x:1, ', ', y:1, ')');
    end;
  end;

begin
  Write('Starting Sequence in format x y:');
  ReadLn(x, y);
  if not OnBoard(x, y) then
    WriteLn('(', x:1, ', ', y:1, ') is not on the board!')
  else
  begin
    Assign(Out, OutFile);
    {$I-}
    Append(Out);
    {$I+}
    if IOResult <> 0 then { the file does not exist }
      ReWrite(Out);

    WriteLn('Valid positions starting from (', x:1, ', ', y:1, '):');
    TestShow(x + 3, y);
    TestShow(x - 3, y);
    TestShow(x, y + 3);
    TestShow(x, y - 3);
    TestShow(x + 2, y + 2);
    TestShow(x + 2, y - 2);
    TestShow(x - 2, y + 2);
    TestShow(x - 2, y - 2);
    Close(Out);
  end;
end;

{ Part (B) }
procedure ProblemB;
type
  TGrid = array[1..5, 1..5] of Integer;    { this represents the grid }
var
  x, y: Integer;
  Out: Text;
  Start, Example: TGrid;
  Combinations: Integer;

  { Place is a recursive procedure which, if possible, puts n on the
    Grid at (x, y) and tries all positions for placing n+1.
    If n=25 and it can be placed, the grid is noted as a valid
    combination and copied to the example.
    Zero is used to mark an empty grid position. }
  procedure Place(var Grid: TGrid; n, x, y: Integer);
  begin
    if OnBoard(x, y) then if Grid[x, y] = 0 then
    begin
      Grid[x, y] := n;
      if n = 25 then
      begin
        Example := Grid;
        Combinations := Combinations + 1;
      end
      else
      begin
        Place(Grid, n+1, x + 3, y);
        Place(Grid, n+1, x - 3, y);
        Place(Grid, n+1, x, y + 3);
        Place(Grid, n+1, x, y - 3);
        Place(Grid, n+1, x + 2, y + 2);
        Place(Grid, n+1, x + 2, y - 2);
        Place(Grid, n+1, x - 2, y + 2);
        Place(Grid, n+1, x - 2, y - 2);
      end;

      { reset the grid for trying other combinations }
      Grid[x, y] := 0;
    end;
  end;

begin
  { create a blank grid }
  for x := 1 to 5 do for y := 1 to 5 do
    Start[x, y] := 0;
  Combinations := 0;
  Write('Starting Sequence in format x y:');
  ReadLn(x, y);
  if not OnBoard(x, y) then
    WriteLn('(', x:1, ', ', y:1, ') is not on the board!')
  else
  begin
    Assign(Out, OutFile);
    {$I-}
    Append(Out);
    {$I+}
    if IOResult <> 0 then { the file does not exist }
      ReWrite(Out);

    { find combinations and display them }
    Place(Start, 1, x, y);
    WriteLn(
      'Total number of valid combinations starting from (',
      x:1, ', ', y:1, '): ', Combinations:1);
    WriteLn(Out,
      'Total number of valid combinations starting from (',
      x:1, ', ', y:1, '): ', Combinations:1);
    for y := 1 to 5 do
    begin
      for x := 1 to 5 do
      begin
        Write(Example[x, y]:3);
        Write(Out, Example[x, y]:3);
      end;
      WriteLn;
      WriteLn(Out);
    end;
    Close(Out);
  end;
end;

var
  c: Char;

begin
  repeat
    WriteLn('The 1995 British Informatics Olympiad Round Two');
    WriteLn('Example Solution to Question Three: Squares');
    WriteLn('Copyright (C) Antony Rix 1995');
    WriteLn;
    WriteLn('Choose an option:');
    WriteLn('  A - Problem (A)');
    WriteLn('  B - Problem (B)');
    WriteLn('  X - Exit the program');
    WriteLn;
    Write('Press a key:');
    c := ReadKey;
    WriteLn;
    WriteLn;

    case UpCase(c) of
      'A': ProblemA;
      'B': ProblemB;
      'X': WriteLn('Exiting...');
    else
      WriteLn('Please press A, B, or X.');
    end;
    WriteLn;
  until UpCase(c) = 'X';
end.
{ Program 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
}