1 unit uLandGraphics;

     2 interface

     3 

     4 type PRangeArray = ^TRangeArray;

     5      TRangeArray = array[0..31] of record

     6                                    Left, Right: integer;

     7                                    end;

     8 

     9 procedure DrawExplosion(X, Y, Radius: integer);

    10 procedure DrawHLinesExplosions(ar: PRangeArray; Radius: Longword; y, dY: integer; Count: Byte);

    11 procedure DrawTunnel(X, Y, dX, dY: real; ticks, HalfWidth: integer);

    12 procedure FillRoundInLand(X, Y, Radius: integer; Value: Longword);

    13 

    14 implementation

    15 uses SDLh, uStore, uMisc, uLand;

    16 

    17 procedure FillCircleLines(x, y, dx, dy: integer; Value: Longword);

    18 var i: integer;

    19 begin

    20 if ((y + dy) and $FFFFFC00) = 0 then

    21    for i:= max(x - dx, 0) to min(x + dx, 2047) do Land[y + dy, i]:= Value;

    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;

    24 if ((y + dx) and $FFFFFC00) = 0 then

    25    for i:= max(x - dy, 0) to min(x + dy, 2047) do Land[y + dx, i]:= Value;

    26 if ((y - dx) and $FFFFFC00) = 0 then

    27    for i:= max(x - dy, 0) to min(x + dy, 2047) do Land[y - dx, i]:= Value;

    28 end;

    29 

    30 procedure FillRoundInLand(X, Y, Radius: integer; Value: Longword);

    31 var dx, dy, d: integer;

    32 begin

    33   dx:= 0;

    34   dy:= Radius;

    35   d:= 3 - 2 * Radius;

    36   while (dx < dy) do

    37      begin

    38      FillCircleLines(x, y, dx, dy, Value);

    39      if (d < 0)

    40      then d:= d + 4 * dx + 6

    41      else begin

    42           d:= d + 4 * (dx - dy) + 10;

    43           dec(dy)

    44           end;

    45      inc(dx)

    46      end;

    47   if (dx = dy) then FillCircleLines(x, y, dx, dy, Value);

    48 end;

    49 

    50 procedure DrawExplosion(X, Y, Radius: integer);

    51 var ty, tx, p: integer;

    52 begin

    53 FillRoundInLand(X, Y, Radius, 0);

    54 

    55 if SDL_MustLock(LandSurface) then

    56    SDLTry(SDL_LockSurface(LandSurface) >= 0, true);

    57 

    58 p:= integer(LandSurface.pixels);

    59 case LandSurface.format.BytesPerPixel of

    60      1: ;// not supported

    61      2: for ty:= max(-Radius, -y) to min(Radius, 1023 - y) do

    62             for tx:= max(0, round(x-radius*sqrt(1-sqr(ty/radius)))) to min(2047, round(x+radius*sqrt(1-sqr(ty/radius)))) do

    63                 PWord(p + LandSurface.pitch*(y + ty) + tx * 2)^:= 0;

    64      3: for ty:= max(-Radius, -y) to min(Radius, 1023 - y) do

    65             for tx:= max(0, round(x-radius*sqrt(1-sqr(ty/radius)))) to min(2047, round(x+radius*sqrt(1-sqr(ty/radius)))) do

    66                 begin

    67                 PByte(p + LandSurface.pitch*(y + ty) + tx * 3 + 0)^:= 0;

    68                 PByte(p + LandSurface.pitch*(y + ty) + tx * 3 + 1)^:= 0;

    69                 PByte(p + LandSurface.pitch*(y + ty) + tx * 3 + 2)^:= 0;

    70                 end;

    71      4: for ty:= max(-Radius, -y) to min(Radius, 1023 - y) do

    72             for tx:= max(0, round(x-radius*sqrt(1-sqr(ty/radius)))) to min(2047, round(x+radius*sqrt(1-sqr(ty/radius)))) do

    73                 PLongword(p + LandSurface.pitch*(y + ty) + tx * 4)^:= 0;

    74      end;

    75 

    76 inc(Radius, 4);

    77 

    78 case LandSurface.format.BytesPerPixel of

    79      1: ;// not supported

    80      2: for ty:= max(-Radius, -y) to min(Radius, 1023 - y) do

    81             for tx:= max(0, round(x-radius*sqrt(1-sqr(ty/radius)))) to min(2047, round(x+radius*sqrt(1-sqr(ty/radius)))) do

    82                if Land[y + ty, tx] = $FFFFFF then

    83                   PWord(p + LandSurface.pitch*(y + ty) + tx * 2)^:= cExplosionBorderColor;

    84      3: for ty:= max(-Radius, -y) to min(Radius, 1023 - y) do

    85             for tx:= max(0, round(x-radius*sqrt(1-sqr(ty/radius)))) to min(2047, round(x+radius*sqrt(1-sqr(ty/radius)))) do

    86                if Land[y + ty, tx] = $FFFFFF then

    87                 begin

    88                 PByte(p + LandSurface.pitch*(y + ty) + tx * 3 + 0)^:= cExplosionBorderColor and $FF;

    89                 PByte(p + LandSurface.pitch*(y + ty) + tx * 3 + 1)^:= (cExplosionBorderColor shr 8) and $FF;

    90                 PByte(p + LandSurface.pitch*(y + ty) + tx * 3 + 2)^:= (cExplosionBorderColor shr 16);

    91                 end;

    92      4: for ty:= max(-Radius, -y) to min(Radius, 1023 - y) do

    93             for tx:= max(0, round(x-radius*sqrt(1-sqr(ty/radius)))) to min(2047, round(x+radius*sqrt(1-sqr(ty/radius)))) do

    94                if Land[y + ty, tx] = $FFFFFF then

    95                    PLongword(p + LandSurface.pitch*(y + ty) + tx * 4)^:= cExplosionBorderColor;

    96      end;

    97 

    98 if SDL_MustLock(LandSurface) then

    99    SDL_UnlockSurface(LandSurface);

   100 

   101 SDL_UpdateRect(LandSurface, X - Radius, Y - Radius, Radius * 2, Radius * 2)

   102 end;

   103 

   104 procedure DrawHLinesExplosions(ar: PRangeArray; Radius: Longword; y, dY: integer; Count: Byte);

   105 var tx, ty, i, p: integer;

   106 begin

   107 if SDL_MustLock(LandSurface) then

   108    SDL_LockSurface(LandSurface);

   109 

   110 p:= integer(LandSurface.pixels);

   111 for i:= 0 to Pred(Count) do

   112     begin

   113     case LandSurface.format.BytesPerPixel of

   114      1: ;

   115      2: for ty:= max(-Radius, -y) to min(Radius, 1023 - y) do

   116             for tx:= max(0, round(ar[i].Left - radius*sqrt(1-sqr(ty/radius)))) to min(2047, round(ar[i].Right + radius*sqrt(1-sqr(ty/radius)))) do

   117                 PWord(p + LandSurface.pitch*(y + ty) + tx * 2)^:= 0;

   118      3: for ty:= max(-Radius, -y) to min(Radius, 1023 - y) do

   119             for tx:= max(0, round(ar[i].Left - radius*sqrt(1-sqr(ty/radius)))) to min(2047, round(ar[i].Right + radius*sqrt(1-sqr(ty/radius)))) do

   120                 begin

   121                 PByte(p + LandSurface.pitch*(y + ty) + tx * 3 + 0)^:= 0;

   122                 PByte(p + LandSurface.pitch*(y + ty) + tx * 3 + 1)^:= 0;

   123                 PByte(p + LandSurface.pitch*(y + ty) + tx * 3 + 2)^:= 0;

   124                 end;

   125      4: for ty:= max(-Radius, -y) to min(Radius, 1023 - y) do

   126             for tx:= max(0, round(ar[i].Left - radius*sqrt(1-sqr(ty/radius)))) to min(2047, round(ar[i].Right + radius*sqrt(1-sqr(ty/radius)))) do

   127                 PLongword(p + LandSurface.pitch*(y + ty) + tx * 4)^:= 0;

   128      end;

   129     inc(y, dY)

   130     end;

   131 

   132 inc(Radius, 4);

   133 dec(y, Count*dY);

   134 

   135 for i:= 0 to Pred(Count) do

   136     begin

   137     case LandSurface.format.BytesPerPixel of

   138      1: ;

   139      2: for ty:= max(-Radius, -y) to min(Radius, 1023 - y) do

   140             for tx:= max(0, round(ar[i].Left - radius*sqrt(1-sqr(ty/radius)))) to min(2047, round(ar[i].Right + radius*sqrt(1-sqr(ty/radius)))) do

   141                if Land[y + ty, tx] = $FFFFFF then

   142                   PWord(p + LandSurface.pitch*(y + ty) + tx * 2)^:= cExplosionBorderColor;

   143      3: for ty:= max(-Radius, -y) to min(Radius, 1023 - y) do

   144             for tx:= max(0, round(ar[i].Left - radius*sqrt(1-sqr(ty/radius)))) to min(2047, round(ar[i].Right + radius*sqrt(1-sqr(ty/radius)))) do

   145                if Land[y + ty, tx] = $FFFFFF then

   146                 begin

   147                 PByte(p + LandSurface.pitch*(y + ty) + tx * 3 + 0)^:= cExplosionBorderColor and $FF;

   148                 PByte(p + LandSurface.pitch*(y + ty) + tx * 3 + 1)^:= (cExplosionBorderColor shr 8) and $FF;

   149                 PByte(p + LandSurface.pitch*(y + ty) + tx * 3 + 2)^:= (cExplosionBorderColor shr 16);

   150                 end;

   151      4: for ty:= max(-Radius, -y) to min(Radius, 1023 - y) do

   152             for tx:= max(0, round(ar[i].Left - radius*sqrt(1-sqr(ty/radius)))) to min(2047, round(ar[i].Right + radius*sqrt(1-sqr(ty/radius)))) do

   153                if Land[y + ty, tx] = $FFFFFF then

   154                    PLongword(p + LandSurface.pitch*(y + ty) + tx * 4)^:= cExplosionBorderColor;

   155      end;

   156     inc(y, dY)

   157     end;

   158 

   159 if SDL_MustLock(LandSurface) then

   160    SDL_UnlockSurface(LandSurface);

   161 end;

   162 

   163 //

   164 //  - (dX, dY) - direction, vector of length = 0.5

   165 //

   166 procedure DrawTunnel(X, Y, dX, dY: real; ticks, HalfWidth: integer);

   167 var nx, ny: real;

   168     i, t, tx, ty, p: integer;

   169 begin  // (-dY, dX) is (dX, dY) turned by PI/2

   170 if SDL_MustLock(LandSurface) then

   171    SDL_LockSurface(LandSurface);

   172 

   173 nx:= X + dY * (HalfWidth + 8);

   174 ny:= Y - dX * (HalfWidth + 8);

   175 p:= integer(LandSurface.pixels);

   176 

   177 for i:= 0 to 7 do

   178     begin

   179     X:= nx - 8 * dX;

   180     Y:= ny - 8 * dY;

   181     for t:= -8 to ticks + 8 do

   182         {$include tunsetborder.inc}

   183     nx:= nx - dY;

   184     ny:= ny + dX;

   185     end;

   186 

   187 for i:= -HalfWidth to HalfWidth do

   188     begin

   189     X:= nx - dX * 8;

   190     Y:= ny - dY * 8;

   191     for t:= 0 to 7 do

   192         {$include tunsetborder.inc}

   193     X:= nx;

   194     Y:= ny;

   195     for t:= 0 to ticks do

   196         begin

   197         X:= X + dX;

   198         Y:= Y + dY;

   199         tx:= round(X);

   200         ty:= round(Y);

   201         if ((ty and $FFFFFC00) = 0) and ((tx and $FFFFF800) = 0) then

   202            begin

   203            Land[ty, tx]:= 0;

   204            case LandSurface.format.BytesPerPixel of

   205                 1: ;

   206                 2: PWord(p + LandSurface.pitch * ty + tx * 2)^:= 0;

   207                 3: begin

   208                    PByte(p + LandSurface.pitch * ty + tx * 3 + 0)^:= 0;

   209                    PByte(p + LandSurface.pitch * ty + tx * 3 + 1)^:= 0;

   210                    PByte(p + LandSurface.pitch * ty + tx * 3 + 2)^:= 0;

   211                    end;

   212                 4: PLongword(p + LandSurface.pitch * ty + tx * 4)^:= 0;

   213                 end

   214            end

   215         end;

   216     for t:= 0 to 7 do

   217         {$include tunsetborder.inc}

   218     nx:= nx - dY;

   219     ny:= ny + dX;

   220     end;

   221 

   222 for i:= 0 to 7 do

   223     begin

   224     X:= nx - 8 * dX;

   225     Y:= ny - 8 * dY;

   226     for t:= -8 to ticks + 8 do

   227         {$include tunsetborder.inc}

   228     nx:= nx - dY;

   229     ny:= ny + dX;

   230     end;

   231 

   232 if SDL_MustLock(LandSurface) then

   233    SDL_UnlockSurface(LandSurface)

   234 end;

   235 

   236 

   237 end.