Cod sursa(job #57438)

Utilizator cezar305Mr. Noname cezar305 Data 2 mai 2007 00:10:29
Problema Car Scor 10
Compilator fpc Status done
Runda Arhiva de probleme Marime 3.04 kb
var a:array[0..501,0..501] of longint;
    i,j,m,n,x,pos,c,si,sj,fi,fj,gi,gj,xi,xj,nri,nrj,nr:longint;
    f1,f2:text;
    ok:boolean;

procedure vecini(x,y:longint);
begin
        if a[x,y]>pos+1 then
        begin
                ok:=true;
                a[x,y]:=pos+1;
        end;
end;

procedure ifok;
begin
        if a[gi-1,gj]=a[gi,gj]-1 then begin xi:=-1; xj:=0; end
        else
        if a[gi+1,gj]=a[gi,gj]-1 then begin xi:=+1; xj:=0; end
        else
        if a[gi-1,gj+1]=a[gi,gj]-1 then begin xi:=-1; xj:=+1; end
        else
        if a[gi-1,gj-1]=a[gi,gj]-1 then begin xi:=-1; xj:=-1; end
        else
        if a[gi+1,gj-1]=a[gi,gj]-1 then begin xi:=+1; xj:=-1; end
        else
        if a[gi+1,gj+1]=a[gi,gj]-1 then begin xi:=+1; xj:=+1; end
        else
        if a[gi,gj-1]=a[gi,gj]-1 then begin xi:=0; xj:=-1; end
        else
        if a[gi,gj+1]=a[gi,gj]-1 then begin xi:=0; xj:=+1; end;
end;

begin
        assign(f1,'car.in');
        reset(f1);
        assign(f2,'car.out');
        rewrite(f2);
        read(f1,n,m);
        read(f1,si,sj,fi,fj);
        for i:=1 to n do
        begin
                for j:=1 to m do
                begin
                        read(f1,c);
                        if c=0 then a[i,j]:=maxlongint;
                        if c=1 then a[i,j]:=-1;
                end;
                readln(f1);
        end;
        a[si,sj]:=1;
        ok:=true;
        for i:=1 to n do
        begin
                a[i,0]:=-1;
                a[i,m+1]:=-1;
        end;
        for i:=1 to m do
        begin
                a[0,i]:=-1;
                a[n+1,i]:=-1;
        end;
        while ok=true do begin
                ok:=false;
                inc(pos);
                for i:=1 to n do
                        for j:=1 to n do
                        begin
                                if a[i,j]=pos then
                                begin
                                        vecini(i-1,j);
                                        vecini(i+1,j);
                                        vecini(i,j+1);
                                        vecini(i,j-1);
                                        vecini(i-1,j-1);
                                        vecini(i-1,j+1);
                                        vecini(i+1,j-1);
                                        vecini(i+1,j+1);
                                end;
                        end;
                if a[fi,fj]<>maxlongint then break;
        end;
        gi:=fi;
        gj:=fj;
        nri:=0;
        nrj:=0;
        x:=a[fi,fj];
        while x<>1 do
        begin
                ifok;
                gi:=gi+xi;
                gj:=gj+xj;
                if x<>a[fi,fj] then
                begin
                        nr:=nr+abs(nri-xi)+abs(nrj-xj);
                        nri:=xi;
                        nrj:=xj;
                end;
                x:=a[gi,gj];
        end;
        writeln(f2,nr-1);
        close(f1);
        close(f2);
end.