{$INCLUDE "options.inc"}

unit uLandGenMaze;

interface

procedure GenMaze;

implementation

type direction = record x, y: LongInt; end;

const DIR_N: direction = (x: 0; y: -1);

    DIR_E: direction = (x: 1; y: 0);

    DIR_S: direction = (x: 0; y: 1);

    DIR_W: direction = (x: -1; y: 0);

operator = (const a, b: direction) c: Boolean;

begin

    c := (a.x = b.x) and (a.y = b.y);

end;

const small_cell_size = 128;

    medium_cell_size = 192;

    large_cell_size = 256;

    braidness = 10;

type

   cell_t = record x,y         : LongInt

        end;

var x, y               : LongInt;

    cellsize               : LongInt; //selected by the user in the gui

    seen_cells_x, seen_cells_y : LongInt; //number of cells that can be visited by the generator, that is every second cell in x and y direction. the cells between there are walls that will be removed when we move from one cell to another

    num_edges_x, num_edges_y   : LongInt; //number of resulting edges that need to be vertexificated

    num_cells_x, num_cells_y   : LongInt; //actual number of cells, depending on cell size

    seen_list              : array of array of LongInt;

    xwalls             : array of array of Boolean;

    ywalls             : array of array of Boolean;

    x_edge_list            : array of array of Boolean;

    y_edge_list            : array of array of Boolean;

    maze               : array of array of Boolean;

    pa                 : TPixAr;

    num_vertices           : LongInt;

    off_y              : LongInt;

    num_steps              : LongInt;

    current_step           : LongInt;

    step_done              : array of Boolean;

    done               : Boolean;

{   last_cell              : array 0..3 of record x, y :LongInt ; end;

    came_from              : array of array of record x, y: LongInt; end;

    came_from_pos          : array of LongInt;

}

    last_cell : array of cell_t;

    came_from : array of array of cell_t;

    came_from_pos: array of LongInt;

    maze_inverted                      : Boolean;

function when_seen(x: LongInt; y: LongInt): LongInt;

begin

if (x < 0) or (x >= seen_cells_x) or (y < 0) or (y >= seen_cells_y) then

    when_seen := current_step

else

    when_seen := seen_list[x, y];

end;

function is_x_edge(x, y: LongInt): Boolean;

begin

if (x < 0) or (x > num_edges_x) or (y < 0) or (y > num_cells_y) then

    is_x_edge := false

else

    is_x_edge := x_edge_list[x, y];

end;

function is_y_edge(x, y: LongInt): Boolean;

begin

if (x < 0) or (x > num_cells_x) or (y < 0) or (y > num_edges_y) then

    is_y_edge := false

else

    is_y_edge := y_edge_list[x, y];

end;

procedure see_cell;

var dir: direction;

    tries: LongInt;

    x, y: LongInt;

    found_cell: Boolean;

    next_dir_clockwise: Boolean;

begin

x := last_cell[current_step].x;

y := last_cell[current_step].y;

seen_list[x, y] := current_step;

case GetRandom(4) of

    0: dir := DIR_N;

    1: dir := DIR_E;

    2: dir := DIR_S;

    3: dir := DIR_W;

end;

tries := 0;

found_cell := false;

if getrandom(2) = 1 then

    next_dir_clockwise := true

else

    next_dir_clockwise := false;

while (tries < 5) and (not found_cell) do

begin

    if when_seen(x + dir.x, y + dir.y) = current_step then //we are seeing ourselves, try another direction

    begin

        //we have already seen the target cell, decide if we should remove the wall anyway

        //(or put a wall there if maze_inverted, but we are not doing that right now)

        if (not maze_inverted) and (GetRandom(braidness) = 0) then

        //or just warn that inverted+braid+indestructible terrain != good idea

        begin

            case dir.x of

                -1:

                if x > 0 then

                    ywalls[x-1, y] := false;

                1:

                if x < seen_cells_x - 1 then

                    ywalls[x, y] := false;

            end;

            case dir.y of

                -1:

                if y > 0 then

                    xwalls[x, y-1] := false;

                1:

                if y < seen_cells_y - 1 then

                    xwalls[x, y] := false;

            end;

        end;

        if next_dir_clockwise then

        begin

            if dir = DIR_N then

                dir := DIR_E

            else if dir = DIR_E then

                dir := DIR_S

            else if dir = DIR_S then

                dir := DIR_W

            else

                dir := DIR_N;

        end

        else

        begin

            if dir = DIR_N then

                dir := DIR_W

            else if dir = DIR_E then

                dir := DIR_N

            else if dir = DIR_S then

                dir := DIR_E

            else

                dir := DIR_S;

        end

    end

    else if when_seen(x + dir.x, y + dir.y) = -1 then //cell was not seen yet, go there

        begin

        case dir.y of

            -1: xwalls[x, y-1] := false;

            1: xwalls[x, y] := false;

        end;

        case dir.x of

            -1: ywalls[x-1, y] := false;

            1: ywalls[x, y] := false;

        end;

        last_cell[current_step].x := x+dir.x;

        last_cell[current_step].y := y+dir.y;

        came_from_pos[current_step] := came_from_pos[current_step] + 1;

        came_from[current_step, came_from_pos[current_step]].x := x;

        came_from[current_step, came_from_pos[current_step]].y := y;

        found_cell := true;

        end

    else //we are seeing someone else, quit

        begin

        step_done[current_step] := true;

        found_cell := true;

        end;

    tries := tries + 1;

