hedgewars/uLandGraphics.pas
changeset 371 731ad6d27bd1
parent 358 236bbd12d4d9
child 393 db01cc79f278
equal deleted inserted replaced
370:c75410fe3133 371:731ad6d27bd1
     3 uses uFloat;
     3 uses uFloat;
     4 {$INCLUDE options.inc}
     4 {$INCLUDE options.inc}
     5 
     5 
     6 type PRangeArray = ^TRangeArray;
     6 type PRangeArray = ^TRangeArray;
     7      TRangeArray = array[0..31] of record
     7      TRangeArray = array[0..31] of record
     8                                    Left, Right: integer;
     8                                    Left, Right: LongInt;
     9                                    end;
     9                                    end;
    10 
    10 
    11 procedure DrawExplosion(X, Y, Radius: integer);
    11 procedure DrawExplosion(X, Y, Radius: LongInt);
    12 procedure DrawHLinesExplosions(ar: PRangeArray; Radius: integer; y, dY: integer; Count: Byte);
    12 procedure DrawHLinesExplosions(ar: PRangeArray; Radius: LongInt; y, dY: LongInt; Count: Byte);
    13 procedure DrawTunnel(X, Y, dX, dY: hwFloat; ticks, HalfWidth: integer);
    13 procedure DrawTunnel(X, Y, dX, dY: hwFloat; ticks, HalfWidth: LongInt);
    14 procedure FillRoundInLand(X, Y, Radius: integer; Value: Longword);
    14 procedure FillRoundInLand(X, Y, Radius: LongInt; Value: Longword);
    15 
    15 
    16 implementation
    16 implementation
    17 uses SDLh, uMisc, uLand, uConsts;
    17 uses SDLh, uMisc, uLand, uConsts;
    18 
    18 
    19 procedure FillCircleLines(x, y, dx, dy: integer; Value: Longword);
    19 procedure FillCircleLines(x, y, dx, dy: LongInt; Value: Longword);
    20 var i: integer;
    20 var i: LongInt;
    21 begin
    21 begin
    22 if ((y + dy) and $FFFFFC00) = 0 then
    22 if ((y + dy) and $FFFFFC00) = 0 then
    23    for i:= max(x - dx, 0) to min(x + dx, 2047) do Land[y + dy, i]:= Value;
    23    for i:= max(x - dx, 0) to min(x + dx, 2047) do Land[y + dy, i]:= Value;
    24 if ((y - dy) and $FFFFFC00) = 0 then
    24 if ((y - dy) and $FFFFFC00) = 0 then
    25    for i:= max(x - dx, 0) to min(x + dx, 2047) do Land[y - dy, i]:= Value;
    25    for i:= max(x - dx, 0) to min(x + dx, 2047) do Land[y - dy, i]:= Value;
    27    for i:= max(x - dy, 0) to min(x + dy, 2047) do Land[y + dx, i]:= Value;
    27    for i:= max(x - dy, 0) to min(x + dy, 2047) do Land[y + dx, i]:= Value;
    28 if ((y - dx) and $FFFFFC00) = 0 then
    28 if ((y - dx) and $FFFFFC00) = 0 then
    29    for i:= max(x - dy, 0) to min(x + dy, 2047) do Land[y - dx, i]:= Value;
    29    for i:= max(x - dy, 0) to min(x + dy, 2047) do Land[y - dx, i]:= Value;
    30 end;
    30 end;
    31 
    31 
    32 procedure FillRoundInLand(X, Y, Radius: integer; Value: Longword);
    32 procedure FillRoundInLand(X, Y, Radius: LongInt; Value: Longword);
    33 var dx, dy, d: integer;
    33 var dx, dy, d: LongInt;
    34 begin
    34 begin
    35   dx:= 0;
    35   dx:= 0;
    36   dy:= Radius;
    36   dy:= Radius;
    37   d:= 3 - 2 * Radius;
    37   d:= 3 - 2 * Radius;
    38   while (dx < dy) do
    38   while (dx < dy) do
    47      inc(dx)
    47      inc(dx)
    48      end;
    48      end;
    49   if (dx = dy) then FillCircleLines(x, y, dx, dy, Value);
    49   if (dx = dy) then FillCircleLines(x, y, dx, dy, Value);
    50 end;
    50 end;
    51 
    51 
    52 procedure ClearLandPixel(y, x: integer);
    52 procedure ClearLandPixel(y, x: LongInt);
    53 var p: PByteArray;
    53 var p: PByteArray;
    54 begin
    54 begin
    55 p:= @PByteArray(LandSurface^.pixels)^[LandSurface^.pitch * y];
    55 p:= @PByteArray(LandSurface^.pixels)^[LandSurface^.pitch * y];
    56 case LandSurface^.format^.BytesPerPixel of
    56 case LandSurface^.format^.BytesPerPixel of
    57      1: ;// not supported
    57      1: ;// not supported
    63         end;
    63         end;
    64      4: PLongword(@(p^[x * 4]))^:= 0;
    64      4: PLongword(@(p^[x * 4]))^:= 0;
    65      end
    65      end
    66 end;
    66 end;
    67 
    67 
    68 procedure SetLandPixel(y, x: integer);
    68 procedure SetLandPixel(y, x: LongInt);
    69 var p: PByteArray;
    69 var p: PByteArray;
    70 begin
    70 begin
    71 p:= @PByteArray(LandSurface^.pixels)^[LandSurface^.pitch * y];
    71 p:= @PByteArray(LandSurface^.pixels)^[LandSurface^.pitch * y];
    72 case LandSurface^.format^.BytesPerPixel of
    72 case LandSurface^.format^.BytesPerPixel of
    73      1: ;// not supported
    73      1: ;// not supported
    79         end;
    79         end;
    80      4: PLongword(@(p^[x * 4]))^:= cExplosionBorderColor;
    80      4: PLongword(@(p^[x * 4]))^:= cExplosionBorderColor;
    81      end
    81      end
    82 end;
    82 end;
    83 
    83 
    84 procedure FillLandCircleLines0(x, y, dx, dy: integer);
    84 procedure FillLandCircleLines0(x, y, dx, dy: LongInt);
    85 var i: integer;
    85 var i: LongInt;
    86 begin
    86 begin
    87 if ((y + dy) and $FFFFFC00) = 0 then
    87 if ((y + dy) and $FFFFFC00) = 0 then
    88    for i:= max(x - dx, 0) to min(x + dx, 2047) do ClearLandPixel(y + dy, i);
    88    for i:= max(x - dx, 0) to min(x + dx, 2047) do ClearLandPixel(y + dy, i);
    89 if ((y - dy) and $FFFFFC00) = 0 then
    89 if ((y - dy) and $FFFFFC00) = 0 then
    90    for i:= max(x - dx, 0) to min(x + dx, 2047) do ClearLandPixel(y - dy, i);
    90    for i:= max(x - dx, 0) to min(x + dx, 2047) do ClearLandPixel(y - dy, i);
    92    for i:= max(x - dy, 0) to min(x + dy, 2047) do ClearLandPixel(y + dx, i);
    92    for i:= max(x - dy, 0) to min(x + dy, 2047) do ClearLandPixel(y + dx, i);
    93 if ((y - dx) and $FFFFFC00) = 0 then
    93 if ((y - dx) and $FFFFFC00) = 0 then
    94    for i:= max(x - dy, 0) to min(x + dy, 2047) do ClearLandPixel(y - dx, i);
    94    for i:= max(x - dy, 0) to min(x + dy, 2047) do ClearLandPixel(y - dx, i);
    95 end;
    95 end;
    96 
    96 
    97 procedure FillLandCircleLinesEBC(x, y, dx, dy: integer);
    97 procedure FillLandCircleLinesEBC(x, y, dx, dy: LongInt);
    98 var i: integer;
    98 var i: LongInt;
    99 begin
    99 begin
   100 if ((y + dy) and $FFFFFC00) = 0 then
   100 if ((y + dy) and $FFFFFC00) = 0 then
   101    for i:= max(x - dx, 0) to min(x + dx, 2047) do
   101    for i:= max(x - dx, 0) to min(x + dx, 2047) do
   102        if Land[y + dy, i] = COLOR_LAND then SetLandPixel(y + dy, i);
   102        if Land[y + dy, i] = COLOR_LAND then SetLandPixel(y + dy, i);
   103 if ((y - dy) and $FFFFFC00) = 0 then
   103 if ((y - dy) and $FFFFFC00) = 0 then
   109 if ((y - dx) and $FFFFFC00) = 0 then
   109 if ((y - dx) and $FFFFFC00) = 0 then
   110    for i:= max(x - dy, 0) to min(x + dy, 2047) do
   110    for i:= max(x - dy, 0) to min(x + dy, 2047) do
   111        if Land[y - dx, i] = COLOR_LAND then SetLandPixel(y - dx, i);
   111        if Land[y - dx, i] = COLOR_LAND then SetLandPixel(y - dx, i);
   112 end;
   112 end;
   113 
   113 
   114 procedure DrawExplosion(X, Y, Radius: integer);
   114 procedure DrawExplosion(X, Y, Radius: LongInt);
   115 var dx, dy, d: integer;
   115 var dx, dy, d: LongInt;
   116 begin
   116 begin
   117 FillRoundInLand(X, Y, Radius, 0);
   117 FillRoundInLand(X, Y, Radius, 0);
   118 
   118 
   119 if SDL_MustLock(LandSurface) then
   119 if SDL_MustLock(LandSurface) then
   120    SDLTry(SDL_LockSurface(LandSurface) >= 0, true);
   120    SDLTry(SDL_LockSurface(LandSurface) >= 0, true);
   153 
   153 
   154 if SDL_MustLock(LandSurface) then
   154 if SDL_MustLock(LandSurface) then
   155    SDL_UnlockSurface(LandSurface);
   155    SDL_UnlockSurface(LandSurface);
   156 end;
   156 end;
   157 
   157 
   158 procedure DrawHLinesExplosions(ar: PRangeArray; Radius: integer; y, dY: integer; Count: Byte);
   158 procedure DrawHLinesExplosions(ar: PRangeArray; Radius: LongInt; y, dY: LongInt; Count: Byte);
   159 var tx, ty, i: LongInt;
   159 var tx, ty, i: LongInt;
   160 begin
   160 begin
   161 if SDL_MustLock(LandSurface) then
   161 if SDL_MustLock(LandSurface) then
   162    SDL_LockSurface(LandSurface);
   162    SDL_LockSurface(LandSurface);
   163 
   163 
   186 end;
   186 end;
   187 
   187 
   188 //
   188 //
   189 //  - (dX, dY) - direction, vector of length = 0.5
   189 //  - (dX, dY) - direction, vector of length = 0.5
   190 //
   190 //
   191 procedure DrawTunnel(X, Y, dX, dY: hwFloat; ticks, HalfWidth: integer);
   191 procedure DrawTunnel(X, Y, dX, dY: hwFloat; ticks, HalfWidth: LongInt);
   192 var nx, ny, dX8, dY8: hwFloat;
   192 var nx, ny, dX8, dY8: hwFloat;
   193     i, t, tx, ty: Longint;
   193     i, t, tx, ty: Longint;
   194 begin  // (-dY, dX) is (dX, dY) rotated by PI/2
   194 begin  // (-dY, dX) is (dX, dY) rotated by PI/2
   195 if SDL_MustLock(LandSurface) then
   195 if SDL_MustLock(LandSurface) then
   196    SDL_LockSurface(LandSurface);
   196    SDL_LockSurface(LandSurface);