Cod sursa(job #187945)

Utilizator qSortMorariu Razvan qSort Data 5 mai 2008 21:19:06
Problema Rj Scor 100
Compilator fpc Status done
Runda Arhiva de probleme Marime 2.65 kb
program romeo_julieta;
const dx: array[1..8] of -1..1=(-1,-1,0,1, 1, 1, 0,-1);
			dy: array[1..8] of -1..1=( 0, 1,1,1, 0,-1,-1,-1);
type matrice= array[0..101,0..101]of integer;
		 celula= record
						lin,col,pas:integer;
						end;
		 coada=array[1..10000] of celula;
var rom,jul: matrice;
		{r,j:coada;o declar locala}
		f,g,h,p:text;
		n,m,xr,xj,yr,yj,min:integer;
procedure citire;
var i,j:integer;
		c:char;
begin
	assign(f,'rj.in'); reset(f);
	readln(f,n,m);
	for i:=1 to n do
		for j:=1 to m do
		 begin
			rom[i,j]:=0;
			jul[i,j]:=0;
     end;
for i:=1 to n do
	begin
	for j:=1 to m do
		begin
			read(f,c);
			case c of
			'X':begin  rom[i,j]:=-1; jul[i,j]:=-1;  end;
			'R': begin rom[i,j]:=1; xr:=i; yr:=j; end;
			'J': begin jul[i,j]:=1; xj:=i; yj:=j; end;
			end;
		end;
	 readln(f);
	end;
close(f);
end;
procedure test;
var i,j:integer;
begin
assign(h,'romeo.out'); rewrite(h);
assign(p,'julieta.out'); rewrite(p);
for i:=1 to n do
begin
  for j:=1 to m do
       begin
         write(h,rom[i,j]:3);
         write(p,jul[i,j]:3);
       end;
  writeln(h);
  writeln(p);
end;
close(h);close(p);
end;
procedure bordare;
var i,j:integer;
begin
		for j:=0 to m+1 do begin
											rom[0,j]:=-1;
											rom[n+1,j]:=-1;
											jul[0,j]:=-1;
											jul[n+1,j]:=-1;
										 end;
	for i:=0 to n+1 do begin
											rom[i,0]:=-1;
											rom[i,m+1]:=-1;
											jul[i,0]:=-1;
											jul[i,m+1]:=-1;
										 end;
end;
procedure lee(var mat:matrice; x0,y0:integer);
var c:coada;
    pi,ps,k:integer;
		y,z:celula;
begin
 pi:=1;
 ps:=1;
 c[pi].lin:=x0;
 c[pi].col:=y0;
 c[pi].pas:=1;
 	while ps<=pi do
  	begin
    	y:=c[ps];
      ps:=ps+1;
      for k:=1 to 8 do
      	begin
        	z.lin:=y.lin+dx[k];
          z.col:=y.col+dy[k];
          z.pas:=y.pas+1;
          if mat[z.lin,z.col]=0 then begin
          														mat[z.lin,z.col]:=z.pas;
                                      pi:=pi+1;
                                      c[pi]:=z;
          														end;
        end;
    end;

end;

procedure sol;
var i,j:integer;
begin
 min:=maxint;
for i:=1 to n do
	for j:=1 to m do
  	begin
    	if(rom[i,j]=jul[i,j]) and (rom[i,j]<min) and(rom[i,j]<>-1)and(rom[i,j]<>0) then begin
																																				min:=rom[i,j];
                                                                        xr:=i;
                                                                        yr:=j;
    end;                                                              end;
end;
procedure afisare;
begin
 assign(g,'rj.out'); rewrite(g);
 write(g,min,' ',xr,' ',yr);
close(g);
end;




begin
citire;
bordare;
{test;}
lee(rom,xr,yr);
lee(jul,xj,yj);
test;
sol;
afisare;
end.