program fiveteen;
{basic functionality and -solve , -show are O.K., but it doesn't find an optiomal solution}
uses crt;
var a:array [1..4,1..4] of byte;
    i,j,now,x,y,shifts:integer;                {now- which number should be placed now, x,y- place where is empty field,shifts-
                                               number of shifts}
    flag,solve,show:boolean;
    ss:string;
    t:text;

procedure out;
begin                           {writes field on monitor}
 clrscr;
 writeln;
 for j:=1 to 4 do
  begin
   for i:=1 to 4 do
     if a[i,j]<>0 then write(a[i,j]:8) else write('        ');
   writeln;
   writeln;
  end;
end;

procedure reading(s:string);  {this procedure is reading puzzle from file}
var ch,ch2:char;
    code:integer;
begin
 assign(t,s);
 reset(t);
 for j:=1 to 4 do
  for i:=1 to 4 do
     begin
      repeat read(t,ch);until ch in ['0'..'9','X'];
      if ch<>'X' then                       {we must be careful of 'X' becouse it isn't number}
           begin
            read(t,ch2);
            if ch2 in ['0'..'9'] then val(ch+ch2,a[i,j],code) else val(ch,a[i,j],code);
           end
           else begin a[i,j]:=0;x:=i;y:=j; end;   {empty place}
     end;
 close(t);
end;

procedure moveone(ch:char);
begin                           {it moves with one card}
 write(t,ch);
 inc(shifts);
 case ch of
  'r':begin a[x,y]:=a[x-1,y];a[x-1,y]:=0;x:=x-1;end;
  'l':begin a[x,y]:=a[x+1,y];a[x+1,y]:=0;x:=x+1;end;
  'd':begin a[x,y]:=a[x,y-1];a[x,y-1]:=0;y:=y-1;end;
  'u':begin a[x,y]:=a[x,y+1];a[x,y+1]:=0;y:=y+1;end;
  end;
 if show then begin out; delay(200);end;
end;

procedure movement(s:string);
var qw:integer;              {it moves with more cards calling moveone}
begin
 for qw:=1 to length(s) do moveone(s[qw]);
end;

function border(x1,y1:byte):byte;
{this function says if x1,y1 is at border field, 1. bit means that it's at up border, 2.bit means right e.t.c.}
var qw:byte;
begin
 qw:=0;
 if y1=1 then qw:=qw or 1;
 if x1=4 then qw:=qw or 2;
 if y1=4 then qw:=qw or 4;
 if x1=1 then qw:=qw or 8;
 border:=qw;
end;

procedure place_it(number:byte);
{this procedure place the number on right place, xx,yy says where the number is, tx,ty is target place}
var xx,yy,tx,ty:byte;
begin
 for j:=1 to 4 do
   for i:=1 to 4 do if a[i,j]=number then begin xx:=i; yy:=j;end;
 tx:=(number-1) mod 4 +1;
 ty:=(number-1) div 4 +1;
 if number=10 then begin tx:=1;ty:=3;end;
 if (number=11)or(number=9) then begin tx:=2;ty:=3;end;
 if number=12 then begin tx:=3;ty:=3;end;
 if (xx<>tx)or(yy<>ty) then
 begin
 if number mod 4=0 then ty:=ty+1;
 while xx>tx do               {place it to right sloupec}
   begin
    if x>=xx then
           begin
            if y=yy then if border(x,y) and 4<>0 then moveone('d') else moveone('u');
            while x>=xx do moveone('r');
           end;
    while x<xx-1 do moveone('l');
    while y<yy do moveone('u');      {moving empty field}
    while y>yy do moveone('d');
    moveone('l');dec(xx);
   end;
 while xx<tx do          {same from other side}
    begin
    if x<=xx then
           begin
            if y=yy then if border(x,y) and 4<>0 then moveone('d') else moveone('u');
            while x<=xx do moveone('l');
           end;
    while x>xx+1 do moveone('r');
    while y<yy do moveone('u');              {moving empty field}
    while y>yy do moveone('d');
    moveone('r');inc(xx);
   end;
 while yy>ty do         {place it to right row}
    begin
     if y>=yy then
           begin
            if (x<xx)and(y=yy)and(y<>4) then moveone('u');
            if (yy<>4) then while (x<=xx)and(xx<>4) do moveone('l');
            if x=xx then if border(x,y) and 2<>0 then moveone('r') else moveone('l');
            while y>=yy do moveone('d');
           end;
     while y<yy-1 do moveone('u');
     while x<xx do moveone('l');           {moving empty field}
     while x>xx do moveone('r');
     moveone('u');dec(yy);
    end;
 if number mod 4 =0 then
      begin
       while x>1 do moveone('r');
       while y>ty do moveone('d');
       movement('dlllurdrru');          {this is finta}
      end;
 if y=yy then moveone('u');             {shift for save}
 end;
end;

procedure finta1(number:byte);
{special procedure for placing 11 and 12}
var xx,yy:integer;
begin
 for j:=1 to 4 do
   for i:=1 to 4 do if a[i,j]=number then begin xx:=i; yy:=j;end;
 if number=11 then
  begin
   if x=1 then moveone('l');
   while x>2 do moveone('r');
  end
  else
  begin
   if x=2 then moveone('l');
   while x>3 do moveone('r');
  end;
 if y=3 then moveone('u');
 if number=11 then
   if (xx<>2)or(yy<>3) then
     if (xx=1)and(yy=4) then
         movement('rdluldrruldl')          {it is finta again}
         else place_it(11);
 if number=12 then
   if (xx<>3)or(yy<>3) then
     if (xx=2)and(yy=4) then
         movement('rdluldrruldl')          {and again}
         else if a[4,3]=12 then movement('dl') else movement('ldru');
 if y=3 then moveone('u');
 while x>number-10 do moveone('r');
 movement('dl');
end;

procedure finish;
begin
 if x=4 then moveone('r');
 if y=4 then moveone('d');
 while a[3,4]<>13 do movement('lurd');
 movement('rrullldrrrulll');
end;

procedure mich;
var wq:integer;
begin
randomize;
 for wq:=1 to 15 do
  repeat
   i:=random(4)+1;j:=random(4)+1;
   if a[i,j]=0 then a[i,j]:=wq;
  until a[i,j]=wq;
 for j:=1 to 4 do
   for i:=1 to 4 do if a[i,j]=0 then begin x:=i; y:=j;end;
end;

procedure write_solution;
var ch:char;
begin
 writeln;
 writeln('Number of shifts:',shifts);
 reset(t);
 while not(eof(t)) do
   begin
    read(t,ch);
    case ch of
      'l':write('Left,');
      'r':write('Right,');
      'u':write('Up,');
      'd':write('Down,');
      end;
   end;
 close(t);
end;

begin
if paramcount=0 then writeln('You should write some parametr, i.e. name of puzzle that should be solved.')
   else
 begin
  i:=1;
  ss:=paramstr(i);
  if ss[1]='-' then
       begin
        if paramstr(i)='-solve' then solve:=true else solve:=false;
        if paramstr(i)='-show' then show:=true else show:=false;
        inc(i);
       end;
 reading(paramstr(i));
   now:=1;shifts:=0;
   assign(t,'my.txt');
   rewrite(t);
   for now:=1 to 8 do place_it(now);
   place_it(10);                         {the main part, calling placing}
   finta1(11);
   place_it(9);
   finta1(12);
   finish;
   close(t);
   if a[2,4]<>14 then begin clrscr;writeln('It could not be transormed to goal state.');end
     else
      if (solve)or(show) then write_solution else
                         begin clrscr;writeln('It could be transformed to goal state');end;
 end;
end.