unit uLandGenMaze;interfaceprocedure GenMaze;implementationuses 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;beginif (x < 0) or (x >= seen_cells_x) or (y < 0) or (y >= seen_cells_y) then when_seen := current_stepelse when_seen := seen_list[x, y];end;function is_x_edge(x, y: LongInt): Boolean;beginif (x < 0) or (x > num_edges_x) or (y < 0) or (y > num_cells_y) then is_x_edge := falseelse is_x_edge := x_edge_list[x, y];end;function is_y_edge(x, y: LongInt): Boolean;beginif (x < 0) or (x > num_cells_x) or (y < 0) or (y > num_edges_y) then is_y_edge := falseelse 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;beginx := 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 := trueelse next_dir_clockwise := false;while (tries < 5) and (not found_cell) dobegin 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 thenbegin 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;beginif x = NTPX thenbegin 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; endendelsebegin 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;beginif dir = DIR_N thenbegin dir := DIR_Wendelse if dir = DIR_E thenbegin dir := DIR_Nendelse if dir = DIR_S thenbegin dir := DIR_Eendelsebegin dir := DIR_S;end;for i := 0 to 3 dobegin 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;begincase 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 oddnum_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 dobegin 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 dobegin 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)elsebegin 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:= falseelse hasGirders := true;leftX:= 0;rightX:= playWidth;topY:= off_y;hasBorder := false;end;end.