Cod sursa(job #135065)

Utilizator time_testtime tester time_test Data 12 februarie 2008 21:50:51
Problema Barbar Scor 0
Compilator fpc Status done
Runda Arhiva de probleme Marime 2.13 kb
type coord=record
      x,y:integer;
    end;
type pelem=^elem;
     elem=record
       info:coord;
       next:pelem;
     end;
type vector=array[1..4]of integer;
const dx:vector=(0,0,1,-1);
      dy:vector=(1,-1,0,0);
const nmax=1000001;
var fi,fo:text;
    R,C,i,j,iu,ju,xi,yi,xf,yf,k:integer;
    first,last:pelem;
    a:array[0..1001,0..1001]of char;
    o:array[0..1001,0..1001]of longint;
    pc,pu:coord;
procedure qout(var vl:coord);
var p:pelem;
begin
  p:=first;
  vl:=first^.info;
  first:=first^.next;
  dispose(p);
end;
procedure qin(vl:coord);
var p:pelem;
begin
  new(p);
  p^.info:=vl;
  p^.next:=nil;
  if first=nil then
    begin
      first:=p;
      last:=first;
    end
  else
    begin
      last^.next:=p;
      last:=p;
    end;
end;
begin
  assign(fi,'barbar.in'); reset(fi);
  assign(fo,'barbar.out'); rewrite(fo);
  readln(fi,R,C);
  for i:=1 to R do
    begin
      for j:=1 to C do
        begin
          read(fi,a[i,j]);
          o[i,j]:=nmax;
          if a[i,j]='I' then
            begin
              xi:=i;
              yi:=j;
            end;
          if a[i,j]='O' then
            begin
              xf:=i;
              yf:=j;
              a[i,j]:='.';
            end;
          if a[i,j]='D' then
            begin
              o[i,j]:=0;
              pc.x:=i; pc.y:=j;
              qin(pc);
            end;
        end;
      readln(fi);
    end;
  for i:=0 to R+1 do
    begin
      a[i,0]:='*';
      a[i,R+1]:='*';
    end;
  for i:=0 to C+1 do
    begin
      a[0,i]:='*';
      a[0,C+1]:='*';
    end;
  while first<>nil do
    begin
      qout(pc); i:=pc.x; j:=pc.y;
      for k:=1 to 4 do
        begin
          if (i=xf)and(j=yf) then continue;
          iu:=i+dx[k]; ju:=j+dy[k];
          if (a[iu,ju]='.')and(o[iu,ju]>o[i,j]+1) then
            begin
              o[iu,ju]:=o[i,j]+1;
              pu.x:=iu; pu.y:=ju; qin(pu);
            end;
        end;
    end;
  for i:=1 to R do
    begin
      for j:=1 to C do
        write(fo,o[i,j],' ');
      writeln(fo);
    end;
  close(fi);
  close(fo);
end.