Cod sursa(job #1370018)

Utilizator Andreea1864Andreea Oancea Andreea1864 Data 3 martie 2015 12:39:00
Problema Rj Scor 0
Compilator fpc Status done
Runda Arhiva de probleme Marime 2.56 kb
type poz = record lin,col:integer;end;
type sir = array[1..8] of integer;
type coada = array[1..1000] of poz;
type matl = array[0..105,0..105] of char;
type matn = array[0..105,0..105] of integer;
var l:matn;
    lc:matl;
    cr,cj:coada;
    dl,dc:sir;
    f,g:text;
    pr,pcr,pcj,vr,vj,pj:poz;
    n,m,k,i,j,primr,ultimr,primj,ultimj:integer;
    ok:boolean;

procedure citire(var l:matn;var n,m:integer);
var i,j:integer;
    lc:matl;
    x:char;
begin
 readln(f,n,m);
 for i:=1 to n do  begin
  for j:=1 to n do begin
   read(f,x);      l[i,j]:=0;
   if x='R' then begin l[i,j]:=1;pr.lin:=i;pr.col:=j;end;
   if x='J' then begin l[i,j]:=1;pj.lin:=i;pj.col:=j;end;
   if x='X' then l[i,j]:=-1 ;

  end;
  readln(f);
  end;
end;

procedure bordare(var l:matn;n,m:integer);
var i:integer;
begin
 for i:=0 to m+1 do begin
  l[0,i]:=-1;
  l[n+1,i]:=-1;
 end;
 for i:=0 to n+1 do begin
  l[i,0]:=-1;
  l[i,m+1]:=-1;
 end;
end;

procedure max(l:matn;n,m:integer);
var i,j,max:integer;
    p:poz;
begin
 max:=-maxint;
 for i:=1 to n do
  for j:=1 to m do if l[i,j]>max then begin max:=l[i,j];p.lin:=i;p.col:=j;end;
 write(max,' ',p.lin,' ',p.col);
end;


begin
assign(f,'rj.in');reset(f);
assign(g,'rj.out');rewrite(g);
citire(l,n,m);
bordare(l,n,m);
dl[1]:=-1;dl[2]:=-1;dl[3]:=-1;dl[4]:=0; dl[5]:=0;dl[6]:=1; dl[7]:=1;dl[8]:=1;
dc[1]:=-1;dc[2]:=0; dc[3]:=1; dc[4]:=-1;dc[5]:=1;dc[6]:=-1;dc[7]:=0;dc[8]:=1;
primr:=1;
ultimr:=1;
primj:=1;
ultimj:=1;
cr[1]:=pr;
cj[1]:=pj;
l[pr.lin,pr.col]:=1;
l[pj.lin,pj.col]:=1;ok:=false;
while (ok=false) and (primr<=ultimr) and (primj<=ultimj) do begin
 pcr:=cr[primr];inc(primr);
 pcj:=cj[primj];inc(primj);

 for k:=1 to 8 do begin
  vr.lin:=pcr.lin+dl[k];
  vr.col:=pcr.col+dc[k];
  if l[vr.lin,vr.col]=0 then begin l[vr.lin,vr.col]:=l[pcr.lin,pcr.col]+1;
  inc(ultimr);
  cr[ultimr]:=vr;end;
 end;

 {writeln('r');
 for i:=1 to n do begin
  for j:=1 to m do write(l[i,j]:2);
  writeln;end;}

 k:=1;
 while (ok=false) and (k<=8) do begin
  vj.lin:=pcj.lin+dl[k];
  vj.col:=pcj.col+dc[k];
  if l[vj.lin,vj.col]=0 then begin l[vj.lin,vj.col]:=l[pcj.lin,pcj.col]+1;
                                   inc(ultimj);
                                   cj[ultimj]:=vj;end
                        else if l[vj.lin,vj.col]>0 then begin ok:=true;
                        end;
  inc(k);
 end;
{ writeln('j');
 for i:=1 to n do begin
  for j:=1 to m do write(l[i,j]:2);
  writeln;end;}
end;
max(l,n,m);
close(g);
end.