hedgewars/uLandGraphics.pas
changeset 504 13b6ebc53627
parent 495 62c1c2b4414c
child 505 fcba7d7aea0d
equal deleted inserted replaced
503:2cfdc4bfc2be 504:13b6ebc53627
    28 
    28 
    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 procedure ChangeRoundInLand(X, Y, Radius: LongInt; Delta: LongInt);
    33 
    34 
    34 function TryPlaceOnLand(cpX, cpY: LongInt; Obj: TSprite; Frame: LongInt): boolean;
    35 function TryPlaceOnLand(cpX, cpY: LongInt; Obj: TSprite; Frame: LongInt): boolean;
    35 
    36 
    36 implementation
    37 implementation
    37 uses SDLh, uMisc, uLand;
    38 uses SDLh, uMisc, uLand;
    45    for i:= max(x - dx, 0) to min(x + dx, 2047) do Land[y - dy, i]:= Value;
    46    for i:= max(x - dx, 0) to min(x + dx, 2047) do Land[y - dy, i]:= Value;
    46 if ((y + dx) and $FFFFFC00) = 0 then
    47 if ((y + dx) and $FFFFFC00) = 0 then
    47    for i:= max(x - dy, 0) to min(x + dy, 2047) do Land[y + dx, i]:= Value;
    48    for i:= max(x - dy, 0) to min(x + dy, 2047) do Land[y + dx, i]:= Value;
    48 if ((y - dx) and $FFFFFC00) = 0 then
    49 if ((y - dx) and $FFFFFC00) = 0 then
    49    for i:= max(x - dy, 0) to min(x + dy, 2047) do Land[y - dx, i]:= Value;
    50    for i:= max(x - dy, 0) to min(x + dy, 2047) do Land[y - dx, i]:= Value;
       
    51 end;
       
    52 
       
    53 procedure ChangeCircleLines(x, y, dx, dy: LongInt; Delta: LongInt);
       
    54 var i: LongInt;
       
    55 begin
       
    56 if ((y + dy) and $FFFFFC00) = 0 then
       
    57    for i:= max(x - dx, 0) to min(x + dx, 2047) do inc(Land[y + dy, i], Delta);
       
    58 if ((y - dy) and $FFFFFC00) = 0 then
       
    59    for i:= max(x - dx, 0) to min(x + dx, 2047) do inc(Land[y - dy, i], Delta);
       
    60 if ((y + dx) and $FFFFFC00) = 0 then
       
    61    for i:= max(x - dy, 0) to min(x + dy, 2047) do inc(Land[y + dx, i], Delta);
       
    62 if ((y - dx) and $FFFFFC00) = 0 then
       
    63    for i:= max(x - dy, 0) to min(x + dy, 2047) do inc(Land[y - dx, i], Delta);
    50 end;
    64 end;
    51 
    65 
    52 procedure FillRoundInLand(X, Y, Radius: LongInt; Value: Longword);
    66 procedure FillRoundInLand(X, Y, Radius: LongInt; Value: Longword);
    53 var dx, dy, d: LongInt;
    67 var dx, dy, d: LongInt;
    54 begin
    68 begin
    66           end;
    80           end;
    67      inc(dx)
    81      inc(dx)
    68      end;
    82      end;
    69   if (dx = dy) then FillCircleLines(x, y, dx, dy, Value);
    83   if (dx = dy) then FillCircleLines(x, y, dx, dy, Value);
    70 end;
    84 end;
       
    85 
       
    86 procedure ChangeRoundInLand(X, Y, Radius: LongInt; Delta: LongInt);
       
    87 var dx, dy, d: LongInt;
       
    88 begin
       
    89   dx:= 0;
       
    90   dy:= Radius;
       
    91   d:= 3 - 2 * Radius;
       
    92   while (dx < dy) do
       
    93      begin
       
    94      ChangeCircleLines(x, y, dx, dy, Delta);
       
    95      if (d < 0)
       
    96      then d:= d + 4 * dx + 6
       
    97      else begin
       
    98           d:= d + 4 * (dx - dy) + 10;
       
    99           dec(dy)
       
   100           end;
       
   101      inc(dx)
       
   102      end;
       
   103   if (dx = dy) then ChangeCircleLines(x, y, dx, dy, Delta);
       
   104 end;
       
   105 
    71 
   106 
    72 procedure ClearLandPixel(y, x: LongInt);
   107 procedure ClearLandPixel(y, x: LongInt);
    73 var p: PByteArray;
   108 var p: PByteArray;
    74 begin
   109 begin
    75 p:= @PByteArray(LandSurface^.pixels)^[LandSurface^.pitch * y];
   110 p:= @PByteArray(LandSurface^.pixels)^[LandSurface^.pitch * y];