Cod sursa(job #362044)

Utilizator ionutz32Ilie Ionut ionutz32 Data 7 noiembrie 2009 18:49:29
Problema Rj Scor 50
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.64 kb
var a:array[0..101,0..101,1..3] of byte;
f,g:text;
m,n,i,j,t,x,y:word;
c:char;
k:boolean;
begin
assign(f,'rj.in');
assign(g,'rj.out');
reset(f);rewrite(g);
readln(f,m,n);
for i:=1 to m do
    begin
    for j:=1 to n do
        begin
        read(f,c);
        if c='X' then
           a[i,j,1]:=1
        else
            if c='J' then
               a[i,j,2]:=1
            else
                if c='R' then
                   a[i,j,3]:=1;
        end;
    readln(f);
    end;
t:=1;
repeat
      t:=t+1;
      for i:=1 to m do
          for j:=1 to n do
              begin
              if (a[i,j,2]<>1) and (a[i,j,1]=0) and ((a[i-1,j-1,2]=1) or (a[i-1,j,2]=1) or (a[i-1,j+1,2]=1) or (a[i,j-1,2]=1)
or (a[i,j+1,2]=1) or (a[i+1,j-1,2]=1) or (a[i+1,j,2]=1) or (a[i+1,j+1,2]=1)) then
                 a[i,j,2]:=2;
              if (a[i,j,3]<>1) and (a[i,j,1]=0) and ((a[i-1,j-1,3]=1) or (a[i-1,j,3]=1) or (a[i-1,j+1,3]=1) or (a[i,j-1,3]=1)
or (a[i,j+1,3]=1) or (a[i+1,j-1,3]=1) or (a[i+1,j,3]=1) or (a[i+1,j+1,3]=1)) then
                 a[i,j,3]:=2;
              end;
      k:=false;
      for i:=1 to m do
          begin
          for j:=1 to n do
              begin
              if (a[i,j,2]=2) and (a[i,j,3]=2) then
                 begin
                 x:=i;y:=j;
                 k:=true;
                 break;
                 end;
              if a[i,j,2]=2 then
                 a[i,j,2]:=1;
              if a[i,j,3]=2 then
                 a[i,j,3]:=1;
              end;
          if k=true then
             break;
          end;
until k=true;
write(g,t,' ',x,' ',y);
close(f);close(g);
end.