hedgewars/uLandGenPerlin.pas
changeset 10190 e4f81f6d428c
parent 10189 875607ce793d
child 10191 d9862e01309a
equal deleted inserted replaced
10189:875607ce793d 10190:e4f81f6d428c
   118 
   118 
   119     for i:= 0 to 255 do
   119     for i:= 0 to 255 do
   120         p[256 + i]:= p[i];
   120         p[256 + i]:= p[i];
   121 end;
   121 end;
   122 
   122 
   123 const detail = 120000*3;
   123 const detail = 180000;
   124     field = 3;
   124     field = 5;
   125     df = detail * field;
   125     df = detail * field;
   126     width = 4096;
   126     width = 4096;
   127     height = 2048;
   127     height = 2048;
       
   128     minY = 500;
       
   129 
   128     bottomPlateHeight = 90;
   130     bottomPlateHeight = 90;
   129     bottomPlateMargin = 1200;
   131     bottomPlateMargin = 1200;
   130     plateFactor = 1;
   132     margin = 200;
   131 
   133 
   132 procedure GenPerlin;
   134 procedure GenPerlin;
   133 var y, x, dy, di, dj, r: LongInt;
   135 var y, x, dy, di, dj, r: LongInt;
   134 begin
   136 begin
   135     inoise_setup();
   137     inoise_setup();
   136 
   138 
   137     for y:= 1024 to pred(height) do
   139     for y:= minY to pred(height) do
   138     begin
   140     begin
   139         di:= df * y div height;
   141         di:= df * y div height;
   140         for x:= 0 to pred(width) do
   142         for x:= 0 to pred(width) do
   141         begin
   143         begin
   142             dj:= df * x div width;
   144             dj:= df * x div width;
   143             r:= (abs(inoise(di, dj))) shr 8 and $ff;
   145             r:= (abs(inoise(di, dj))) shr 8 and $ff;
   144             //r:= r - max(0, abs(x - width div 2) - width * 55 div 128); // fade on edges
   146             if (x < margin) or (x > width - margin) then r:= r - abs(x - width div 2) + width div 2 - margin; // fade on edges
       
   147 
       
   148             r:= r - (height - y) div 32;
       
   149 
   145             //r:= r - max(0, - abs(x - width div 2) + width * 2 div 100); // split vertically in the middle
   150             //r:= r - max(0, - abs(x - width div 2) + width * 2 div 100); // split vertically in the middle
       
   151             //r:= r + (trunc(1000 - sqrt(sqr(x - (width div 2)) * 4 + sqr(y - height * 5 div 4) * 22))) div 600 * 20; // ellipse
       
   152             //r:= r + 1 - ((abs(x - (width div 2)) + abs(y - height) * 2)) div 32; // manhattan length ellipse
   146 
   153 
   147 
   154             {
   148             //r:= r + (trunc(1000 - sqrt(sqr(x - (width div 2)) * 4 + sqr(y - height * 5 div 4) * 22))) div 600 * 20; // ellipse
       
   149             r:= r + (trunc(2000 - (abs(x - (width div 2)) * 2 + abs(y - height * 5 div 4) * 4))) div 26; // manhattan length ellipse
       
   150 
       
   151             if (y > height - bottomPlateHeight) and (x > bottomPlateMargin) and (x + bottomPlateMargin < width) then
   155             if (y > height - bottomPlateHeight) and (x > bottomPlateMargin) and (x + bottomPlateMargin < width) then
   152             begin
   156             begin
   153                 dy:= (y - height + bottomPlateHeight) * plateFactor;
   157                 dy:= (y - height + bottomPlateHeight);
   154                 r:= r + dy;
   158                 r:= r + dy;
   155 
   159 
   156                 if x < bottomPlateMargin + bottomPlateHeight then
   160                 if x < bottomPlateMargin + bottomPlateHeight then
   157                     r:= r + (x - bottomPlateMargin - bottomPlateHeight) * plateFactor
   161                     r:= r + (x - bottomPlateMargin - bottomPlateHeight)
   158                 else
   162                 else
   159                 if x + bottomPlateMargin + bottomPlateHeight > width then
   163                 if x + bottomPlateMargin + bottomPlateHeight > width then
   160                     r:= r - (x - width + bottomPlateMargin + bottomPlateHeight) * plateFactor;
   164                     r:= r - (x - width + bottomPlateMargin + bottomPlateHeight);
   161             end;
   165             end;
       
   166             }
   162             if r < 0 then Land[y, x]:= 0 else Land[y, x]:= lfObjMask;
   167             if r < 0 then Land[y, x]:= 0 else Land[y, x]:= lfObjMask;
   163 
   168 
   164         end;
   169         end;
   165     end;
   170     end;
   166 
   171 
   167     for x:= 0 to width do
   172     for x:= 0 to width do
   168         if Land[height - 1, x] = lfObjMask then FillLand(x, height - 1, 0, lfBasic);
   173         if Land[height - 1, x] = lfObjMask then FillLand(x, height - 1, 0, lfBasic);
   169     FillLand(0, 0, lfBasic, lfObjMask);
   174     FillLand(0, minY, lfBasic, lfObjMask);
   170     FillLand(0, 0, lfBasic, 0);
   175 
       
   176     // strip all lfObjMask pixels
       
   177     for y:= 0 to LAND_HEIGHT - 1 do
       
   178         for x:= 0 to LAND_WIDTH - 1 do
       
   179             if Land[y, x] = lfObjMask then
       
   180                 Land[y, x]:= 0;
   171 
   181 
   172     leftX:= 0;
   182     leftX:= 0;
   173     rightX:= 4095;
   183     rightX:= 4095;
   174     topY:= 0;
   184     topY:= 0;
   175     hasBorder:= false;
   185     hasBorder:= false;