{$A+,B-,D+,E+,F-,G-,I-,L+,N-,O-,P-,Q-,R-,S+,T-,V+,X+,Y+}
{$M 16384,0,655360}
program Game;
uses Crt;    { $I- avoids runtime errors while working with the file }

type DeskType = array[0..3,0..3] of byte;

const GoalDesk  : DeskType = ((1,5,9,13),(2,6,10,14),
                              (3,7,11,15),(4,8,12,0));
      Flags     : byte = 0;
      MaxDepth         = 3;  { maximal depth of recursion }
      Depth     : byte = 0;  { actual depth of recursion  }
      ToPerform   : shortint = 0;
      TotalShifts : longint  = 0;

      UP = -1; DOWN = 1; LEFT = -2; RIGHT = 2;  { directions }

var ConvertedGoalDesk : array[0..15] of record
 { goal desk is converted in order to}    x,y:byte;
 {  process the data quicker }          end;
    Desk:DeskType;
    x,y,i,j:byte;
    Code,ii:integer;
    Rate:array[-2..2] of integer;
    Rating:integer;
    ch:char;
    VRAM:array[1..25,1..80] of record        { this variable is used for }
                                 ch:char;    { fast display operations   }
                                 at:byte;    { instead of Write          }
                               end absolute $B800:$0000;
                        { address, where VRAM is mapped on VGA }

procedure ModifyDesk(var CurrDesk:DeskType;x,y:byte;N:integer);
{ modifies a desk with the value from the input file }
{ checks for invalid and duplicate entries }
var xx,yy:byte;
begin
  if (N<0) or (N>15) then
  begin
    WriteLn('Invalid card specified in input file.');
    Halt;
  end;
  for yy:=0 to 3 do
   for xx:=0 to 3 do
    if CurrDesk[xx,yy]=N then
    begin
      WriteLn('Duplicated cards specified in input file.');
      Halt;
    end;
  CurrDesk[x,y]:=N;
end;

procedure LoadDeskFromFile(var CurrDesk:DeskType;FileName:string);
{ fills a desk with the data from a file }
{ checks is file exists and contain all cards }
var f:text;
    Line,s:string;
    x,y,i,j,Num:byte;
