Заполнить массив заданным образом - PascalABC.NET

const
  n = 6;
 
var
  a: array[1.. n, 1.. n] of integer;
  i, j, x, di: integer;
 
begin
  i := 1; x := 1; di := 1;
  // собственно, заполнение
  for j := 1 to n do
  begin
    while (i > 0) and (i <= n) do
    begin
      a[i, j] := x; x += 1;
      inc(i, di);
    end;
    di := -di;
    inc(i, di);
  end;
  
  // а теперь - вывод
  for i := 1 to n do
  begin
    for j := 1 to n do write(a[i, j]:3);
    writeln;
  end;
end.