author | Wuzzy <almikes@aol.com> |
Mon, 10 Apr 2017 20:56:01 +0200 | |
changeset 12216 | 5b525d041fb4 |
parent 11051 | 3996500fd1e5 |
child 15929 | 128ace913837 |
permissions | -rw-r--r-- |
{$INCLUDE "options.inc"} unit uLandGenMaze; interface procedure GenMaze; implementation uses uRandom, uLandOutline, uLandTemplates, uVariables, uFloat, uConsts, uLandGenTemplateBased, uUtils; 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; type cell_t = record x,y : LongInt end; 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 0..3 of record x, y :LongInt ; end; came_from : array of array of record x, y: LongInt; end; came_from_pos : array of LongInt; } last_cell : array of cell_t; came_from : array of array of cell_t; 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, nx, ny: 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; nx:= (x-1)*cellsize + tmp_x; ny:= (y-1)*cellsize + tmp_y + off_y; if num_vertices > 2 then if ((pa.ar[num_vertices - 2].x = pa.ar[num_vertices - 1].x) and (pa.ar[num_vertices - 1].x = nx)) or ((pa.ar[num_vertices - 2].y = pa.ar[num_vertices - 1].y) and (pa.ar[num_vertices - 1].y = ny)) then dec(num_vertices); pa.ar[num_vertices].x := nx; pa.ar[num_vertices].y := ny; 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; var i: Longword; begin case cTemplateFilter of 0: begin cellsize := small_cell_size; maze_inverted := false; minDistance:= max(cFeatureSize*8,32); dabDiv:= 150; end; 1: begin cellsize := medium_cell_size; minDistance:= max(cFeatureSize*6,20); maze_inverted := false; dabDiv:= 100; end; 2: begin cellsize := large_cell_size; minDistance:= max(cFeatureSize*5,12); maze_inverted := false; dabDiv:= 90; end; 3: begin cellsize := small_cell_size; minDistance:= max(cFeatureSize*8,32); maze_inverted := true; dabDiv:= 130; end; 4: begin cellsize := medium_cell_size; minDistance:= max(cFeatureSize*6,20); maze_inverted := true; dabDiv:= 100; end; 5: begin cellsize := large_cell_size; minDistance:= max(cFeatureSize*5,12); maze_inverted := true; dabDiv:= 85; 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 begin step_done[current_step] := false; came_from_pos[current_step] := 0; end; 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; leftX:= 0; rightX:= playWidth; topY:= off_y; // fill point pa.ar[pa.Count].x:= 1; pa.ar[pa.Count].y:= 1 + off_y; { for i:= 0 to pa.Count - 1 do begin system.writeln(pa.ar[i].x, ', ', pa.ar[i].y); end; } // divide while it divides repeat i:= pa.Count; DivideEdges(1, pa) until i = pa.Count; // make it smooth BezierizeEdge(pa, _0_2); DrawEdge(pa, 0); if maze_inverted then FillLand(1, 1 + off_y, 0, 0) 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, 0, 0); end; MaxHedgehogs:= 32; if (GameFlags and gfDisableGirders) <> 0 then hasGirders:= false else hasGirders := true; hasBorder := false; end; end.