hedgewars/uLandGraphics.pas
changeset 768 2886dafa5bcf
parent 767 697728ffe39f
child 769 788efc1d649f
equal deleted inserted replaced
767:697728ffe39f 768:2886dafa5bcf
   118      inc(dx)
   118      inc(dx)
   119      end;
   119      end;
   120   if (dx = dy) then ChangeCircleLines(x, y, dx, dy, doSet)
   120   if (dx = dy) then ChangeCircleLines(x, y, dx, dy, doSet)
   121 end;
   121 end;
   122 
   122 
   123 procedure ClearLandPixel(y, x: LongInt);
       
   124 var p: PByteArray;
       
   125 begin
       
   126 p:= @PByteArray(LandSurface^.pixels)^[LandSurface^.pitch * y];
       
   127 case LandSurface^.format^.BytesPerPixel of
       
   128      2: PWord(@(p^[x * 2]))^:= 0;
       
   129      3: begin
       
   130         p^[x * 3 + 0]:= 0;
       
   131         p^[x * 3 + 1]:= 0;
       
   132         p^[x * 3 + 2]:= 0;
       
   133         end;
       
   134      4: PLongword(@(p^[x * 4]))^:= 0;
       
   135      end
       
   136 end;
       
   137 
       
   138 procedure SetLandPixel(y, x: LongInt);
       
   139 var p: PByteArray;
       
   140 begin
       
   141 p:= @PByteArray(LandSurface^.pixels)^[LandSurface^.pitch * y];
       
   142 case LandSurface^.format^.BytesPerPixel of
       
   143      2: PWord(@(p^[x * 2]))^:= cExplosionBorderColor;
       
   144      3: begin
       
   145         p^[x * 3 + 0]:= cExplosionBorderColor and $FF;
       
   146         p^[x * 3 + 1]:= (cExplosionBorderColor shr 8) and $FF;
       
   147         p^[x * 3 + 2]:= cExplosionBorderColor shr 16;
       
   148         end;
       
   149      4: PLongword(@(p^[x * 4]))^:= cExplosionBorderColor;
       
   150      end
       
   151 end;
       
   152 
       
   153 procedure FillLandCircleLines0(x, y, dx, dy: LongInt);
   123 procedure FillLandCircleLines0(x, y, dx, dy: LongInt);
   154 var i: LongInt;
   124 var i: LongInt;
   155 begin
   125 begin
   156 if ((y + dy) and $FFFFFC00) = 0 then
   126 if ((y + dy) and $FFFFFC00) = 0 then
   157    for i:= max(x - dx, 0) to min(x + dx, 2047) do ClearLandPixel(y + dy, i);
   127    for i:= max(x - dx, 0) to min(x + dx, 2047) do LandPixels[y + dy, i]:= 0;
   158 if ((y - dy) and $FFFFFC00) = 0 then
   128 if ((y - dy) and $FFFFFC00) = 0 then
   159    for i:= max(x - dx, 0) to min(x + dx, 2047) do ClearLandPixel(y - dy, i);
   129    for i:= max(x - dx, 0) to min(x + dx, 2047) do LandPixels[y - dy, i]:= 0;
   160 if ((y + dx) and $FFFFFC00) = 0 then
   130 if ((y + dx) and $FFFFFC00) = 0 then
   161    for i:= max(x - dy, 0) to min(x + dy, 2047) do ClearLandPixel(y + dx, i);
   131    for i:= max(x - dy, 0) to min(x + dy, 2047) do LandPixels[y + dx, i]:= 0;
   162 if ((y - dx) and $FFFFFC00) = 0 then
   132 if ((y - dx) and $FFFFFC00) = 0 then
   163    for i:= max(x - dy, 0) to min(x + dy, 2047) do ClearLandPixel(y - dx, i);
   133    for i:= max(x - dy, 0) to min(x + dy, 2047) do LandPixels[y - dx, i]:= 0;
   164 end;
   134 end;
   165 
   135 
   166 procedure FillLandCircleLinesEBC(x, y, dx, dy: LongInt);
   136 procedure FillLandCircleLinesEBC(x, y, dx, dy: LongInt);
   167 var i: LongInt;
   137 var i: LongInt;
   168 begin
   138 begin
   169 if ((y + dy) and $FFFFFC00) = 0 then
   139 if ((y + dy) and $FFFFFC00) = 0 then
   170    for i:= max(x - dx, 0) to min(x + dx, 2047) do
   140    for i:= max(x - dx, 0) to min(x + dx, 2047) do
   171        if Land[y + dy, i] = COLOR_LAND then SetLandPixel(y + dy, i);
   141        if Land[y + dy, i] = COLOR_LAND then LandPixels[y + dy, i]:= cExplosionBorderColor;
   172 if ((y - dy) and $FFFFFC00) = 0 then
   142 if ((y - dy) and $FFFFFC00) = 0 then
   173    for i:= max(x - dx, 0) to min(x + dx, 2047) do
   143    for i:= max(x - dx, 0) to min(x + dx, 2047) do
   174        if Land[y - dy, i] = COLOR_LAND then SetLandPixel(y - dy, i);
   144        if Land[y - dy, i] = COLOR_LAND then LandPixels[y - dy, i]:= cExplosionBorderColor;
   175 if ((y + dx) and $FFFFFC00) = 0 then
   145 if ((y + dx) and $FFFFFC00) = 0 then
   176    for i:= max(x - dy, 0) to min(x + dy, 2047) do
   146    for i:= max(x - dy, 0) to min(x + dy, 2047) do
   177        if Land[y + dx, i] = COLOR_LAND then SetLandPixel(y + dx, i);
   147        if Land[y + dx, i] = COLOR_LAND then LandPixels[y + dx, i]:= cExplosionBorderColor;
   178 if ((y - dx) and $FFFFFC00) = 0 then
   148 if ((y - dx) and $FFFFFC00) = 0 then
   179    for i:= max(x - dy, 0) to min(x + dy, 2047) do
   149    for i:= max(x - dy, 0) to min(x + dy, 2047) do
   180        if Land[y - dx, i] = COLOR_LAND then SetLandPixel(y - dx, i);
   150        if Land[y - dx, i] = COLOR_LAND then LandPixels[y - dx, i]:= cExplosionBorderColor;
   181 end;
   151 end;
   182 
   152 
   183 procedure DrawExplosion(X, Y, Radius: LongInt);
   153 procedure DrawExplosion(X, Y, Radius: LongInt);
   184 var dx, dy, d: LongInt;
   154 var dx, dy, d: LongInt;
   185 begin
   155 begin
   186 FillRoundInLand(X, Y, Radius, 0);
   156 FillRoundInLand(X, Y, Radius, 0);
   187 
       
   188 if SDL_MustLock(LandSurface) then
       
   189    SDLTry(SDL_LockSurface(LandSurface) >= 0, true);
       
   190 
   157 
   191   dx:= 0;
   158   dx:= 0;
   192   dy:= Radius;
   159   dy:= Radius;
   193   d:= 3 - 2 * Radius;
   160   d:= 3 - 2 * Radius;
   194   while (dx < dy) do
   161   while (dx < dy) do
   218           end;
   185           end;
   219      inc(dx)
   186      inc(dx)
   220      end;
   187      end;
   221   if (dx = dy) then FillLandCircleLinesEBC(x, y, dx, dy);
   188   if (dx = dy) then FillLandCircleLinesEBC(x, y, dx, dy);
   222 
   189 
   223 if SDL_MustLock(LandSurface) then
   190 d:= max(Y - Radius, 0);
   224    SDL_UnlockSurface(LandSurface);
   191 dy:= min(Y + Radius, 1023) - d;
   225 
   192 UpdateLandTexture(d, dy)
   226 UpdateLandTexture(Y - Radius, 2 * Radius)
       
   227 end;
   193 end;
   228 
   194 
   229 procedure DrawHLinesExplosions(ar: PRangeArray; Radius: LongInt; y, dY: LongInt; Count: Byte);
   195 procedure DrawHLinesExplosions(ar: PRangeArray; Radius: LongInt; y, dY: LongInt; Count: Byte);
   230 var tx, ty, i: LongInt;
   196 var tx, ty, i: LongInt;
   231 begin
   197 begin
   232 if SDL_MustLock(LandSurface) then
       
   233    SDL_LockSurface(LandSurface);
       
   234 
       
   235 for i:= 0 to Pred(Count) do
   198 for i:= 0 to Pred(Count) do
   236     begin
   199     begin
   237     for ty:= max(y - Radius, 0) to min(y + Radius, 1023) do
   200     for ty:= max(y - Radius, 0) to min(y + Radius, 1023) do
   238         for tx:= max(0, ar^[i].Left - Radius) to min(2047, ar^[i].Right + Radius) do
   201         for tx:= max(0, ar^[i].Left - Radius) to min(2047, ar^[i].Right + Radius) do
   239             ClearLandPixel(ty, tx);
   202             LandPixels[ty, tx]:= 0;
   240     inc(y, dY)
   203     inc(y, dY)
   241     end;
   204     end;
   242 
   205 
   243 inc(Radius, 4);
   206 inc(Radius, 4);
   244 dec(y, Count * dY);
   207 dec(y, Count * dY);
   246 for i:= 0 to Pred(Count) do
   209 for i:= 0 to Pred(Count) do
   247     begin
   210     begin
   248     for ty:= max(y - Radius, 0) to min(y + Radius, 1023) do
   211     for ty:= max(y - Radius, 0) to min(y + Radius, 1023) do
   249         for tx:= max(0, ar^[i].Left - Radius) to min(2047, ar^[i].Right + Radius) do
   212         for tx:= max(0, ar^[i].Left - Radius) to min(2047, ar^[i].Right + Radius) do
   250             if Land[ty, tx] = $FFFFFF then
   213             if Land[ty, tx] = $FFFFFF then
   251                   SetLandPixel(ty, tx);
   214                   LandPixels[ty, tx]:= cExplosionBorderColor;
   252     inc(y, dY)
   215     inc(y, dY)
   253     end;
   216     end;
   254 
   217 
   255 if SDL_MustLock(LandSurface) then
   218 UpdateLandTexture(0, 1024)
   256    SDL_UnlockSurface(LandSurface);
       
   257 
       
   258 //UpdateLandTexture
       
   259 end;
   219 end;
   260 
   220 
   261 //
   221 //
   262 //  - (dX, dY) - direction, vector of length = 0.5
   222 //  - (dX, dY) - direction, vector of length = 0.5
   263 //
   223 //
   264 procedure DrawTunnel(X, Y, dX, dY: hwFloat; ticks, HalfWidth: LongInt);
   224 procedure DrawTunnel(X, Y, dX, dY: hwFloat; ticks, HalfWidth: LongInt);
   265 var nx, ny, dX8, dY8: hwFloat;
   225 var nx, ny, dX8, dY8: hwFloat;
   266     i, t, tx, ty: Longint;
   226     i, t, tx, ty: Longint;
   267 begin  // (-dY, dX) is (dX, dY) rotated by PI/2
   227 begin  // (-dY, dX) is (dX, dY) rotated by PI/2
   268 if SDL_MustLock(LandSurface) then
       
   269    SDL_LockSurface(LandSurface);
       
   270 
       
   271 nx:= X + dY * (HalfWidth + 8);
   228 nx:= X + dY * (HalfWidth + 8);
   272 ny:= Y - dX * (HalfWidth + 8);
   229 ny:= Y - dX * (HalfWidth + 8);
   273 
   230 
   274 dX8:= dX * 8;
   231 dX8:= dX * 8;
   275 dY8:= dY * 8;
   232 dY8:= dY * 8;
   299         ty:= hwRound(Y);
   256         ty:= hwRound(Y);
   300         if ((ty and $FFFFFC00) = 0) and ((tx and $FFFFF800) = 0) then
   257         if ((ty and $FFFFFC00) = 0) and ((tx and $FFFFF800) = 0) then
   301          if Land[ty, tx] = COLOR_LAND then
   258          if Land[ty, tx] = COLOR_LAND then
   302            begin
   259            begin
   303            Land[ty, tx]:= 0;
   260            Land[ty, tx]:= 0;
   304            ClearLandPixel(ty, tx);
   261            LandPixels[ty, tx]:= 0;
   305            end
   262            end
   306         end;
   263         end;
   307     for t:= 0 to 7 do
   264     for t:= 0 to 7 do
   308         {$include tunsetborder.inc}
   265         {$include tunsetborder.inc}
   309     nx:= nx - dY;
   266     nx:= nx - dY;
   318         {$include tunsetborder.inc}
   275         {$include tunsetborder.inc}
   319     nx:= nx - dY;
   276     nx:= nx - dY;
   320     ny:= ny + dX;
   277     ny:= ny + dX;
   321     end;
   278     end;
   322 
   279 
   323 if SDL_MustLock(LandSurface) then
   280 UpdateLandTexture(0, 1024)
   324    SDL_UnlockSurface(LandSurface);
       
   325 
       
   326 //UpdateLandTexture
       
   327 end;
   281 end;
   328 
   282 
   329 function TryPlaceOnLand(cpX, cpY: LongInt; Obj: TSprite; Frame: LongInt; doPlace: boolean): boolean;
   283 function TryPlaceOnLand(cpX, cpY: LongInt; Obj: TSprite; Frame: LongInt; doPlace: boolean): boolean;
   330 (*var X, Y, bpp, h, w: LongInt;
   284 (*var X, Y, bpp, h, w: LongInt;
   331     p: PByteArray;
   285     p: PByteArray;