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.