Cod sursa(job #1185354)

Utilizator valen.valentinValentin Valeanu valen.valentin Data 15 mai 2014 16:17:24
Problema Rj Scor 0
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.62 kb
program rj;
type
tabel=array [0..102,0..102] of longint;
var
t,v:tabel;
f1,f2:text;
ind:boolean;
n,m,i,j,k,x,y,h,b:longint;
a:char;
begin
assign (f1,'rj.in');
assign (f2,'rj.out');
reset (f1);
rewrite (f2);
readln (f1,n,m);
i:=1; j:=0;
repeat
j:=j+1;
read (f1,a);
case a of
'X':t[i,j]:=1;
'R':t[i,j]:=2;
'J':t[i,j]:=3;
' ':t[i,j]:=0;
end;
if t[i,j]=3 then begin t[i,j]:=0; v[i,j]:=2; end else
if t[i,j]=2 then v[i,j]:=0 else
v[i,j]:=t[i,j];
if j=m then begin
readln (f1);
j:=0;
i:=i+1;
end;
until i=n+1;
k:=1;
repeat
k:=k+1;
ind:=true;
for i:=1 to n do
for j:=1 to m do
if t[i,j]=k then
begin
if t[i,j+1]=0 then begin
t[i,j+1]:=k+1; ind:=false; end;
if t[i+1,j]=0 then begin
t[i+1,j]:=k+1; ind:=false; end;
if t[i-1,j]=0 then begin
t[i-1,j]:=k+1; ind:=false; end;
if t[i,j-1]=0 then begin
t[i,j-1]:=k+1; ind:=false; end;
end;
until (ind);
k:=1;
repeat
k:=k+1;
ind:=true;
for i:=1 to n do
for j:=1 to m do
if v[i,j]=k then
begin
if v[i,j+1]=0 then begin
v[i,j+1]:=k+1; ind:=false; end;
if v[i+1,j]=0 then begin
v[i+1,j]:=k+1; ind:=false; end;
if v[i-1,j]=0 then begin
v[i-1,j]:=k+1; ind:=false; end;
if t[i,j-1]=0 then begin
v[i,j-1]:=k+1; ind:=false; end;
end;
until (ind);
b:=k-2;
{for i:=1 to n do begin
for j:=1 to m do
write (f2,t[i,j],' ');
writeln (f2);
end;
writeln (f2);
for i:=1 to n do begin
for j:=1 to m do
write (f2,v[i,j],' ');
writeln (f2);
end; }
for i:=1 to n do
for j:=1 to m do
if (t[i,j]=v[i,j]) and (h=0) and (t[i,j]<>1) and (t[i,j]<b) then begin
x:=i; y:=j;
k:=v[i,j];
h:=1;
end;
writeln (f2,k-2,' ',x,' ',y);
close (f1);
close (f2);
end.