Eight queens problem (Unoptimized)

type
    TArray = array [1..1000000] of longint;

procedure draw(positions: TArray; size: longint);
var
    field: array [1..1000, 1..1000] of longint;
    i, j: longint;
begin
    for i := 1 to size do
        for j := 1 to size do
            field[i, j] := 0;

    for i := 1 to size do
        field[i, positions[i]] := 1;

    writeln;

    for i := 1 to size do
    begin
        for j := 1 to size do
        begin
            write(field[i, j]);
        end;

        writeln;
    end;
end;

function check(positions: TArray; size: longint) : boolean;
var
    i, j: longint;
begin
    for i := 1 to size do
    begin
        for j := 1 to size do
        begin
            if (i <> j) and (abs(i - j) = abs(positions[i] - positions[j])) then
            begin
                check := false;
                exit;
            end;
        end;
    end;

    check := true;
end;

procedure generate(var positions : TArray; size, l, r : integer);
var i,v:integer;
begin
    if (l=r) then
    begin
        if check(positions, size) then
            draw(positions, size);
    end
    else
    begin
        for i := l to r do
        begin
            v := positions[l]; positions[l] := positions[i]; positions[i] := v;
            generate(positions, size, l + 1, r);
            v := positions[l]; positions[l] := positions[i]; positions[i] := v;
        end;
    end;
end;

var
    result: TArray;
    size, i, cnt: longint;

begin
    read(size);

    for i := 1 to size do
        result[i] := i;

    generate(result, size, 1, size);
end.