hedgewars/uLandGenMaze.pas
author unc0rr
Sun, 02 Dec 2012 01:25:11 +0400
changeset 8178 8bd087478b48
parent 6580 6155187bf599
child 8026 4a4f21070479
child 9009 f8e9d1147dd8
permissions -rw-r--r--
Fix QSettings problems: - Reopen file in ReadOnly mode if it was open in ReadWrite mode and is being read. This is needed for stupid QSettings which opens file in ReadWrite mode just to call readAll() on it. - Implement setSize(0)

unit uLandGenMaze;

interface

procedure GenMaze;

implementation

uses uRandom, uLandOutline, uLandTemplates, uVariables, uFloat, uConsts;

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;

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 of record x, y: LongInt; end;
    came_from: array of array of record x, y: LongInt; end;
    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: 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;

    pa.ar[num_vertices].x := (x-1)*cellsize + tmp_x;
    pa.ar[num_vertices].y := (y-1)*cellsize + tmp_y + off_y;
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;
begin
case cTemplateFilter of
    0: begin
        cellsize := small_cell_size;
        maze_inverted := false;
    end;
    1: begin
        cellsize := medium_cell_size;
        maze_inverted := false;
    end;
    2: begin
        cellsize := large_cell_size;
        maze_inverted := false;
    end;
    3: begin
        cellsize := small_cell_size;
        maze_inverted := true;
    end;
    4: begin
        cellsize := medium_cell_size;
        maze_inverted := true;
    end;
    5: begin
        cellsize := large_cell_size;
        maze_inverted := true;
    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
    step_done[current_step] := false;
    came_from_pos[current_step] := 0;
    
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
        Land[y, x] := 0;

for x := 0 to playWidth do
    for y := off_y to LAND_HEIGHT - 1 do
        Land[y, x] := lfBasic;

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;

RandomizePoints(pa);
BezierizeEdge(pa, _0_25);
RandomizePoints(pa);
BezierizeEdge(pa, _0_25);

DrawEdge(pa, 0);

if maze_inverted then
    FillLand(1, 1+off_y)
else
    begin
    x := 0;
    while Land[cellsize div 2 + cellsize + off_y, x] = lfBasic do
        x := x + 1;
    while Land[cellsize div 2 + cellsize + off_y, x] = 0 do
        x := x + 1;
    FillLand(x+1, cellsize div 2 + cellsize + off_y);
    end;

MaxHedgehogs:= 32;
if (GameFlags and gfDisableGirders) <> 0 then
    hasGirders:= false
else
    hasGirders := true;
leftX:= 0;
rightX:= playWidth;
topY:= off_y;
hasBorder := false;
end;

end.