end;

if not found_cell then

    begin

    last_cell[current_step].x := came_from[current_step, came_from_pos[current_step]].x;

    last_cell[current_step].y := came_from[current_step, came_from_pos[current_step]].y;

    came_from_pos[current_step] := came_from_pos[current_step] - 1;

    if came_from_pos[current_step] >= 0 then

        see_cell()

    else

        step_done[current_step] := true;

    end;

end;

procedure add_vertex(x, y: LongInt);

var tmp_x, tmp_y, nx, ny: LongInt;

begin

    if x = NTPX then

    begin

        if pa.ar[num_vertices - 6].x = NTPX then

        begin

            num_vertices := num_vertices - 6;

        end

        else

        begin

            pa.ar[num_vertices].x := NTPX;

            pa.ar[num_vertices].y := 0;

        end

    end

    else

    begin

        if maze_inverted or (x mod 2 = 0) then

            tmp_x := cellsize

        else

            tmp_x := cellsize * 2 div 3;

        if maze_inverted or (y mod 2 = 0) then

            tmp_y := cellsize

        else

            tmp_y := cellsize * 2 div 3;

        nx:= (x-1)*cellsize + tmp_x;

        ny:= (y-1)*cellsize + tmp_y + off_y;

        if num_vertices > 2 then

            if ((pa.ar[num_vertices - 2].x = pa.ar[num_vertices - 1].x) and (pa.ar[num_vertices - 1].x = nx))

                or ((pa.ar[num_vertices - 2].y = pa.ar[num_vertices - 1].y) and (pa.ar[num_vertices - 1].y = ny))

                then

                dec(num_vertices);

        pa.ar[num_vertices].x := nx;

        pa.ar[num_vertices].y := ny;

    end;

    num_vertices := num_vertices + 1;

end;

procedure add_edge(x, y: LongInt; dir: direction);

var i: LongInt;

begin

if dir = DIR_N then

    begin

    dir := DIR_W

    end

else if dir = DIR_E then

    begin

    dir := DIR_N

    end

else if dir = DIR_S then

    begin

    dir := DIR_E

    end

else

    begin

    dir := DIR_S;

    end;

for i := 0 to 3 do

    begin

    if dir = DIR_N then

        dir := DIR_E

    else if dir = DIR_E then

        dir := DIR_S

    else if dir = DIR_S then

        dir := DIR_W

    else

        dir := DIR_N;

    if (dir = DIR_N) and is_x_edge(x, y) then

        begin

            x_edge_list[x, y] := false;

            add_vertex(x+1, y);

            add_edge(x, y-1, DIR_N);

            break;

        end;

    if (dir = DIR_E) and is_y_edge(x+1, y) then

        begin

            y_edge_list[x+1, y] := false;

            add_vertex(x+2, y+1);

            add_edge(x+1, y, DIR_E);

            break;

        end;

    if (dir = DIR_S) and is_x_edge(x, y+1) then

        begin

            x_edge_list[x, y+1] := false;

            add_vertex(x+1, y+2);

            add_edge(x, y+1, DIR_S);

            break;

        end;

    if (dir = DIR_W) and is_y_edge(x, y) then

        begin

            y_edge_list[x, y] := false;

            add_vertex(x, y+1);

            add_edge(x-1, y, DIR_W);

            break;

        end;

    end;

end;

procedure GenMaze;

var i: Longword;

begin

case cTemplateFilter of

    0: begin

       cellsize := small_cell_size;

       maze_inverted := false;

       minDistance:= max(cFeatureSize*8,32);

       dabDiv:= 150;

       end;

    1: begin

       cellsize := medium_cell_size;

       minDistance:= max(cFeatureSize*6,20);

       maze_inverted := false;

       dabDiv:= 100;

       end;

    2: begin

       cellsize := large_cell_size;

       minDistance:= max(cFeatureSize*5,12);

       maze_inverted := false;

       dabDiv:= 90;

       end;

    3: begin

       cellsize := small_cell_size;

       minDistance:= max(cFeatureSize*8,32);

       maze_inverted := true;

       dabDiv:= 130;

       end;

    4: begin

       cellsize := medium_cell_size;

       minDistance:= max(cFeatureSize*6,20);

       maze_inverted := true;

       dabDiv:= 100;

       end;

    5: begin

       cellsize := large_cell_size;

       minDistance:= max(cFeatureSize*5,12);

       maze_inverted := true;

       dabDiv:= 85;

       end;

    end;

