hedgewars/uLandGraphics.pas
changeset 409 4f1841929ccc
parent 393 db01cc79f278
child 495 62c1c2b4414c
equal deleted inserted replaced
408:6c3da4907d00 409:4f1841929ccc
    16  * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA
    16  * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA
    17  *)
    17  *)
    18 
    18 
    19 unit uLandGraphics;
    19 unit uLandGraphics;
    20 interface
    20 interface
    21 uses uFloat;
    21 uses uFloat, uConsts;
    22 {$INCLUDE options.inc}
    22 {$INCLUDE options.inc}
    23 
    23 
    24 type PRangeArray = ^TRangeArray;
    24 type PRangeArray = ^TRangeArray;
    25      TRangeArray = array[0..31] of record
    25      TRangeArray = array[0..31] of record
    26                                    Left, Right: LongInt;
    26                                    Left, Right: LongInt;
    29 procedure DrawExplosion(X, Y, Radius: LongInt);
    29 procedure DrawExplosion(X, Y, Radius: LongInt);
    30 procedure DrawHLinesExplosions(ar: PRangeArray; Radius: LongInt; y, dY: LongInt; Count: Byte);
    30 procedure DrawHLinesExplosions(ar: PRangeArray; Radius: LongInt; y, dY: LongInt; Count: Byte);
    31 procedure DrawTunnel(X, Y, dX, dY: hwFloat; ticks, HalfWidth: LongInt);
    31 procedure DrawTunnel(X, Y, dX, dY: hwFloat; ticks, HalfWidth: LongInt);
    32 procedure FillRoundInLand(X, Y, Radius: LongInt; Value: Longword);
    32 procedure FillRoundInLand(X, Y, Radius: LongInt; Value: Longword);
    33 
    33 
       
    34 function TryPlaceOnLand(cpX, cpY: LongInt; Obj: TSprite; Frame: LongInt): boolean;
       
    35 
    34 implementation
    36 implementation
    35 uses SDLh, uMisc, uLand, uConsts;
    37 uses SDLh, uMisc, uLand;
    36 
    38 
    37 procedure FillCircleLines(x, y, dx, dy: LongInt; Value: Longword);
    39 procedure FillCircleLines(x, y, dx, dy: LongInt; Value: Longword);
    38 var i: LongInt;
    40 var i: LongInt;
    39 begin
    41 begin
    40 if ((y + dy) and $FFFFFC00) = 0 then
    42 if ((y + dy) and $FFFFFC00) = 0 then
    70 procedure ClearLandPixel(y, x: LongInt);
    72 procedure ClearLandPixel(y, x: LongInt);
    71 var p: PByteArray;
    73 var p: PByteArray;
    72 begin
    74 begin
    73 p:= @PByteArray(LandSurface^.pixels)^[LandSurface^.pitch * y];
    75 p:= @PByteArray(LandSurface^.pixels)^[LandSurface^.pitch * y];
    74 case LandSurface^.format^.BytesPerPixel of
    76 case LandSurface^.format^.BytesPerPixel of
    75      1: ;// not supported
       
    76      2: PWord(@(p^[x * 2]))^:= 0;
    77      2: PWord(@(p^[x * 2]))^:= 0;
    77      3: begin
    78      3: begin
    78         p^[x * 3 + 0]:= 0;
    79         p^[x * 3 + 0]:= 0;
    79         p^[x * 3 + 1]:= 0;
    80         p^[x * 3 + 1]:= 0;
    80         p^[x * 3 + 2]:= 0;
    81         p^[x * 3 + 2]:= 0;
    86 procedure SetLandPixel(y, x: LongInt);
    87 procedure SetLandPixel(y, x: LongInt);
    87 var p: PByteArray;
    88 var p: PByteArray;
    88 begin
    89 begin
    89 p:= @PByteArray(LandSurface^.pixels)^[LandSurface^.pitch * y];
    90 p:= @PByteArray(LandSurface^.pixels)^[LandSurface^.pitch * y];
    90 case LandSurface^.format^.BytesPerPixel of
    91 case LandSurface^.format^.BytesPerPixel of
    91      1: ;// not supported
       
    92      2: PWord(@(p^[x * 2]))^:= cExplosionBorderColor;
    92      2: PWord(@(p^[x * 2]))^:= cExplosionBorderColor;
    93      3: begin
    93      3: begin
    94         p^[x * 3 + 0]:= cExplosionBorderColor and $FF;
    94         p^[x * 3 + 0]:= cExplosionBorderColor and $FF;
    95         p^[x * 3 + 1]:= (cExplosionBorderColor shr 8) and $FF;
    95         p^[x * 3 + 1]:= (cExplosionBorderColor shr 8) and $FF;
    96         p^[x * 3 + 2]:= cExplosionBorderColor shr 16;
    96         p^[x * 3 + 2]:= cExplosionBorderColor shr 16;
   266 
   266 
   267 if SDL_MustLock(LandSurface) then
   267 if SDL_MustLock(LandSurface) then
   268    SDL_UnlockSurface(LandSurface)
   268    SDL_UnlockSurface(LandSurface)
   269 end;
   269 end;
   270 
   270 
       
   271 function TryPlaceOnLand(cpX, cpY: LongInt; Obj: TSprite; Frame: LongInt): boolean;
       
   272 var Result: boolean;
       
   273     X, Y, sY, bpp, h, w: LongInt;
       
   274     p: PByteArray;
       
   275     r, rr: TSDL_Rect;
       
   276     Image: PSDL_Surface;
       
   277 begin
       
   278 Result:= true;
       
   279 Image:= SpritesData[Obj].Surface;
       
   280 w:= SpritesData[Obj].Width;
       
   281 h:= SpritesData[Obj].Height; 
       
   282 
       
   283 if SDL_MustLock(Image) then
       
   284    SDLTry(SDL_LockSurface(Image) >= 0, true);
       
   285 
       
   286 bpp:= Image^.format^.BytesPerPixel;
       
   287 TryDo(bpp <> 1, 'We don''t work with 8 bit surfaces', true);
       
   288 // Check that sprites fits free space
       
   289 p:= @(PByteArray(Image^.pixels)^[Image^.pitch * Frame * h]);
       
   290 case bpp of
       
   291      2: for y:= 0 to Pred(h) do
       
   292             begin
       
   293             for x:= 0 to Pred(w) do
       
   294                 if PWord(@(p^[x * 2]))^ <> 0 then
       
   295                    if (((cpY + y) and $FFFFFC00) <> 0) or
       
   296                       (((cpX + x) and $FFFFF800) <> 0) or
       
   297                       (Land[cpY + y, cpX + x] <> 0) then
       
   298                       begin
       
   299                       if SDL_MustLock(Image) then
       
   300                          SDL_UnlockSurface(Image);
       
   301                       exit(false)
       
   302                       end;
       
   303             p:= @(p^[Image^.pitch]);
       
   304             end;
       
   305      3: for y:= 0 to Pred(h) do
       
   306             begin
       
   307             for x:= 0 to Pred(w) do
       
   308                 if  (p^[x * 3 + 0] <> 0)
       
   309                  or (p^[x * 3 + 1] <> 0)
       
   310                  or (p^[x * 3 + 2] <> 0) then
       
   311                    if (((cpY + y) and $FFFFFC00) <> 0) or
       
   312                       (((cpX + x) and $FFFFF800) <> 0) or
       
   313                       (Land[cpY + y, cpX + x] <> 0) then
       
   314                       begin
       
   315                       if SDL_MustLock(Image) then
       
   316                          SDL_UnlockSurface(Image);
       
   317                       exit(false)
       
   318                       end;
       
   319             p:= @(p^[Image^.pitch]);
       
   320             end;
       
   321      4: for y:= 0 to Pred(h) do
       
   322             begin
       
   323             for x:= 0 to Pred(w) do
       
   324                 if PLongword(@(p^[x * 4]))^ <> 0 then
       
   325                    if (((cpY + y) and $FFFFFC00) <> 0) or
       
   326                       (((cpX + x) and $FFFFF800) <> 0) or
       
   327                       (Land[cpY + y, cpX + x] <> 0) then
       
   328                       begin
       
   329                       if SDL_MustLock(Image) then
       
   330                          SDL_UnlockSurface(Image);
       
   331                       exit(false)
       
   332                       end;
       
   333             p:= @(p^[Image^.pitch]);
       
   334             end;
       
   335      end;
       
   336 
       
   337 // Checked, now place
       
   338 p:= @(PByteArray(Image^.pixels)^[Image^.pitch * Frame * h]);
       
   339 case bpp of
       
   340      2: for y:= 0 to Pred(h) do
       
   341             begin
       
   342             for x:= 0 to Pred(w) do
       
   343                 if PWord(@(p^[x * 2]))^ <> 0 then Land[cpY + y, cpX + x]:= COLOR_LAND;
       
   344             p:= @(p^[Image^.pitch]);
       
   345             end;
       
   346      3: for y:= 0 to Pred(h) do
       
   347             begin
       
   348             for x:= 0 to Pred(w) do
       
   349                 if  (p^[x * 3 + 0] <> 0)
       
   350                  or (p^[x * 3 + 1] <> 0)
       
   351                  or (p^[x * 3 + 2] <> 0) then Land[cpY + y, cpX + x]:= COLOR_LAND;
       
   352             p:= @(p^[Image^.pitch]);
       
   353             end;
       
   354      4: for y:= 0 to Pred(h) do
       
   355             begin
       
   356             for x:= 0 to Pred(w) do
       
   357                 if PLongword(@(p^[x * 4]))^ <> 0 then Land[cpY + y, cpX + x]:= COLOR_LAND;
       
   358             p:= @(p^[Image^.pitch]);
       
   359             end;
       
   360      end;
       
   361 if SDL_MustLock(Image) then
       
   362    SDL_UnlockSurface(Image);
       
   363 
       
   364 // Draw sprite on Land surface
       
   365 r.x:= 0;
       
   366 r.y:= SpritesData[Obj].Height * Frame;
       
   367 r.w:= SpritesData[Obj].Width;
       
   368 r.h:= SpritesData[Obj].Height;
       
   369 rr.x:= cpX;
       
   370 rr.y:= cpY;
       
   371 SDL_UpperBlit(Image, @r, LandSurface, @rr);
       
   372 
       
   373 TryPlaceOnLand:= true
       
   374 end;
       
   375 
   271 
   376 
   272 end.
   377 end.