hedgewars/uLandGenMaze.pas
author unc0rr
Fri, 08 Nov 2013 17:53:02 +0400
branchsdl2transition
changeset 9694 e8d0fe885169
parent 9009 f8e9d1147dd8
child 9127 e350500c4edb
permissions -rw-r--r--
- Keyboard bindings seem to work fully - Catch mouse wheel event (bindings don't work for unknown reason)

{$INCLUDE "options.inc"}

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.