hedgewars/uLandGenMaze.pas
branchtransitional_engine
changeset 16065 7b8d96fc8799
parent 16064 0caa3dfb3ba2
child 16067 d903f8d2395a
child 16068 a236360669cc
equal deleted inserted replaced
16064:0caa3dfb3ba2 16065:7b8d96fc8799
     1 {$INCLUDE "options.inc"}
       
     2 
       
     3 unit uLandGenMaze;
       
     4 
       
     5 interface
       
     6 
       
     7 procedure GenMaze;
       
     8 
       
     9 implementation
       
    10 
       
    11 uses uRandom, uLandOutline, uLandTemplates, uVariables, uFloat, uConsts,
       
    12      uLandGenTemplateBased, uUtils, uLandUtils;
       
    13 
       
    14 type direction = record x, y: LongInt; end;
       
    15 const DIR_N: direction = (x: 0; y: -1);
       
    16     DIR_E: direction = (x: 1; y: 0);
       
    17     DIR_S: direction = (x: 0; y: 1);
       
    18     DIR_W: direction = (x: -1; y: 0);
       
    19 
       
    20 operator = (const a, b: direction) c: Boolean;
       
    21 begin
       
    22     c := (a.x = b.x) and (a.y = b.y);
       
    23 end;
       
    24 
       
    25 const small_cell_size = 128;
       
    26     medium_cell_size = 192;
       
    27     large_cell_size = 256;
       
    28     braidness = 10;
       
    29 
       
    30 type
       
    31    cell_t = record x,y         : LongInt
       
    32         end;
       
    33 
       
    34 var x, y               : LongInt;
       
    35     cellsize               : LongInt; //selected by the user in the gui
       
    36     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
       
    37     num_edges_x, num_edges_y   : LongInt; //number of resulting edges that need to be vertexificated
       
    38     num_cells_x, num_cells_y   : LongInt; //actual number of cells, depending on cell size
       
    39 
       
    40 
       
    41     seen_list              : array of array of LongInt;
       
    42     xwalls             : array of array of Boolean;
       
    43     ywalls             : array of array of Boolean;
       
    44     x_edge_list            : array of array of Boolean;
       
    45     y_edge_list            : array of array of Boolean;
       
    46     maze               : array of array of Boolean;
       
    47 
       
    48     pa                 : TPixAr;
       
    49     num_vertices           : LongInt;
       
    50     off_y              : LongInt;
       
    51     num_steps              : LongInt;
       
    52     current_step           : LongInt;
       
    53 
       
    54     step_done              : array of Boolean;
       
    55 
       
    56     done               : Boolean;
       
    57 
       
    58 {   last_cell              : array 0..3 of record x, y :LongInt ; end;
       
    59     came_from              : array of array of record x, y: LongInt; end;
       
    60     came_from_pos          : array of LongInt;
       
    61 }
       
    62     last_cell : array of cell_t;
       
    63     came_from : array of array of cell_t;
       
    64     came_from_pos: array of LongInt;
       
    65 
       
    66     maze_inverted                      : Boolean;
       
    67 
       
    68 function when_seen(x: LongInt; y: LongInt): LongInt;
       
    69 begin
       
    70 if (x < 0) or (x >= seen_cells_x) or (y < 0) or (y >= seen_cells_y) then
       
    71     when_seen := current_step
       
    72 else
       
    73     when_seen := seen_list[x, y];
       
    74 end;
       
    75 
       
    76 function is_x_edge(x, y: LongInt): Boolean;
       
    77 begin
       
    78 if (x < 0) or (x > num_edges_x) or (y < 0) or (y > num_cells_y) then
       
    79     is_x_edge := false
       
    80 else
       
    81     is_x_edge := x_edge_list[x, y];
       
    82 end;
       
    83 
       
    84 function is_y_edge(x, y: LongInt): Boolean;
       
    85 begin
       
    86 if (x < 0) or (x > num_cells_x) or (y < 0) or (y > num_edges_y) then
       
    87     is_y_edge := false
       
    88 else
       
    89     is_y_edge := y_edge_list[x, y];
       
    90 end;
       
    91 
       
    92 procedure see_cell;
       
    93 var dir: direction;
       
    94     tries: LongInt;
       
    95     x, y: LongInt;
       
    96     found_cell: Boolean;
       
    97     next_dir_clockwise: Boolean;
       
    98 
       
    99 begin
       
   100 x := last_cell[current_step].x;
       
   101 y := last_cell[current_step].y;
       
   102 seen_list[x, y] := current_step;
       
   103 case GetRandom(4) of
       
   104     0: dir := DIR_N;
       
   105     1: dir := DIR_E;
       
   106     2: dir := DIR_S;
       
   107     3: dir := DIR_W;
       
   108 end;
       
   109 tries := 0;
       
   110 found_cell := false;
       
   111 if getrandom(2) = 1 then
       
   112     next_dir_clockwise := true
       
   113 else
       
   114     next_dir_clockwise := false;
       
   115 
       
   116 while (tries < 5) and (not found_cell) do
       
   117 begin
       
   118     if when_seen(x + dir.x, y + dir.y) = current_step then //we are seeing ourselves, try another direction
       
   119     begin
       
   120         //we have already seen the target cell, decide if we should remove the wall anyway
       
   121         //(or put a wall there if maze_inverted, but we are not doing that right now)
       
   122         if (not maze_inverted) and (GetRandom(braidness) = 0) then
       
   123         //or just warn that inverted+braid+indestructible terrain != good idea
       
   124         begin
       
   125             case dir.x of
       
   126 
       
   127                 -1:
       
   128                 if x > 0 then
       
   129                     ywalls[x-1, y] := false;
       
   130                 1:
       
   131                 if x < seen_cells_x - 1 then
       
   132                     ywalls[x, y] := false;
       
   133             end;
       
   134             case dir.y of
       
   135                 -1:
       
   136                 if y > 0 then
       
   137                     xwalls[x, y-1] := false;
       
   138                 1:
       
   139                 if y < seen_cells_y - 1 then
       
   140                     xwalls[x, y] := false;
       
   141             end;
       
   142         end;
       
   143         if next_dir_clockwise then
       
   144         begin
       
   145             if dir = DIR_N then
       
   146                 dir := DIR_E
       
   147             else if dir = DIR_E then
       
   148                 dir := DIR_S
       
   149             else if dir = DIR_S then
       
   150                 dir := DIR_W
       
   151             else
       
   152                 dir := DIR_N;
       
   153         end
       
   154         else
       
   155         begin
       
   156             if dir = DIR_N then
       
   157                 dir := DIR_W
       
   158             else if dir = DIR_E then
       
   159                 dir := DIR_N
       
   160             else if dir = DIR_S then
       
   161                 dir := DIR_E
       
   162             else
       
   163                 dir := DIR_S;
       
   164         end
       
   165     end
       
   166     else if when_seen(x + dir.x, y + dir.y) = -1 then //cell was not seen yet, go there
       
   167         begin
       
   168         case dir.y of
       
   169             -1: xwalls[x, y-1] := false;
       
   170             1: xwalls[x, y] := false;
       
   171         end;
       
   172         case dir.x of
       
   173             -1: ywalls[x-1, y] := false;
       
   174             1: ywalls[x, y] := false;
       
   175         end;
       
   176         last_cell[current_step].x := x+dir.x;
       
   177         last_cell[current_step].y := y+dir.y;
       
   178         came_from_pos[current_step] := came_from_pos[current_step] + 1;
       
   179         came_from[current_step, came_from_pos[current_step]].x := x;
       
   180         came_from[current_step, came_from_pos[current_step]].y := y;
       
   181         found_cell := true;
       
   182         end
       
   183     else //we are seeing someone else, quit
       
   184         begin
       
   185         step_done[current_step] := true;
       
   186         found_cell := true;
       
   187         end;
       
   188 
       
   189     tries := tries + 1;
       
   190 end;
       
   191 if not found_cell then
       
   192     begin
       
   193     last_cell[current_step].x := came_from[current_step, came_from_pos[current_step]].x;
       
   194     last_cell[current_step].y := came_from[current_step, came_from_pos[current_step]].y;
       
   195     came_from_pos[current_step] := came_from_pos[current_step] - 1;
       
   196 
       
   197     if came_from_pos[current_step] >= 0 then
       
   198         see_cell()
       
   199 
       
   200     else
       
   201         step_done[current_step] := true;
       
   202     end;
       
   203 end;
       
   204 
       
   205 procedure add_vertex(x, y: LongInt);
       
   206 var tmp_x, tmp_y, nx, ny: LongInt;
       
   207 begin
       
   208     if x = NTPX then
       
   209     begin
       
   210         if pa.ar[num_vertices - 6].x = NTPX then
       
   211         begin
       
   212             num_vertices := num_vertices - 6;
       
   213         end
       
   214         else
       
   215         begin
       
   216             pa.ar[num_vertices].x := NTPX;
       
   217             pa.ar[num_vertices].y := 0;
       
   218         end
       
   219     end
       
   220     else
       
   221     begin
       
   222         if maze_inverted or (x mod 2 = 0) then
       
   223             tmp_x := cellsize
       
   224         else
       
   225             tmp_x := cellsize * 2 div 3;
       
   226 
       
   227         if maze_inverted or (y mod 2 = 0) then
       
   228             tmp_y := cellsize
       
   229         else
       
   230             tmp_y := cellsize * 2 div 3;
       
   231 
       
   232         nx:= (x-1)*cellsize + tmp_x;
       
   233         ny:= (y-1)*cellsize + tmp_y + off_y;
       
   234 
       
   235         if num_vertices > 2 then
       
   236             if ((pa.ar[num_vertices - 2].x = pa.ar[num_vertices - 1].x) and (pa.ar[num_vertices - 1].x = nx))
       
   237                 or ((pa.ar[num_vertices - 2].y = pa.ar[num_vertices - 1].y) and (pa.ar[num_vertices - 1].y = ny))
       
   238                 then
       
   239                 dec(num_vertices);
       
   240 
       
   241         pa.ar[num_vertices].x := nx;
       
   242         pa.ar[num_vertices].y := ny;
       
   243     end;
       
   244 
       
   245     num_vertices := num_vertices + 1;
       
   246 end;
       
   247 
       
   248 procedure add_edge(x, y: LongInt; dir: direction);
       
   249 var i: LongInt;
       
   250 begin
       
   251 if dir = DIR_N then
       
   252     begin
       
   253     dir := DIR_W
       
   254     end
       
   255 else if dir = DIR_E then
       
   256     begin
       
   257     dir := DIR_N
       
   258     end
       
   259 else if dir = DIR_S then
       
   260     begin
       
   261     dir := DIR_E
       
   262     end
       
   263 else
       
   264     begin
       
   265     dir := DIR_S;
       
   266     end;
       
   267 
       
   268 for i := 0 to 3 do
       
   269     begin
       
   270     if dir = DIR_N then
       
   271         dir := DIR_E
       
   272     else if dir = DIR_E then
       
   273         dir := DIR_S
       
   274     else if dir = DIR_S then
       
   275         dir := DIR_W
       
   276     else
       
   277         dir := DIR_N;
       
   278 
       
   279     if (dir = DIR_N) and is_x_edge(x, y) then
       
   280         begin
       
   281             x_edge_list[x, y] := false;
       
   282             add_vertex(x+1, y);
       
   283             add_edge(x, y-1, DIR_N);
       
   284             break;
       
   285         end;
       
   286 
       
   287     if (dir = DIR_E) and is_y_edge(x+1, y) then
       
   288         begin
       
   289             y_edge_list[x+1, y] := false;
       
   290             add_vertex(x+2, y+1);
       
   291             add_edge(x+1, y, DIR_E);
       
   292             break;
       
   293         end;
       
   294 
       
   295     if (dir = DIR_S) and is_x_edge(x, y+1) then
       
   296         begin
       
   297             x_edge_list[x, y+1] := false;
       
   298             add_vertex(x+1, y+2);
       
   299             add_edge(x, y+1, DIR_S);
       
   300             break;
       
   301         end;
       
   302 
       
   303     if (dir = DIR_W) and is_y_edge(x, y) then
       
   304         begin
       
   305             y_edge_list[x, y] := false;
       
   306             add_vertex(x, y+1);
       
   307             add_edge(x-1, y, DIR_W);
       
   308             break;
       
   309         end;
       
   310     end;
       
   311 
       
   312 end;
       
   313 
       
   314 procedure GenMaze;
       
   315 var i: Longword;
       
   316 begin
       
   317 case cTemplateFilter of
       
   318     0: begin
       
   319        cellsize := small_cell_size;
       
   320        maze_inverted := false;
       
   321        minDistance:= max(cFeatureSize*8,32);
       
   322        dabDiv:= 150;
       
   323        end;
       
   324     1: begin
       
   325        cellsize := medium_cell_size;
       
   326        minDistance:= max(cFeatureSize*6,20);
       
   327        maze_inverted := false;
       
   328        dabDiv:= 100;
       
   329        end;
       
   330     2: begin
       
   331        cellsize := large_cell_size;
       
   332        minDistance:= max(cFeatureSize*5,12);
       
   333        maze_inverted := false;
       
   334        dabDiv:= 90;
       
   335        end;
       
   336     3: begin
       
   337        cellsize := small_cell_size;
       
   338        minDistance:= max(cFeatureSize*8,32);
       
   339        maze_inverted := true;
       
   340        dabDiv:= 130;
       
   341        end;
       
   342     4: begin
       
   343        cellsize := medium_cell_size;
       
   344        minDistance:= max(cFeatureSize*6,20);
       
   345        maze_inverted := true;
       
   346        dabDiv:= 100;
       
   347        end;
       
   348     5: begin
       
   349        cellsize := large_cell_size;
       
   350        minDistance:= max(cFeatureSize*5,12);
       
   351        maze_inverted := true;
       
   352        dabDiv:= 85;
       
   353        end;
       
   354     end;
       
   355 
       
   356 num_cells_x := LAND_WIDTH div cellsize;
       
   357 if not odd(num_cells_x) then
       
   358     num_cells_x := num_cells_x - 1; //needs to be odd
       
   359 
       
   360 num_cells_y := LAND_HEIGHT div cellsize;
       
   361 if not odd(num_cells_y) then
       
   362     num_cells_y := num_cells_y - 1;
       
   363 
       
   364 num_edges_x := num_cells_x - 1;
       
   365 num_edges_y := num_cells_y - 1;
       
   366 
       
   367 seen_cells_x := num_cells_x div 2;
       
   368 seen_cells_y := num_cells_y div 2;
       
   369 
       
   370 if maze_inverted then
       
   371     num_steps := 3 //TODO randomize, between 3 and 5?
       
   372 else
       
   373     num_steps := 1;
       
   374 
       
   375 SetLength(step_done, num_steps);
       
   376 SetLength(last_cell, num_steps);
       
   377 SetLength(came_from_pos, num_steps);
       
   378 SetLength(came_from, num_steps, num_cells_x*num_cells_y);
       
   379 
       
   380 done := false;
       
   381 
       
   382 for current_step := 0 to num_steps - 1 do
       
   383     begin
       
   384     step_done[current_step] := false;
       
   385     came_from_pos[current_step] := 0;
       
   386     end;
       
   387 
       
   388 current_step := 0;
       
   389 
       
   390 
       
   391 SetLength(seen_list, seen_cells_x, seen_cells_y);
       
   392 SetLength(xwalls, seen_cells_x, seen_cells_y - 1);
       
   393 SetLength(ywalls, seen_cells_x - 1, seen_cells_y);
       
   394 SetLength(x_edge_list, num_edges_x, num_cells_y);
       
   395 SetLength(y_edge_list, num_cells_x, num_edges_y);
       
   396 SetLength(maze, num_cells_x, num_cells_y);
       
   397 
       
   398 
       
   399 num_vertices := 0;
       
   400 
       
   401 playHeight := num_cells_y * cellsize;
       
   402 playWidth := num_cells_x * cellsize;
       
   403 off_y := LAND_HEIGHT - playHeight;
       
   404 
       
   405 for x := 0 to playWidth do
       
   406     for y := 0 to off_y - 1 do
       
   407         LandSet(y, x, 0);
       
   408 
       
   409 for x := 0 to playWidth do
       
   410     for y := off_y to LAND_HEIGHT - 1 do
       
   411         LandSet(y, x, lfBasic);
       
   412 
       
   413 for y := 0 to num_cells_y - 1 do
       
   414     for x := 0 to num_cells_x - 1 do
       
   415         maze[x, y] := false;
       
   416 
       
   417 for x := 0 to seen_cells_x - 1 do
       
   418     for y := 0 to seen_cells_y - 2 do
       
   419         xwalls[x, y] := true;
       
   420 
       
   421 for x := 0 to seen_cells_x - 2 do
       
   422     for y := 0 to seen_cells_y - 1 do
       
   423         ywalls[x, y] := true;
       
   424 
       
   425 for x := 0 to seen_cells_x - 1 do
       
   426     for y := 0 to seen_cells_y - 1 do
       
   427         seen_list[x, y] := -1;
       
   428 
       
   429 for x := 0 to num_edges_x - 1 do
       
   430     for y := 0 to num_cells_y - 1 do
       
   431         x_edge_list[x, y] := false;
       
   432 
       
   433 for x := 0 to num_cells_x - 1 do
       
   434     for y := 0 to num_edges_y - 1 do
       
   435         y_edge_list[x, y] := false;
       
   436 
       
   437 for current_step := 0 to num_steps-1 do
       
   438     begin
       
   439     x := GetRandom(seen_cells_x - 1) div LongWord(num_steps);
       
   440     last_cell[current_step].x := x + current_step * seen_cells_x div num_steps;
       
   441     last_cell[current_step].y := GetRandom(seen_cells_y);
       
   442 end;
       
   443 
       
   444 while not done do
       
   445     begin
       
   446     done := true;
       
   447     for current_step := 0 to num_steps-1 do
       
   448         begin
       
   449         if not step_done[current_step] then
       
   450             begin
       
   451             see_cell;
       
   452             done := false;
       
   453             end;
       
   454         end;
       
   455     end;
       
   456 
       
   457 for x := 0 to seen_cells_x - 1 do
       
   458     for y := 0 to seen_cells_y - 1 do
       
   459         if seen_list[x, y] > -1 then
       
   460             maze[(x+1)*2-1, (y+1)*2-1] := true;
       
   461 
       
   462 for x := 0 to seen_cells_x - 1 do
       
   463     for y := 0 to seen_cells_y - 2 do
       
   464         if not xwalls[x, y] then
       
   465             maze[x*2 + 1, y*2 + 2] := true;
       
   466 
       
   467 
       
   468 for x := 0 to seen_cells_x - 2 do
       
   469      for y := 0 to seen_cells_y - 1 do
       
   470         if not ywalls[x, y] then
       
   471             maze[x*2 + 2, y*2 + 1] := true;
       
   472 
       
   473 for x := 0 to num_edges_x - 1 do
       
   474     for y := 0 to num_cells_y - 1 do
       
   475         if maze[x, y] xor maze[x+1, y] then
       
   476             x_edge_list[x, y] := true
       
   477         else
       
   478             x_edge_list[x, y] := false;
       
   479 
       
   480 for x := 0 to num_cells_x - 1 do
       
   481     for y := 0 to num_edges_y - 1 do
       
   482         if maze[x, y] xor maze[x, y+1] then
       
   483             y_edge_list[x, y] := true
       
   484         else
       
   485             y_edge_list[x, y] := false;
       
   486 
       
   487 for x := 0 to num_edges_x - 1 do
       
   488     for y := 0 to num_cells_y - 1 do
       
   489         if x_edge_list[x, y] then
       
   490             begin
       
   491             x_edge_list[x, y] := false;
       
   492             add_vertex(x+1, y+1);
       
   493             add_vertex(x+1, y);
       
   494             add_edge(x, y-1, DIR_N);
       
   495             add_vertex(NTPX, 0);
       
   496             end;
       
   497 
       
   498 pa.count := num_vertices;
       
   499 
       
   500 leftX:= 0;
       
   501 rightX:= playWidth;
       
   502 topY:= off_y;
       
   503 
       
   504 // fill point
       
   505 pa.ar[pa.Count].x:= 1;
       
   506 pa.ar[pa.Count].y:= 1 + off_y;
       
   507 
       
   508 {
       
   509 for i:= 0 to pa.Count - 1 do
       
   510     begin
       
   511         system.writeln(pa.ar[i].x, ', ', pa.ar[i].y);
       
   512     end;
       
   513 }
       
   514 
       
   515 // divide while it divides
       
   516 repeat
       
   517     i:= pa.Count;
       
   518     DivideEdges(1, pa)
       
   519 until i = pa.Count;
       
   520 
       
   521 // make it smooth
       
   522 BezierizeEdge(pa, _0_2);
       
   523 
       
   524 DrawEdge(pa, 0);
       
   525 
       
   526 if maze_inverted then
       
   527     FillLand(1, 1 + off_y, 0, 0)
       
   528 else
       
   529     begin
       
   530     x := 0;
       
   531     while LandGet(cellsize div 2 + cellsize + off_y, x) = lfBasic do
       
   532         x := x + 1;
       
   533     while LandGet(cellsize div 2 + cellsize + off_y, x) = 0 do
       
   534         x := x + 1;
       
   535     FillLand(x+1, cellsize div 2 + cellsize + off_y, 0, 0);
       
   536     end;
       
   537 
       
   538 MaxHedgehogs:= 32;
       
   539 if (GameFlags and gfDisableGirders) <> 0 then
       
   540     hasGirders:= false
       
   541 else
       
   542     hasGirders := true;
       
   543 
       
   544 hasBorder := false;
       
   545 end;
       
   546 
       
   547 end.