Cod sursa(job #284592)

Utilizator vladcfVlad Frasineanu vladcf Data 21 martie 2009 20:17:59
Problema Text Scor 0
Compilator fpc Status done
Runda contest01 Marime 1.84 kb
var n,i,j,x,y,p:integer;
    m:array[1..11,1..11] of integer;
    ok:boolean;
    f,g:text;
begin
assign (f,'text.in');
assign (g,'text.out');
reset (f);
rewrite (g);

read (f,n);
for i:=1 to n do
    for j:=1 to n do
        read (f,m[i,j]);
x:=1;
y:=1;
for i:=2 to n do
    begin
     if m[i,i]=0 then
        begin
          if m[x,y+1]=1 then
             begin
                            ok:=false;
              p:=1;
              while not(ok) do
                    begin
                     if m[x,y+p]=0 then
                        begin
                        writeln (g,x+p,' ',y+p);
                        y:=y+p;
                        if (x=i) and (y=i) then ok:=true;
                        end
                        else
                        begin
                        writeln (g,x+p,' ',y);
                        x:=x+p;
                        if (x=i) and (y=i) then ok:=true;
                        end;
                    end;


             end
             else
             begin
              ok:=false;
              p:=1;
              while not(ok) do
                    begin
                     if m[x+p,y+p]=0 then
                        begin

                        if (x+p=i) and (y+p=i) then
                           begin

                           ok:=true;
                           y:=i;
                           writeln (g,x,' ',y);
                           writeln (g,x+p,' ',y);
                           end;

                        x:=x+p;
                        end
                        else
                        begin
                        writeln (g,x+p,' ',y);
                        y:=y+p;
                        end;
                     end;
             end;

        end;
    end;
close (f);
close (g);
end.