Заполнить матрицу в соответствии со схемой

uses crt;
var
 n:integer;
const
  nmax=10;
 
type
  TArray = array [1..nmax, 1..nmax] of Integer;
 
{Procedura vivodit matricu na ekran}
procedure Print(const a: TArray);
var
  i, j: integer;
begin
  for i := 1 to n do begin
    writeln;
    for j := 1 to n do begin
      write(a[i, j]:4);
    end;
  end;
end;
 
{Procedura sozdaet matricu i zapolnyaet ee v ykazannom poryadke}
procedure Create(var a: TArray);
var
  i, j, k: integer;
begin
 
   k := 0;
 
   i := 1;
   j := 1;
 
   a[i, j] := k;
 
   repeat
 
     if j < n then
       begin
         inc(j);
         inc(k);
         a[i, j] := k;
       end
     else
       begin
         inc(i);
         inc(k);
         a[i, j] := k;
       end;
 
        while (j > 1) and (i < n) do
          begin
            dec(j);
            inc(i);
            inc(k);
            a[i, j] := k;
          end;
 
           if i < n then
             begin
               inc(i);
               inc(k);
               a[i, j] := k;
             end
           else
             if j < n then
             begin
               inc(j);
               inc(k);
               a[i, j] := k;
             end;
 
              while (i > 1) and (j < n) do
              begin
                dec(i);
                inc(j);
                inc(k);
                a[i, j] := k;
              end;
 
   until (i = n) and (j = n);
end;
 
var
  a: TArray;
begin
  clrscr;
  writeln('vvedite n');
  readln(n);
  Create(a);
  Print(a);
  readln;
end.

while (j > 1)
while (i > 1)

writeln('vvedite n');
readln(n);
if n=1 then
 begin
  writeln('Нет ни одного шага, программа завершена!');
  readln;
  exit;
 end;
.........