Cod sursa(job #487296)

Utilizator yoannaserb ioana yoanna Data 24 septembrie 2010 17:40:07
Problema Rj Scor 50
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.54 kb
program rj;
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.