Cod sursa(job #583678)

Utilizator elffikkVasile Ermicioi elffikk Data 21 aprilie 2011 19:15:03
Problema Car Scor 10
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.82 kb
var a:array[1..500, 1..500] of byte;
    b:array[1..500,1..500] of boolean;
    n,m,x1,y1,x2,y2,sum:integer;
    x,y:array[1..2500]of byte;
    pp:longint;
    
procedure init;
var i,j:integer; f:text;
begin
  sum:=-1; pp:=0;
  assign(f, 'car.in');
  reset(f);
  read(f,n,m);
  read(f,x1,y1,x2,y2);
  for i:=1 to n do
  begin
    for j:=1 to m do
    begin
      read(f,a[i,j]);
      {write(a[i,j]);}
      b[i,j]:=false;
    end;
    {writeln;}
  end;
  close(f);
end;

procedure finish(k:integer);
var i,s:integer;
begin
  s:=0;
  for i:=3  to k do
  begin
    s:=s+abs((x[i]-x[i-1])- (x[i-1]-x[i-2]));
    s:=s+abs((y[i]-y[i-1])-(y[i-1]-y[i-2]));
  end;
 {   writeln(x[i],' ',y[i]);}
  if s>sum then sum:=s;
end;

procedure pas(p,px,py:integer);
begin
  inc(pp);
  if pp<500000 then begin
  x[p]:=px; y[p]:=py;
  if (px=x2) and (py=y2)
  then begin
    finish(p);
  end
  else begin
     b[px,py]:=true;
     if (px-1>0) and(a[px-1,py]=0) and not b[px-1,py] then pas(p+1,px-1,py);
     if (px+1<=n) and(a[px+1,py]=0) and not b[px+1,py] then pas(p+1,px+1,py);
     if (py-1>0) and(a[px,py-1]=0) and not b[px,py-1] then pas(p+1,px,py-1);
     if (py+1<=n) and(a[px,py+1]=0) and not b[px,py+1] then pas(p+1,px,py+1);
     if (px-1>0)and(py-1>0) and(a[px-1,py-1]=0)and not b[px-1,py-1] then pas(p+1,px-1,py-1);
     if (px-1>0)and(py+1<=n) and(a[px-1,py+1]=0)and not b[px-1,py+1] then pas(p+1,px-1,py+1);
     if (px+1<=n)and(py-1>0) and(a[px+1,py-1]=0)and not b[px+1,py-1] then pas(p+1,px+1,py-1);
     if (px+1<=n)and(py+1<=n) and(a[px+1,py+1]=0)and not b[px+1,py+1] then pas(p+1,px+1,py+1);
     b[px,py]:=false;
  end;
  end;
end;

procedure rez;
var f:text;
begin
  assign(f,'car.out');
  rewrite(f);
  write(f,sum);
  close(f);
end;

begin
  init;
  pas(1,x1,y1);
  rez;
end.