begin
  Assign(f,FileName);
  Reset(f);
  if IOResult<>0 then
  begin
    WriteLn('Error opening input file.');
    Halt;
  end;
  for y:=0 to 3 do
   for x:=0 to 3 do CurrDesk[x,y]:=255;
  i:=0;
  while not Eof(f) do
  begin
    ReadLn(f,Line);
    j:=1;
    while j<Length(Line) do
    begin
      while (j<=Length(Line)) and (Line[j]<=#32) do Inc(j);
      s[0]:=#0;
      while (j<=Length(Line)) and (Line[j]>#32) do
      begin
        s:=s+Line[j];
        Inc(j);
      end;
      if (s<>'') and (i<=16) then
      begin
        Val(s,Num,Code);  { str2int code<>0 means not a number }
        if Code=0 then ModifyDesk(CurrDesk,i mod 4,i div 4,Num)
         else if s='X' then ModifyDesk(CurrDesk,i mod 4,i div 4,0)
          else
          begin { only numbers and X are permitted }
            WriteLn('Error in input file.');
            Halt;
          end;
        Inc(i);
      end;
    end;
  end;
  if i<16 then
  begin
    WriteLn('Illegal number of cards specified in input file.');
    Halt;
  end;
  Close(f);
end;

procedure DrawDesk(CurrDesk:DeskType);
{ draws actual layout of cards on the desk }
var x,y:byte;
    s:string;

  procedure DrawCell(x,y:byte;s:string);
  { writes a string at the specified location, uses direct access }
  { in VRAM }
  var i:byte;
  begin
    for i:=x to x+Length(s)-1 do VRAM[y,i].ch:=s[i-x+1];
  end;

begin
  for y:=0 to 3 do
   for x:=0 to 3 do
   begin
     if CurrDesk[x,y]>0 then Str(CurrDesk[x,y],s) else s:=' ';
     while Length(s)<2 do s:=s+' ';
     DrawCell(32+x*5,6+y*2,s);
   end;
end;

function AmountOfDisorder(CurrDesk:DeskType):integer;
{ this is the key function for finding the solution }
{ it evaluates the given state of cards on the desk }
{ ordered cards have AmountOfDisorder 0             }
{ higher number means higher disorder               }
{ the purpose is to shift the cards so that this
                  number will decrease              }
var x,y:byte;
    Amount:integer;
begin
  Amount:=0;
  for y:=0 to 3 do
   for x:=0 to 3 do
    if CurrDesk[x,y]>0 then
    begin          { distance of actual pos. of card and goal pos. of card }
      Amount:=Amount+Abs(x-ConvertedGoalDesk[CurrDesk[x,y]].x)+
                     Abs(y-ConvertedGoalDesk[CurrDesk[x,y]].y);
    end;
  AmountOfDisorder:=Amount;
end;

function PerformShift(var CurrDesk:DeskType;ShiftDesired:shortint):boolean;
{ shifts the cards on a desk to specified or desired direction }
{ returns false if the shift could not be performed            }
var Possible:boolean;
    x,y,x0,y0:byte;

  procedure XChange(x1,y1,x2,y2:byte);
  { exchanges cards on specified locations }
  var Temp:byte;
  begin
    Temp:=CurrDesk[x1,y1];
    CurrDesk[x1,y1]:=CurrDesk[x2,y2];
    CurrDesk[x2,y2]:=Temp;
  end;

begin
  for y:=0 to 3 do
   for x:=0 to 3 do
    if CurrDesk[x,y]=0 then   { find the hole }
    begin
      x0:=x;
      y0:=y;
    end;
  Possible:=true;
  case ShiftDesired of
    UP    : if y0=3 then Possible:=false else XChange(x0,y0,x0,y0+1);
    DOWN  : if y0=0 then Possible:=false else XChange(x0,y0,x0,y0-1);
    LEFT  : if x0=3 then Possible:=false else XChange(x0,y0,x0+1,y0);
    RIGHT : if x0=0 then Possible:=false else XChange(x0,y0,x0-1,y0);
  end;
  PerformShift:=Possible;
end;

procedure TestShift(CurrDesk:DeskType;Shift,LastShift:shortint);
{ recursive procedure that makes virtual forward shifts }
{ it "looks in the future"                              }
{ main program uses this proc to find out which shift
   will be the best and will bring lower disorder       }
{ standardly, recursion goes to the depth of 5 calls    }
begin
  if LastShift<>-Shift then
  begin
    if AmountOfDisorder(CurrDesk)<Rating then
     Rating:=AmountOfDisorder(CurrDesk);  { compare best achieved rating }
  end;                                    { with actual rating           }
  if Depth>MaxDepth then Exit; { max depth reached }
  Inc(Depth);
  if LastShift<>-Shift then    { we mustn't make a return shift! }
  begin                        { for example LEFT and then RIGHT }
    if PerformShift(CurrDesk,Shift) then
    begin
      TestShift(CurrDesk,UP,Shift);    {}
      TestShift(CurrDesk,DOWN,Shift);  { recursive calls }
      TestShift(CurrDesk,LEFT,Shift);  {}
      TestShift(CurrDesk,RIGHT,Shift); {}
    end;
  end;
  Dec(Depth);
end;

begin
  if ParamCount=0 then   { no parameters }
  begin
    WriteLn('Usage: 06game [-solve|-show] <start_file> <goal_file>');
    Halt;
  end;
  if ParamCount=1 then LoadDeskFromFile(Desk,ParamStr(1)); { 1 parameter }
  if ParamCount=2 then  { 2 parameters }
  begin
    if ParamStr(1)='-solve' then     { -solve <filename> }
    begin
      Flags:=1;
      LoadDeskFromFile(Desk,ParamStr(2));
    end
    else if ParamStr(1)='-show' then   { -show <filename> }
    begin
      Flags:=2;
      LoadDeskFromFile(Desk,ParamStr(2));
    end
    else
    begin
      LoadDeskFromFile(Desk,ParamStr(1));  { <filename> <filename> }
      LoadDeskFromFile(GoalDesk,ParamStr(2));
    end;
  end;
  if ParamCount=3 then { 3 params ->  -solve|-show <filename> <filename> }
  begin
    LoadDeskFromFile(Desk,ParamStr(2));
    LoadDeskFromFile(GoalDesk,ParamStr(3));
    if ParamStr(1)='-solve' then Flags:=1 else
     if ParamStr(1)='-show' then Flags:=2;
  end;

  for i:=0 to 15 do   { converting the goal layout for higher access speed }
  begin
    for y:=0 to 3 do
     for x:=0 to 3 do if GoalDesk[x,y]=i then
     begin
       ConvertedGoalDesk[i].x:=x;
       ConvertedGoalDesk[i].y:=y;
     end;
  end;

  if Flags=1 then WriteLn('Total number of shifts: UNKNOWN')
             else WriteLn('Working...  ( >1 min. = this program is unable to find solution )');
  if Flags=2 then { flags=2 means that -show switch was used }
  begin
    ClrScr;          { draw a simple table }
    for x:=0 to 4 do
     for y:=5 to 13 do VRAM[y,x*5+30].ch:='|';
    for y:=0 to 4 do
     for x:=30 to 50 do VRAM[y*2+5,x].ch:='-';
    DrawDesk(Desk);
    GotoXY(1,24);
    Write('Any key for next shift, C for continuous shifting...');
  end;

  while (AmountOfDisorder(Desk)>0) and not KeyPressed do { main loop }
  begin
    Rating:=MaxInt;
    TestShift(Desk,UP,ToPerform);
    Rate[UP]:=Rating;
    Rating:=MaxInt;                                  { check ratings of }
    TestShift(Desk,DOWN,ToPerform);                  { all possible shifts }
    Rate[DOWN]:=Rating;
    Rating:=MaxInt;
    TestShift(Desk,LEFT,ToPerform);
    Rate[LEFT]:=Rating;
    Rating:=MaxInt;
    TestShift(Desk,RIGHT,ToPerform);
    Rate[RIGHT]:=Rating;
    ToPerform:=RIGHT;
    for ii:=-2 to 2 do                   { and choose the best rating }
    begin
      if (ii<>0) and (Rate[ii]<Rating) then
      begin
        Rating:=Rate[ii];
        ToPerform:=ii;
      end;
      if (ii<>0) and (Rate[ii]=Rating) and (Random<0.5) then
      begin             { when the ratings are equal, random helps }
        Rating:=Rate[ii];
        ToPerform:=ii;
      end;
    end;
    if Flags=1 then   { if -solve was used, display the chosen shift }
    begin
      case ToPerform of
        UP   :Write('UP      ');
        DOWN :Write('DOWN    ');
        LEFT :Write('LEFT    ');
        RIGHT:Write('RIGHT   ');
      end;
    end;
    PerformShift(Desk,ToPerform);
    Inc(TotalShifts);
    if Flags>1 then DrawDesk(Desk);  { if -show was used, draw actual layout }
    if Flags=2 then
    begin
      ch:=ReadKey;
      if UpCase(ch)='C' then Flags:=3;
      if ch=#27 then Break;
    end;
  end;
  WriteLn;
  if AmountOfDisorder(Desk)=0 then
   WriteLn('Solution found! (',TotalShifts,' shifts needed)')
    else WriteLn('===terminated===');
  WriteLn;
end.

