Cod sursa(job #262110)

Utilizator DanielGGlodeanu Ioan Daniel DanielG Data 18 februarie 2009 23:27:56
Problema Rj Scor 0
Compilator fpc Status done
Runda Arhiva de probleme Marime 3.48 kb
var a:array[1..100,1..100] of integer;
x,y:array[1..10000] of byte;
f:text; c:char;
tmax,aux,xs,ys,xi,xf,yi,yf,xc,yc,u,p,n,m:integer;
procedure citire;
var i,j:byte;
begin
assign(f,'rj.in');reset(f);
readln(f,n,m);
for i:=1 to n do
begin
j:=1;
    while not eoln(f) do
        begin
        read(f,c);
        a[i,j]:=0;
        if c='X' then a[i,j]:=-1;
        if c='R' then begin
                              xi:=i;
                              yi:=j;
                              end;
        if c='J' then begin
                                   xf:=i;
                                   yf:=j;

        end;
                                   inc(j);
    end;
    readln(f);
    end;
    if xi>xf then begin
                  aux:=xi;
                  xi:=xf;
                  xf:=aux;
                  aux:=yi;
                  yi:=yf;
                  yf:=AUX;
                  END;

x[1]:=xi;
y[1]:=yi;
a[xi,yi]:=1;
close(f);
end;
procedure lee;
begin
p:=1; u:=1;
while p<=u do
      begin
      xc:=x[p]; yc:=y[p];
      if (xc-1>0) and (a[xc-1,yc]=0) then
                      begin
                      inc(u);
                      x[u]:=xc-1;
                      y[u]:=yc;
                      a[x[u],y[u]]:=a[xc,yc]+1;
                      end;
      if (xc+1<=n) and (a[xc+1,yc]=0) then
                       begin
                       inc(u);
                       x[u]:=xc+1;
                       y[u]:=yc;
                       a[x[u],y[u]]:=a[xc,yc]+1;
                       end;
      if (yc-1>0) and (a[xc,yc-1]=0) then
                      begin
                      inc(u);
                      x[u]:=xc;
                      y[u]:=yc-1;
                      a[x[u],y[u]]:=a[xc,yc]+1;
                      end;
      if (yc+1<=m) and (a[xc,yc+1]=0) then
                       begin
                       inc(u);
                       x[u]:=xc;
                       y[u]:=yc+1;
                       a[x[u],y[u]]:=a[xc,yc]+1;
                       end;
      if (xc-1>0) and (yc-1>0) and (a[xc-1,yc-1]=0) then
                  begin
                  inc(u);
                  x[u]:=xc-1;
                  y[u]:=yc-1;
                  a[x[u],y[u]]:=a[xc,yc]+1;
                  end;
      if (xc-1>0) and (yc+1<=m) and (a[xc-1,yc+1]=0) then
                  begin
                  inc(u);
                  x[u]:=xc-1;
                  y[u]:=yc+1;
                  a[x[u],y[u]]:=a[xc,yc]+1;
                  end;
      if (xc+1<=n) and (yc-1>0) and (a[xc+1,yc-1]=0) then
                  begin
                  inc(u);
                  x[u]:=xc+1;
                  y[u]:=yc-1;
                  a[x[u],y[u]]:=a[xc,yc]+1;
                  end;
      if (xc+1<=n) and (yc+1<=m) and (a[xc+1,yc+1]=0) then
                  begin
                  inc(u);
                  x[u]:=xc+1;
                  y[u]:=yc+1;
                  a[x[u],y[u]]:=a[xc,yc]+1;
                  end;
      inc(p);
      end;
end;
procedure afisare;
begin
assign(f,'rj.out');rewrite(f);
writeln(f,tmax,' ',xs,' ',ys);
close(f);
end;
procedure drum(xi,yi,xf,yf:byte);
var i,j:byte;
begin
for i:=1 to n do
    for j:=1 to m do
        if a[i,j]=tmax then
            begin
            xs:=i; ys:=j;
            break;
            end;
end;
begin
citire;
lee;
if a[xf,yf] mod 2=0 then tmax:=a[xf,yf] div 2
   else tmax:=a[xf,yf] div 2+1;
drum(xi,yi,xf,yf);
afisare;
end.