Cod sursa(job #237383)

Utilizator MihaiBunBunget Mihai MihaiBun Data 29 decembrie 2008 17:11:20
Problema Tablete Scor 30
Compilator fpc Status done
Runda Arhiva de probleme Marime 2.21 kb
program table;
var a:array[1..1000,1..1000] of longint;
    n,k,i,j,d,e:longint;
    f:text;
begin
  assign(f,'tablete.in');
  reset(f);
  readln(f,n,k);
  close(f);
  assign(f,'tablete.out');
  rewrite(f);
  d:=0;
  for i:=1 to n do
  for j:=1 to n do
  begin
  d:=d+1;
  a[i,j]:=d
  end;
  if n mod 2 =0 then begin if k mod 2<>0 then
                       begin
                       i:=-1;
                       repeat
                       i:=i+2;
                       d:=a[i,1];
                       e:=a[i+1,n];
                       for j:=1 to n-1 do
                          begin
                          a[i,j]:=a[i,j+1];
                          a[i+1,n-j+1]:=a[i+1,n-j]
                          end;
                       a[i,n]:=e;
                       a[i+1,1]:=d
                       until i=n-1
                       end
                     end
                else begin
                     if k mod 2=0 then
                           begin
                       i:=-1;
                       repeat
                       i:=i+2;
                       d:=a[i,1];
                       e:=a[i+1,n];
                       for j:=1 to n-1 do
                          begin
                          a[i,j]:=a[i,j+1];
                          a[i+1,n-j+1]:=a[i+1,n-j]
                          end;
                       a[i,n]:=e;
                       a[i+1,1]:=d
                       until i=n-2
                       end
                               else
                               begin
                                   i:=0;
                       repeat
                       i:=i+2;
                       d:=a[i,1];
                       e:=a[i+1,n];
                       for j:=1 to n-1 do
                          begin
                          a[i,j]:=a[i,j+1];
                          a[i+1,n-j+1]:=a[i+1,n-j]
                          end;
                       a[i,n]:=e;
                       a[i+1,1]:=d
                       until i=n-1
                                end
                        end;
  for i:=1 to n do
  begin
  for j:=1 to n do
  write(f,a[i,j],' ');
  writeln(f)
  end;
  close(f)
end.