have fpc work in the right directory instead of passing the full path of the main module (avoids having full paths in debug build backtraces for the first module only)
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.