program Project2;

{$APPTYPE CONSOLE}

uses
  SysUtils;

const
   n = 6;

type
   TArrSort = array [1..(n * n)] of Integer;

function SortArr(MyArr: TArrSort): TArrSort;
var
   i, beg, en: Word;
   Temp: Integer;
begin
   beg := 1;
   en := Length(MyArr);
   while beg < en do
   begin
      for i := beg + 1 to en do
         if MyArr[i-1] > MyArr[i] then
         begin
            Temp := MyArr[i];
            MyArr[i] := MyArr[i-1];
            MyArr[i-1] := Temp;
         end;
      dec(en);
      for i := en - 1 downto beg do
         if MyArr[i + 1] < MyArr[i] then
         begin
            Temp := MyArr[i];
            MyArr[i] := MyArr[i+1];
            MyArr[i+1] := Temp;
         end;
      inc(beg);
   end;
   SortArr := MyArr;
end;

var
   i, j, x, y, til: Word;
   arr: array [1..n,1..n] of Integer;
   sort: TArrSort;

begin
   for i := 1 to n do
      for j := 1 to n do
         arr[i,j] := 10 * i + j;
   for j := 1 to n do
   begin
      for i := 1 to n do
         Write(arr[i][j],'   ');
      WriteLn;
   end;
   WriteLn;
   y := 1;
   x := 1;
   til := n;
   i := 1;
   sort[i] := arr[x,y];
   inc(i);
   repeat
      repeat
         inc(x);
         sort[i] := arr[x,y];
         inc(i);
      until(x = til) or (i > n * n);
      repeat
         inc(y);
         sort[i] := arr[x,y];
         inc(i);
      until(y = til) or (i > n * n);
      repeat
         dec(x);
         sort[i] := arr[x,y];
         inc(i);
      until(x = (n - til + 1)) or (i > n * n);
      repeat
         dec(y);
         sort[i] := arr[x,y];
         inc(i);
      until(y = (n - til + 2)) or (i > n * n);
      dec(til);
   until(i > n * n);
   for j := 1 to Length(sort) do
      Write(sort[j],' ');
   WriteLn(#13#10);
   Sort := SortArr(Sort);
   for j := 1 to Length(sort) do
      Write(sort[j],' ');
   WriteLn(#13#10);
   y := 1;
   x := 1;
   til := n;
   i := 1;
   arr[x,y] := sort[i];
   inc(i);
   repeat
      repeat
         inc(x);
         arr[x,y] := sort[i];
         inc(i);
      until(x = til) or (i > n * n);
      repeat
         inc(y);
         arr[x,y] := sort[i];
         inc(i);
      until(y = til) or (i > n * n);
      repeat
         dec(x);
         arr[x,y] := sort[i];
         inc(i);
      until(x = (n - til + 1)) or (i > n * n);
      repeat
         dec(y);
         arr[x,y] := sort[i];
         inc(i);
      until(y = (n - til + 2)) or (i > n * n);
      dec(til);
   until(i > n * n);
   for j := 1 to n do
   begin
      for i := 1 to n do
         Write(arr[i][j],'   ');
      WriteLn;
   end;
   ReadLn;
end.