1 unit uLandGenMaze;

     2 

     3 interface

     4 

     5 procedure GenMaze;

     6 

     7 implementation

     8 

     9 uses uRandom, uLandOutline, uLandTemplates, uVariables, uFloat, uConsts;

    10 

    11 type direction = record x, y: LongInt; end;

    12 const DIR_N: direction = (x: 0; y: -1);

    13     DIR_E: direction = (x: 1; y: 0);

    14     DIR_S: direction = (x: 0; y: 1);

    15     DIR_W: direction = (x: -1; y: 0);

    16 

    17 

    18 operator = (const a, b: direction) c: Boolean;

    19 begin

    20     c := (a.x = b.x) and (a.y = b.y);

    21 end;

    22 

    23 const small_cell_size = 128;

    24     medium_cell_size = 192;

    25     large_cell_size = 256;

    26     braidness = 10;

    27 

    28 var x, y: LongInt;

    29     cellsize: LongInt; //selected by the user in the gui

    30     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

    31     num_edges_x, num_edges_y: LongInt; //number of resulting edges that need to be vertexificated

    32     num_cells_x, num_cells_y: LongInt; //actual number of cells, depending on cell size

    33     seen_list: array of array of LongInt;

    34     xwalls: array of array of Boolean;

    35     ywalls: array of array of Boolean;

    36     x_edge_list: array of array of Boolean;

    37     y_edge_list: array of array of Boolean;

    38     maze: array of array of Boolean;

    39     pa: TPixAr;

    40     num_vertices: LongInt;

    41     off_y: LongInt;

    42     num_steps: LongInt;

    43     current_step: LongInt;

    44     step_done: array of Boolean;

    45     done: Boolean;

    46     last_cell: array of record x, y: LongInt; end;

    47     came_from: array of array of record x, y: LongInt; end;

    48     came_from_pos: array of LongInt;

    49     maze_inverted: Boolean;

    50 

    51 function when_seen(x: LongInt; y: LongInt): LongInt;

    52 begin

    53 if (x < 0) or (x >= seen_cells_x) or (y < 0) or (y >= seen_cells_y) then

    54     when_seen := current_step

    55 else

    56     when_seen := seen_list[x, y];

    57 end;

    58 

    59 function is_x_edge(x, y: LongInt): Boolean;

    60 begin

    61 if (x < 0) or (x > num_edges_x) or (y < 0) or (y > num_cells_y) then

    62     is_x_edge := false

    63 else

    64     is_x_edge := x_edge_list[x, y];

    65 end;

    66 

    67 function is_y_edge(x, y: LongInt): Boolean;

    68 begin

    69 if (x < 0) or (x > num_cells_x) or (y < 0) or (y > num_edges_y) then

    70     is_y_edge := false

    71 else

    72     is_y_edge := y_edge_list[x, y];

    73 end;

    74 

    75 procedure see_cell;

    76 var dir: direction;

    77     tries: LongInt;

    78     x, y: LongInt;

    79     found_cell: Boolean;

    80     next_dir_clockwise: Boolean;

    81 

    82 begin

    83 x := last_cell[current_step].x;

    84 y := last_cell[current_step].y;

    85 seen_list[x, y] := current_step;

    86 case GetRandom(4) of

    87     0: dir := DIR_N;

    88     1: dir := DIR_E;

    89     2: dir := DIR_S;

    90     3: dir := DIR_W;

    91 end;

    92 tries := 0;

    93 found_cell := false;

    94 if getrandom(2) = 1 then next_dir_clockwise := true

    95 else next_dir_clockwise := false;

    96 

    97 while (tries < 5) and (not found_cell) do

    98 begin

    99     if when_seen(x + dir.x, y + dir.y) = current_step then //we are seeing ourselves, try another direction

   100     begin

   101         //we have already seen the target cell, decide if we should remove the wall anyway

   102         //(or put a wall there if maze_inverted, but we are not doing that right now)

   103         if not maze_inverted and (GetRandom(braidness) = 0) then

   104         //or just warn that inverted+braid+indestructible terrain != good idea

   105         begin

   106             case dir.x of

   107                 -1: if x > 0 then ywalls[x-1, y] := false;

   108                 1: if x < seen_cells_x - 1 then ywalls[x, y] := false;

   109             end;

   110             case dir.y of

   111                 -1: if y > 0 then xwalls[x, y-1] := false;

   112                 1: if y < seen_cells_y - 1 then xwalls[x, y] := false;

   113             end;

   114         end;

   115         if next_dir_clockwise then

   116         begin

   117             if dir = DIR_N then

   118                 dir := DIR_E

   119             else if dir = DIR_E then

   120                 dir := DIR_S

   121             else if dir = DIR_S then

   122                 dir := DIR_W

   123             else

   124                 dir := DIR_N;

   125         end

   126         else

   127         begin

   128             if dir = DIR_N then

   129                 dir := DIR_W

   130             else if dir = DIR_E then

   131                 dir := DIR_N

   132             else if dir = DIR_S then

   133                 dir := DIR_E

   134             else

   135                 dir := DIR_S;

   136         end

   137     end

   138     else if when_seen(x + dir.x, y + dir.y) = -1 then //cell was not seen yet, go there

   139     begin

   140         case dir.y of

   141             -1: xwalls[x, y-1] := false;

   142             1: xwalls[x, y] := false;

   143         end;

   144         case dir.x of

   145             -1: ywalls[x-1, y] := false;

   146             1: ywalls[x, y] := false;

   147         end;

   148         last_cell[current_step].x := x+dir.x;

   149         last_cell[current_step].y := y+dir.y;

   150         came_from_pos[current_step] := came_from_pos[current_step] + 1;

   151         came_from[current_step, came_from_pos[current_step]].x := x;

   152         came_from[current_step, came_from_pos[current_step]].y := y;

   153         found_cell := true;

   154     end

   155     else //we are seeing someone else, quit

   156     begin

   157         step_done[current_step] := true;

   158         found_cell := true;

   159     end;

   160 

   161     tries := tries + 1;

   162 end;

   163 if not found_cell then

   164 begin

   165     last_cell[current_step].x := came_from[current_step, came_from_pos[current_step]].x;

   166     last_cell[current_step].y := came_from[current_step, came_from_pos[current_step]].y;

   167     came_from_pos[current_step] := came_from_pos[current_step] - 1;

   168     if came_from_pos[current_step] >= 0 then see_cell

   169     else step_done[current_step] := true;

   170 end;

   171 end;

   172 

   173 procedure add_vertex(x, y: LongInt);

   174 var tmp_x, tmp_y: LongInt;

   175 begin

   176 if x = NTPX then

   177 begin

   178     if pa.ar[num_vertices - 6].x = NTPX then

   179     begin

   180         num_vertices := num_vertices - 6;

   181     end

   182     else

   183     begin

   184         pa.ar[num_vertices].x := NTPX;

   185         pa.ar[num_vertices].y := 0;

   186     end

   187 end

   188 else

   189 begin

   190     if maze_inverted or (x mod 2 = 0) then tmp_x := cellsize

   191     else tmp_x := cellsize * 2 div 3;

   192     if maze_inverted or (y mod 2 = 0) then tmp_y := cellsize

   193     else tmp_y := cellsize * 2 div 3;

   194 

   195     pa.ar[num_vertices].x := (x-1)*cellsize + tmp_x;

   196     pa.ar[num_vertices].y := (y-1)*cellsize + tmp_y + off_y;

   197 end;

   198 num_vertices := num_vertices + 1;

   199 end;

   200 

   201 procedure add_edge(x, y: LongInt; dir: direction);

   202 var i: LongInt;

   203 begin

   204 if dir = DIR_N then

   205 begin

   206     dir := DIR_W

   207 end

   208 else if dir = DIR_E then

   209 begin

   210     dir := DIR_N

   211 end

   212 else if dir = DIR_S then

   213 begin

   214     dir := DIR_E

   215 end

   216 else

   217 begin

   218     dir := DIR_S;

   219 end;

   220 

   221 for i := 0 to 3 do

   222 begin

   223         if dir = DIR_N then

   224             dir := DIR_E

   225         else if dir = DIR_E then

   226             dir := DIR_S

   227         else if dir = DIR_S then

   228             dir := DIR_W

   229         else

   230             dir := DIR_N;

   231 

   232     if (dir = DIR_N) and is_x_edge(x, y) then

   233         begin

   234             x_edge_list[x, y] := false;

   235             add_vertex(x+1, y);

   236             add_edge(x, y-1, DIR_N);

   237             break;

   238         end;

   239 

   240     if (dir = DIR_E) and is_y_edge(x+1, y) then

   241         begin

   242             y_edge_list[x+1, y] := false;

   243             add_vertex(x+2, y+1);

   244             add_edge(x+1, y, DIR_E);

   245             break;

   246         end;

   247 

   248     if (dir = DIR_S) and is_x_edge(x, y+1) then

   249         begin

   250             x_edge_list[x, y+1] := false;

   251             add_vertex(x+1, y+2);

   252             add_edge(x, y+1, DIR_S);

   253             break;

   254         end;

   255 

   256     if (dir = DIR_W) and is_y_edge(x, y) then

   257         begin

   258             y_edge_list[x, y] := false;

   259             add_vertex(x, y+1);

   260             add_edge(x-1, y, DIR_W);

   261             break;

   262         end;

   263 end;

   264 

   265 end;

   266 

   267 procedure GenMaze;

   268 begin

   269 case cTemplateFilter of

   270     0: begin

   271         cellsize := small_cell_size;

   272         maze_inverted := false;

   273     end;

   274     1: begin

   275         cellsize := medium_cell_size;

   276         maze_inverted := false;

   277     end;

   278     2: begin

   279         cellsize := large_cell_size;

   280         maze_inverted := false;

   281     end;

   282     3: begin

   283         cellsize := small_cell_size;

   284         maze_inverted := true;

   285     end;

   286     4: begin

   287         cellsize := medium_cell_size;

   288         maze_inverted := true;

   289     end;

   290     5: begin

   291         cellsize := large_cell_size;

   292         maze_inverted := true;

   293     end;

   294 end;

   295 

   296 num_cells_x := LAND_WIDTH div cellsize;

   297 if not odd(num_cells_x) then num_cells_x := num_cells_x - 1; //needs to be odd

   298 num_cells_y := LAND_HEIGHT div cellsize;

   299 if not odd(num_cells_y) then num_cells_y := num_cells_y - 1;

   300 num_edges_x := num_cells_x - 1;

   301 num_edges_y := num_cells_y - 1;

   302 seen_cells_x := num_cells_x div 2;

   303 seen_cells_y := num_cells_y div 2;

   304 

   305 if maze_inverted then

   306     num_steps := 3 //TODO randomize, between 3 and 5?

   307 else

   308     num_steps := 1;

   309 SetLength(step_done, num_steps);

   310 SetLength(last_cell, num_steps);

   311 SetLength(came_from_pos, num_steps);

   312 SetLength(came_from, num_steps, num_cells_x*num_cells_y);

   313 done := false;

   314 for current_step := 0 to num_steps - 1 do

   315     step_done[current_step] := false;

   316     came_from_pos[current_step] := 0;

   317 current_step := 0;

   318 

   319 SetLength(seen_list, seen_cells_x, seen_cells_y);

   320 SetLength(xwalls, seen_cells_x, seen_cells_y - 1);

   321 SetLength(ywalls, seen_cells_x - 1, seen_cells_y);

   322 SetLength(x_edge_list, num_edges_x, num_cells_y);

   323 SetLength(y_edge_list, num_cells_x, num_edges_y);

   324 SetLength(maze, num_cells_x, num_cells_y);

   325 

   326 num_vertices := 0;

   327 

   328 playHeight := num_cells_y * cellsize;

   329 playWidth := num_cells_x * cellsize;

   330 off_y := LAND_HEIGHT - playHeight;

   331 

   332 for x := 0 to playWidth do

   333     for y := 0 to off_y - 1 do

   334         Land[y, x] := 0;

   335 

   336 for x := 0 to playWidth do

   337     for y := off_y to LAND_HEIGHT - 1 do

   338         Land[y, x] := lfBasic;

   339 

   340 for y := 0 to num_cells_y - 1 do

   341     for x := 0 to num_cells_x - 1 do

   342         maze[x, y] := false;

   343 

   344 for x := 0 to seen_cells_x - 1 do

   345     for y := 0 to seen_cells_y - 2 do

   346         xwalls[x, y] := true;

   347 

   348 for x := 0 to seen_cells_x - 2 do

   349     for y := 0 to seen_cells_y - 1 do

   350         ywalls[x, y] := true;

   351 

   352 for x := 0 to seen_cells_x - 1 do

   353     for y := 0 to seen_cells_y - 1 do

   354         seen_list[x, y] := -1;

   355 

   356 for x := 0 to num_edges_x - 1 do

   357     for y := 0 to num_cells_y - 1 do

   358         x_edge_list[x, y] := false;

   359 

   360 for x := 0 to num_cells_x - 1 do

   361     for y := 0 to num_edges_y - 1 do

   362         y_edge_list[x, y] := false;

   363 

   364 for current_step := 0 to num_steps-1 do

   365 begin

   366     x := GetRandom(seen_cells_x - 1) div LongWord(num_steps);

   367     last_cell[current_step].x := x + current_step * seen_cells_x div num_steps;

   368     last_cell[current_step].y := GetRandom(seen_cells_y);

   369 end;

   370 

   371 while not done do

   372 begin

   373     done := true;

   374     for current_step := 0 to num_steps-1 do

   375     begin

   376         if not step_done[current_step] then

   377         begin

   378             see_cell;

   379             done := false;

   380         end;

   381     end;

   382 end;

   383 

   384 for x := 0 to seen_cells_x - 1 do

   385     for y := 0 to seen_cells_y - 1 do

   386         if seen_list[x, y] > -1 then

   387             maze[(x+1)*2-1, (y+1)*2-1] := true;

   388 

   389 for x := 0 to seen_cells_x - 1 do

   390     for y := 0 to seen_cells_y - 2 do

   391         if not xwalls[x, y] then

   392             maze[x*2 + 1, y*2 + 2] := true;

   393 

   394 

   395 for x := 0 to seen_cells_x - 2 do

   396      for y := 0 to seen_cells_y - 1 do

   397         if not ywalls[x, y] then

   398             maze[x*2 + 2, y*2 + 1] := true;

   399 

   400 for x := 0 to num_edges_x - 1 do

   401     for y := 0 to num_cells_y - 1 do

   402         if maze[x, y] xor maze[x+1, y] then

   403             x_edge_list[x, y] := true

   404         else

   405             x_edge_list[x, y] := false;

   406 

   407 for x := 0 to num_cells_x - 1 do

   408     for y := 0 to num_edges_y - 1 do

   409         if maze[x, y] xor maze[x, y+1] then

   410             y_edge_list[x, y] := true

   411         else

   412             y_edge_list[x, y] := false;

   413 

   414 for x := 0 to num_edges_x - 1 do

   415     for y := 0 to num_cells_y - 1 do

   416         if x_edge_list[x, y] then

   417         begin

   418             x_edge_list[x, y] := false;

   419             add_vertex(x+1, y+1);

   420             add_vertex(x+1, y);

   421             add_edge(x, y-1, DIR_N);

   422             add_vertex(NTPX, 0);

   423         end;

   424 

   425 pa.count := num_vertices;

   426 

   427 RandomizePoints(pa);

   428 BezierizeEdge(pa, _0_25);

   429 RandomizePoints(pa);

   430 BezierizeEdge(pa, _0_25);

   431 

   432 DrawEdge(pa, 0);

   433 

   434 if maze_inverted then

   435     FillLand(1, 1+off_y)

   436 else

   437 begin

   438     x := 0;

   439     while Land[cellsize div 2 + cellsize + off_y, x] = lfBasic do

   440         x := x + 1;

   441     while Land[cellsize div 2 + cellsize + off_y, x] = 0 do

   442         x := x + 1;

   443     FillLand(x+1, cellsize div 2 + cellsize + off_y);

   444 end;

   445 

   446 MaxHedgehogs:= 32;

   447 if (GameFlags and gfDisableGirders) <> 0 then hasGirders:= false

   448 else hasGirders := true;

   449 leftX:= 0;

   450 rightX:= playWidth;

   451 topY:= off_y;

   452 hasBorder := false;

   453 end;

   454 

   455 end.