hedgewars/uLand.pas
changeset 24 79c411363184
parent 23 16322d14f068
child 27 c374fe590272
equal deleted inserted replaced
23:16322d14f068 24:79c411363184
    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, uLandTemplates;
    50 uses uConsole, uStore, uMisc, uConsts, uRandom, uTeams, uIO, uLandTemplates, uLandObjects;
    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;
    56 
    56 
    57 var HHPoints: record
    57 var HHPoints: record
    58               First, Last: word;
    58               First, Last: word;
    59               ar: array[1..Pred(cMaxSpawnPoints)] of TPoint
    59               ar: array[1..Pred(cMaxSpawnPoints)] of TPoint
    60               end = (First: 1);
    60               end = (First: 1);
    61 
       
    62 procedure BlitImageAndGenerateCollisionInfo(cpX, cpY: Longword; Image, Surface: PSDL_Surface);
       
    63 var i, p: LongWord;
       
    64     x, y: Longword;
       
    65     bpp: integer;
       
    66     r: TSDL_Rect;
       
    67 begin
       
    68 r.x:= cpX;
       
    69 r.y:= cpY;
       
    70 SDL_UpperBlit(Image, nil, Surface, @r);
       
    71 WriteToConsole('Generating collision info... ');
       
    72 
       
    73 if SDL_MustLock(Image) then
       
    74    SDLTry(SDL_LockSurface(Image) >= 0, true);
       
    75 
       
    76 bpp:= Image.format.BytesPerPixel;
       
    77 WriteToConsole('('+inttostr(bpp)+') ');
       
    78 p:= LongWord(Image.pixels);
       
    79 case bpp of
       
    80      1: OutError('We don''t work with 8 bit surfaces', true);
       
    81      2: for y:= 0 to Pred(Image.h) do
       
    82             begin
       
    83             i:= Longword(@Land[cpY + y, cpX]);
       
    84             for x:= 0 to Pred(Image.w) do
       
    85                 if PWord(p + x * 2)^ = 0 then PLongWord(i + x * 4)^:= 0
       
    86                                          else PLongWord(i + x * 4)^:= 1;
       
    87             inc(p, Image.pitch);
       
    88             end;
       
    89      3: for y:= 0 to Pred(Image.h) do
       
    90             begin
       
    91             i:= Longword(@Land[cpY + y, cpX]);
       
    92             for x:= 0 to Pred(Image.w) do
       
    93                 if  (PByte(p + x * 3 + 0)^ = 0)
       
    94                 and (PByte(p + x * 3 + 1)^ = 0)
       
    95                 and (PByte(p + x * 3 + 2)^ = 0) then PLongWord(i + x * 4)^:= 0
       
    96                                                 else PLongWord(i + x * 4)^:= 1;
       
    97             inc(p, Image.pitch);
       
    98             end;
       
    99      4: for y:= 0 to Pred(Image.h) do
       
   100             begin
       
   101             i:= Longword(@Land[cpY + y, cpX]);
       
   102             for x:= 0 to Pred(Image.w) do
       
   103                 if PLongword(p + x * 4)^ = 0 then PLongWord(i + x * 4)^:= 0
       
   104                                              else PLongWord(i + x * 4)^:= 1;
       
   105             inc(p, Image.pitch);
       
   106             end;
       
   107      end;
       
   108 if SDL_MustLock(Image) then
       
   109    SDL_UnlockSurface(Image);
       
   110 WriteLnToConsole(msgOK)
       
   111 end;
       
   112 
    61 
   113 procedure DrawBezierEdge(var pa: TPixAr);
    62 procedure DrawBezierEdge(var pa: TPixAr);
   114 var x, y, i: integer;
    63 var x, y, i: integer;
   115     tx, ty, vx, vy, vlen, t: real;
    64     tx, ty, vx, vy, vlen, t: real;
   116     r1, r2, r3, r4: real;
    65     r1, r2, r3, r4: real;
   369       yd:= yu - 1;
   318       yd:= yu - 1;
   370     until yd < 0;
   319     until yd < 0;
   371     end;
   320     end;
   372 end;
   321 end;
   373 
   322 
   374 procedure AddGirders(Surface: PSDL_Surface);
       
   375 var tmpsurf: PSDL_Surface;
       
   376     x1, x2, y, k, i: integer;
       
   377     r, rr: TSDL_Rect;
       
   378 
       
   379     function CountNonZeroz(x, y: integer): Longword;
       
   380     var i: integer;
       
   381     begin
       
   382     Result:= 0;
       
   383     for i:= y to y + 15 do
       
   384         if Land[i, x] <> 0 then inc(Result)
       
   385     end;
       
   386 
       
   387 begin
       
   388 y:= 256;
       
   389 repeat
       
   390   inc(y, 24);
       
   391   x1:= 1024;
       
   392   x2:= 1024;
       
   393   while (x1 > 100) and (CountNonZeroz(x1, y) = 0) do dec(x1, 2);
       
   394   i:= x1 - 12;
       
   395   repeat
       
   396     k:= CountNonZeroz(x1, y);
       
   397     dec(x1, 2)
       
   398   until (x1 < 100) or (k = 0) or (k = 16) or (x1 < i);
       
   399   inc(x1, 2);
       
   400   if k = 16 then
       
   401      begin
       
   402      while (x2 < 1900) and (CountNonZeroz(x2, y) = 0) do inc(x2, 2);
       
   403      i:= x2 + 12;
       
   404      repeat
       
   405        k:= CountNonZeroz(x2, y);
       
   406        inc(x2, 2)
       
   407      until (x2 > 1900) or (k = 0) or (k = 16) or (x2 > i);
       
   408      if (x2 < 1900) and (k = 16) and (x2 - x1 > 250) then break;
       
   409      end;
       
   410 x1:= 0;
       
   411 until y > 900;
       
   412 if x1 > 0 then
       
   413    begin
       
   414    tmpsurf:= LoadImage(Pathz[ptGraphics] + 'Girder.png');
       
   415    rr.x:= x1;
       
   416    rr.y:= y;
       
   417    while rr.x + 100 < x2 do
       
   418          begin
       
   419          SDL_UpperBlit(tmpsurf, nil, Surface, @rr);
       
   420          inc(rr.x, 100);
       
   421          end;
       
   422    r.x:= 0;
       
   423    r.y:= 0;
       
   424    r.w:= x2 - rr.x;
       
   425    r.h:= 16;
       
   426    SDL_UpperBlit(tmpsurf, @r, Surface, @rr);
       
   427    SDL_FreeSurface(tmpsurf);
       
   428    for k:= y to y + 15 do
       
   429        for i:= x1 to x2 do Land[k, i]:= $FFFFFF
       
   430    end
       
   431 end;
       
   432 
       
   433 procedure AddHHPoints;
   323 procedure AddHHPoints;
   434 var x, y, t: integer;
   324 var x, y, t: integer;
   435 
   325 
   436     function CountNonZeroz(x, y: integer): integer;
   326     function CountNonZeroz(x, y: integer): integer;
   437     var i: integer;
   327     var i: integer;
   480    end;
   370    end;
   481 end;
   371 end;
   482 
   372 
   483 procedure PointWave(var Template: TEdgeTemplate; var pa: TPixAr);
   373 procedure PointWave(var Template: TEdgeTemplate; var pa: TPixAr);
   484 const MAXPASSES = 16;
   374 const MAXPASSES = 16;
   485 var ar: array[0..MAXPASSES, 0..5] of real;
   375 var ar: array[1..MAXPASSES, 0..5] of real;
   486     i, k: integer;
   376     i, k: integer;
   487     rx, ry, oy: real;
   377     rx, ry, oy: real;
   488     PassesNum: Longword;
   378     PassesNum: Longword;
   489 begin
   379 begin
   490 with Template do
   380 with Template do
   504 
   394 
   505 for k:= 0 to Pred(pa.Count) do  // apply transformation
   395 for k:= 0 to Pred(pa.Count) do  // apply transformation
   506     begin
   396     begin
   507     rx:= pa.ar[k].x;
   397     rx:= pa.ar[k].x;
   508     ry:= pa.ar[k].y;
   398     ry:= pa.ar[k].y;
   509     for i:= 0 to PassesNum do
   399     for i:= 1 to PassesNum do
   510         begin
   400         begin
   511         oy:= ry;
   401         oy:= ry;
   512         ry:= ry + ar[i, 0] * sin(ar[i, 1] * rx + ar[i, 2]);
   402         ry:= ry + ar[i, 0] * sin(ar[i, 1] * rx + ar[i, 2]);
   513         rx:= rx + ar[i, 3] * sin(ar[i, 4] * oy + ar[i, 5]);
   403         rx:= rx + ar[i, 3] * sin(ar[i, 4] * oy + ar[i, 5]);
   514         end;
   404         end;
   515         pa.ar[k].x:= round(rx);
   405     pa.ar[k].x:= round(rx);
   516         pa.ar[k].y:= round(ry);
   406     pa.ar[k].y:= round(ry);
   517         end;
   407     end;
   518 end;
   408 end;
   519 
   409 
   520 procedure GenBlank(var Template: TEdgeTemplate);
   410 procedure GenBlank(var Template: TEdgeTemplate);
   521 var pa: TPixAr;
   411 var pa: TPixAr;
   522     i: Longword;
   412     i: Longword;
   551 AddProgress;
   441 AddProgress;
   552 AddBorder(tmpsurf);
   442 AddBorder(tmpsurf);
   553 with PixelFormat^ do
   443 with PixelFormat^ do
   554      LandSurface:= SDL_CreateRGBSurface(SDL_HWSURFACE, 2048, 1024, BitsPerPixel, RMask, GMask, BMask, 0);
   444      LandSurface:= SDL_CreateRGBSurface(SDL_HWSURFACE, 2048, 1024, BitsPerPixel, RMask, GMask, BMask, 0);
   555 SDL_FillRect(LandSurface, nil, 0);
   445 SDL_FillRect(LandSurface, nil, 0);
   556 AddGirders(LandSurface);
   446 
       
   447 AddObjects(LandSurface);
       
   448 
   557 SDL_SetColorKey(tmpsurf, SDL_SRCCOLORKEY, 0);
   449 SDL_SetColorKey(tmpsurf, SDL_SRCCOLORKEY, 0);
   558 SDL_UpperBlit(tmpsurf, nil, LandSurface, nil);
   450 SDL_UpperBlit(tmpsurf, nil, LandSurface, nil);
   559 SDL_FreeSurface(tmpsurf);
   451 SDL_FreeSurface(tmpsurf);
   560 AddProgress;
   452 AddProgress;
   561 AddHHPoints;
   453 AddHHPoints;