Mercurial Mercurial > hedgewars / comparison
summary | shortlog | changelog | graph | tags | bookmarks | branches | files | changeset | file | latest | revisions | annotate | diff | comparison | raw | help
Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
hedgewars/uLand.pas
changeset 23 16322d14f068
parent 22 517be8dc5b76
child 24 79c411363184
equal deleted inserted replaced
22:517be8dc5b76 23:16322d14f068 
    45 procedure AddHHPoint(_x, _y: integer);
 
    45 procedure AddHHPoint(_x, _y: integer);
 
    46 procedure GetHHPoint(out _x, _y: integer);
 
    46 procedure GetHHPoint(out _x, _y: integer);
 
    47 procedure RandomizeHHPoints;
 
    47 procedure RandomizeHHPoints;
 
    48 
    48 
    49 implementation
 
    49 implementation
 
    50 uses uConsole, uStore, uMisc, uConsts, uRandom, uTeams, uIO;
 
    50 uses uConsole, uStore, uMisc, uConsts, uRandom, uTeams, uIO, uLandTemplates;
 
    51 
    51 
    52 type TPixAr = record
 
    52 type TPixAr = record
 
    53               Count: Longword;
 
    53               Count: Longword;
 
    54               ar: array[0..Pred(cMaxEdgePoints)] of TPoint;
 
    54               ar: array[0..Pred(cMaxEdgePoints)] of TPoint;
 
    55               end;
 
    55               end;
 
   106             end;
 
   106             end;
 
   107      end;
 
   107      end;
 
   108 if SDL_MustLock(Image) then
 
   108 if SDL_MustLock(Image) then
 
   109    SDL_UnlockSurface(Image);
 
   109    SDL_UnlockSurface(Image);
 
   110 WriteLnToConsole(msgOK)
 
   110 WriteLnToConsole(msgOK)
 
   111 end;
 
       
   112 
       
   113 procedure GenEdge(TemplateType: Longword; out pa: TPixAr);
 
       
   114 const Template0: array[0..4] of TPoint = (
 
       
   115                                          (x:  500; y: 1500),
 
       
   116                                          (x:  350; y:  400),
 
       
   117                                          (x: 1023; y:  800),
 
       
   118                                          (x: 1700; y:  400),
 
       
   119                                          (x: 1550; y: 1500)
 
       
   120                                          );
 
       
   121 var i: integer;
 
       
   122 begin
 
       
   123 pa.Count:= Succ(High(Template0));
 
       
   124 for i:= 0 to High(Template0) do
 
       
   125     pa.ar[i]:= Template0[i]
 
       
   126 end;
 
   111 end;
 
   127 
   112 
   128 procedure DrawBezierEdge(var pa: TPixAr);
 
   113 procedure DrawBezierEdge(var pa: TPixAr);
 
   129 var x, y, i: integer;
 
   114 var x, y, i: integer;
 
   130     tx, ty, vx, vy, vlen, t: real;
 
   115     tx, ty, vx, vy, vlen, t: real;
 
   292 var xl, xr, dir: integer;
 
   277 var xl, xr, dir: integer;
 
   293 begin
 
   278 begin
 
   294 Stack.Count:= 0;
 
   279 Stack.Count:= 0;
 
   295 xl:= x - 1;
 
   280 xl:= x - 1;
 
   296 xr:= x;
 
   281 xr:= x;
 
   297 Push(xl, xr, 1024, -1);
 
   282 Push(xl, xr, y, -1);
 
       
   283 Push(xl, xr, y,  1);
 
   298 while Stack.Count > 0 do
 
   284 while Stack.Count > 0 do
 
   299       begin
 
   285       begin
 
   300       Pop(xl, xr, y, dir);
 
   286       Pop(xl, xr, y, dir);
 
   301       while (xl > 0) and (Land[y, xl] = 0) do dec(xl);
 
   287       while (xl > 0) and (Land[y, xl] = 0) do dec(xl);
 
   302       while (xr < 2047) and (Land[y, xr] = 0) do inc(xr);
 
   288       while (xr < 2047) and (Land[y, xr] = 0) do inc(xr);
 
   450     function CountNonZeroz(x, y: integer): integer;
 
   436     function CountNonZeroz(x, y: integer): integer;
 
   451     var i: integer;
 
   437     var i: integer;
 
   452     begin
 
   438     begin
 
   453     Result:= 0;
 
   439     Result:= 0;
 
   454     if (y and $FFFFFC00) <> 0 then exit;
 
   440     if (y and $FFFFFC00) <> 0 then exit;
 
   455     for i:= max(x - 6, 0) to min(x + 6, 2043) do
 
   441     for i:= max(x - 5, 0) to min(x + 5, 2043) do
 
   456         if Land[y, i] <> 0 then inc(Result)
 
   442         if Land[y, i] <> 0 then inc(Result)
 
   457     end;
 
   443     end;
 
   458 
   444 
   459 begin
 
   445 begin
 
   460 x:= 40;
 
   446 x:= 40;
 
   492    AddHHPoint(1300, 800);
 
   478    AddHHPoint(1300, 800);
 
   493    AddHHPoint(1400, 800);
 
   479    AddHHPoint(1400, 800);
 
   494    end;
 
   480    end;
 
   495 end;
 
   481 end;
 
   496 
   482 
   497 procedure PointWave(var pa: TPixAr; PassesNum: Longword);
 
   483 procedure PointWave(var Template: TEdgeTemplate; var pa: TPixAr);
 
   498 const MAXPASSES = 8;
 
   484 const MAXPASSES = 16;
 
   499 var ar: array[0..Pred(MAXPASSES) - 1, 0..5] of real;
 
   485 var ar: array[0..MAXPASSES, 0..5] of real;
 
   500     i, k: integer;
 
   486     i, k: integer;
 
   501     rx, ry, oy: real;
 
   487     rx, ry, oy: real;
 
   502 begin
 
   488     PassesNum: Longword;
 
   503 TryDo(PassesNum < MAXPASSES, 'Passes number too big', true);
 
   489 begin
 
   504 for i:= 0 to Pred(PassesNum) do  // initialize random parameters
 
   490 with Template do
 
   505     begin
 
   491      begin
 
   506     ar[i, 0]:= 20 + getrandom(45);
 
   492      PassesNum:= PassMin + getrandom(PassDelta);
 
   507     ar[i, 1]:= 0.005 + getrandom * 0.015;
 
   493      TryDo(PassesNum < MAXPASSES, 'Passes number too big', true);
 
   508     ar[i, 2]:= getrandom * pi * 2;
 
   494      for i:= 1 to PassesNum do  // initialize random parameters
 
   509     ar[i, 3]:= 20 + getrandom(45);
 
   495          begin
 
   510     ar[i, 4]:= 0.005 + getrandom * 0.015;
 
   496          ar[i, 0]:= WaveAmplMin + getrandom * WaveAmplDelta;
 
   511     ar[i, 5]:= getrandom * pi * 2;
 
   497          ar[i, 1]:= WaveFreqMin + getrandom * WaveFreqDelta;
 
   512     end;
 
   498          ar[i, 2]:= getrandom * pi * 2;
 
       
   499          ar[i, 3]:= WaveAmplMin + getrandom * WaveAmplDelta;
 
       
   500          ar[i, 4]:= WaveFreqMin + getrandom * WaveFreqDelta;
 
       
   501          ar[i, 5]:= getrandom * pi * 2;
 
       
   502          end;
 
       
   503      end;
 
   513 
   504 
   514 for k:= 0 to Pred(pa.Count) do  // apply transformation
 
   505 for k:= 0 to Pred(pa.Count) do  // apply transformation
 
   515     begin
 
   506     begin
 
   516     rx:= pa.ar[k].x;
 
   507     rx:= pa.ar[k].x;
 
   517     ry:= pa.ar[k].y;
 
   508     ry:= pa.ar[k].y;
 
   518     for i:= 0 to Pred(PassesNum) do
 
   509     for i:= 0 to PassesNum do
 
   519         begin
 
   510         begin
 
   520         oy:= ry;
 
   511         oy:= ry;
 
   521         ry:= ry + ar[i, 0] * sin(ar[i, 1] * rx + ar[i, 2]);
 
   512         ry:= ry + ar[i, 0] * sin(ar[i, 1] * rx + ar[i, 2]);
 
   522         rx:= rx + ar[i, 3] * sin(ar[i, 4] * oy + ar[i, 5]);
 
   513         rx:= rx + ar[i, 3] * sin(ar[i, 4] * oy + ar[i, 5]);
 
   523         end;
 
   514         end;
 
   524         pa.ar[k].x:= round(rx);
 
   515         pa.ar[k].x:= round(rx);
 
   525         pa.ar[k].y:= round(ry);
 
   516         pa.ar[k].y:= round(ry);
 
   526         end;
 
   517         end;
 
   527 end;
 
   518 end;
 
   528 
   519 
       
   520 procedure GenBlank(var Template: TEdgeTemplate);
 
       
   521 var pa: TPixAr;
 
       
   522     i: Longword;
 
       
   523 begin
 
       
   524 with Template do
 
       
   525      begin
 
       
   526      pa.Count:= BasePointsCount;
 
       
   527      for i:= 0 to pred(pa.Count) do
 
       
   528          pa.ar[i]:= BasePoints^[i];
 
       
   529 
       
   530      for i:= 1 to BezPassCnt do
 
       
   531          BezierizeEdge(pa, 0.33333334);
 
       
   532 
       
   533      PointWave(Template, pa);
 
       
   534      DrawBezierEdge(pa);
 
       
   535 
       
   536      for i:= 0 to pred(FillPointsCount) do
 
       
   537          with FillPoints^[i] do
 
       
   538               FillLand(x, y)
 
       
   539      end;
 
       
   540 end;
 
       
   541 
   529 procedure GenLandSurface;
 
   542 procedure GenLandSurface;
 
   530 var pa: TPixAr;
 
   543 var tmpsurf: PSDL_Surface;
 
   531     tmpsurf: PSDL_Surface;
 
   544 begin
 
   532 begin
 
   545 GenBlank(EdgeTemplates[getrandom(Succ(High(EdgeTemplates)))]);
 
   533 GenEdge(0, pa);
 
       
   534 BezierizeEdge(pa, 0.33334);
 
       
   535 BezierizeEdge(pa, 0.33334);
 
       
   536 BezierizeEdge(pa, 0.33334); 
       
   537 PointWave(pa, 3);
 
       
   538 DrawBezierEdge(pa);
 
       
   539 FillLand(1023, 1023);
 
       
   540 
   546 
   541 AddProgress;
 
   547 AddProgress;
 
   542 with PixelFormat^ do
 
   548 with PixelFormat^ do
 
   543      tmpsurf:= SDL_CreateRGBSurface(SDL_HWSURFACE, 2048, 1024, BitsPerPixel, RMask, GMask, BMask, 0);
 
   549      tmpsurf:= SDL_CreateRGBSurface(SDL_HWSURFACE, 2048, 1024, BitsPerPixel, RMask, GMask, BMask, 0);
 
   544 ColorizeLand(tmpsurf);
 
   550 ColorizeLand(tmpsurf);
hedgewars