num_cells_x := LAND_WIDTH div cellsize;

if not odd(num_cells_x) then

    num_cells_x := num_cells_x - 1; //needs to be odd

num_cells_y := LAND_HEIGHT div cellsize;

if not odd(num_cells_y) then

    num_cells_y := num_cells_y - 1;

num_edges_x := num_cells_x - 1;

num_edges_y := num_cells_y - 1;

seen_cells_x := num_cells_x div 2;

seen_cells_y := num_cells_y div 2;

if maze_inverted then

    num_steps := 3 //TODO randomize, between 3 and 5?

else

    num_steps := 1;

SetLength(step_done, num_steps);

SetLength(last_cell, num_steps);

SetLength(came_from_pos, num_steps);

SetLength(came_from, num_steps, num_cells_x*num_cells_y);

done := false;

for current_step := 0 to num_steps - 1 do

    begin

    step_done[current_step] := false;

    came_from_pos[current_step] := 0;

    end;

current_step := 0;

SetLength(seen_list, seen_cells_x, seen_cells_y);

SetLength(xwalls, seen_cells_x, seen_cells_y - 1);

SetLength(ywalls, seen_cells_x - 1, seen_cells_y);

SetLength(x_edge_list, num_edges_x, num_cells_y);

SetLength(y_edge_list, num_cells_x, num_edges_y);

SetLength(maze, num_cells_x, num_cells_y);

num_vertices := 0;

playHeight := num_cells_y * cellsize;

playWidth := num_cells_x * cellsize;

off_y := LAND_HEIGHT - playHeight;

for x := 0 to playWidth do

    for y := 0 to off_y - 1 do

for x := 0 to playWidth do

    for y := off_y to LAND_HEIGHT - 1 do

for y := 0 to num_cells_y - 1 do

    for x := 0 to num_cells_x - 1 do

        maze[x, y] := false;

for x := 0 to seen_cells_x - 1 do

    for y := 0 to seen_cells_y - 2 do

        xwalls[x, y] := true;

for x := 0 to seen_cells_x - 2 do

    for y := 0 to seen_cells_y - 1 do

        ywalls[x, y] := true;

for x := 0 to seen_cells_x - 1 do

    for y := 0 to seen_cells_y - 1 do

        seen_list[x, y] := -1;

for x := 0 to num_edges_x - 1 do

    for y := 0 to num_cells_y - 1 do

        x_edge_list[x, y] := false;

for x := 0 to num_cells_x - 1 do

    for y := 0 to num_edges_y - 1 do

        y_edge_list[x, y] := false;

for current_step := 0 to num_steps-1 do

    begin

    x := GetRandom(seen_cells_x - 1) div LongWord(num_steps);

    last_cell[current_step].x := x + current_step * seen_cells_x div num_steps;

    last_cell[current_step].y := GetRandom(seen_cells_y);

end;

while not done do

    begin

    done := true;

    for current_step := 0 to num_steps-1 do

        begin

        if not step_done[current_step] then

            begin

            see_cell;

            done := false;

            end;

        end;

    end;

for x := 0 to seen_cells_x - 1 do

    for y := 0 to seen_cells_y - 1 do

        if seen_list[x, y] > -1 then

            maze[(x+1)*2-1, (y+1)*2-1] := true;

for x := 0 to seen_cells_x - 1 do

    for y := 0 to seen_cells_y - 2 do

        if not xwalls[x, y] then

            maze[x*2 + 1, y*2 + 2] := true;

for x := 0 to seen_cells_x - 2 do

     for y := 0 to seen_cells_y - 1 do

        if not ywalls[x, y] then

            maze[x*2 + 2, y*2 + 1] := true;

for x := 0 to num_edges_x - 1 do

    for y := 0 to num_cells_y - 1 do

        if maze[x, y] xor maze[x+1, y] then

            x_edge_list[x, y] := true

        else

            x_edge_list[x, y] := false;

for x := 0 to num_cells_x - 1 do

    for y := 0 to num_edges_y - 1 do

        if maze[x, y] xor maze[x, y+1] then

            y_edge_list[x, y] := true

        else

            y_edge_list[x, y] := false;

for x := 0 to num_edges_x - 1 do

    for y := 0 to num_cells_y - 1 do

        if x_edge_list[x, y] then

            begin

            x_edge_list[x, y] := false;

            add_vertex(x+1, y+1);

            add_vertex(x+1, y);

            add_edge(x, y-1, DIR_N);

            add_vertex(NTPX, 0);

            end;

pa.count := num_vertices;

leftX:= 0;

rightX:= playWidth;

topY:= off_y;

// fill point

pa.ar[pa.Count].x:= 1;