Cod sursa(job #57434)

Utilizator cezar305Mr. Noname cezar305 Data 1 mai 2007 23:25:15
Problema Car Scor 0
Compilator fpc Status done
Runda Arhiva de probleme Marime 2.06 kb
var a:array[0..501,0..501] of longint;
    i,j,m,n,x,pos,c,si,sj,fi,fj: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;

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;
        {for i:=1 to n do
        begin
                for j:=1 to m do
                        write(f2,a[i,j],' ');
                writeln(f2);
        end;  }
        close(f1);
        close(f2);
end.