hedgewars/uLandGraphics.pas
changeset 2948 3f21a9dc93d0
parent 2741 7a84ce33f52f
child 2981 d0471586a616
equal deleted inserted replaced
2947:803b277e4894 2948:3f21a9dc93d0
   230 procedure DrawExplosion(X, Y, Radius: LongInt);
   230 procedure DrawExplosion(X, Y, Radius: LongInt);
   231 var dx, dy, ty, tx, d: LongInt;
   231 var dx, dy, ty, tx, d: LongInt;
   232 begin
   232 begin
   233 
   233 
   234 // draw background land texture
   234 // draw background land texture
   235 	begin
   235     begin
   236 	dx:= 0;
   236     dx:= 0;
   237 	dy:= Radius;
   237     dy:= Radius;
   238 	d:= 3 - 2 * Radius;
   238     d:= 3 - 2 * Radius;
   239 
   239 
   240 	while (dx < dy) do
   240     while (dx < dy) do
   241 		begin
   241         begin
   242 		FillLandCircleLinesBG(x, y, dx, dy);
   242         FillLandCircleLinesBG(x, y, dx, dy);
   243 		if (d < 0)
   243         if (d < 0)
   244 		then d:= d + 4 * dx + 6
   244         then d:= d + 4 * dx + 6
   245 		else begin
   245         else begin
   246 			d:= d + 4 * (dx - dy) + 10;
   246             d:= d + 4 * (dx - dy) + 10;
   247 			dec(dy)
   247             dec(dy)
   248 			end;
   248             end;
   249 		inc(dx)
   249         inc(dx)
   250 		end;
   250         end;
   251 	if (dx = dy) then FillLandCircleLinesBG(x, y, dx, dy);
   251     if (dx = dy) then FillLandCircleLinesBG(x, y, dx, dy);
   252 	end;
   252     end;
   253 
   253 
   254 // draw a hole in land
   254 // draw a hole in land
   255 if Radius > 20 then
   255 if Radius > 20 then
   256 	begin
   256     begin
   257 	dx:= 0;
   257     dx:= 0;
   258 	dy:= Radius - 15;
   258     dy:= Radius - 15;
   259 	d:= 3 - 2 * dy;
   259     d:= 3 - 2 * dy;
   260 
   260 
   261 	while (dx < dy) do
   261     while (dx < dy) do
   262 		begin
   262         begin
   263 		FillLandCircleLines0(x, y, dx, dy);
   263         FillLandCircleLines0(x, y, dx, dy);
   264 		if (d < 0)
   264         if (d < 0)
   265 		then d:= d + 4 * dx + 6
   265         then d:= d + 4 * dx + 6
   266 		else begin
   266         else begin
   267 			d:= d + 4 * (dx - dy) + 10;
   267             d:= d + 4 * (dx - dy) + 10;
   268 			dec(dy)
   268             dec(dy)
   269 			end;
   269             end;
   270 		inc(dx)
   270         inc(dx)
   271 		end;
   271         end;
   272 	if (dx = dy) then FillLandCircleLines0(x, y, dx, dy);
   272     if (dx = dy) then FillLandCircleLines0(x, y, dx, dy);
   273 	end;
   273     end;
   274 
   274 
   275   // FillRoundInLand after erasing land pixels to allow Land 0 check for mask.png to function
   275   // FillRoundInLand after erasing land pixels to allow Land 0 check for mask.png to function
   276 	FillRoundInLand(X, Y, Radius, 0);
   276     FillRoundInLand(X, Y, Radius, 0);
   277 
   277 
   278 // draw explosion border
   278 // draw explosion border
   279 	begin
   279     begin
   280 	inc(Radius, 4);
   280     inc(Radius, 4);
   281 	dx:= 0;
   281     dx:= 0;
   282 	dy:= Radius;
   282     dy:= Radius;
   283 	d:= 3 - 2 * Radius;
   283     d:= 3 - 2 * Radius;
   284 	while (dx < dy) do
   284     while (dx < dy) do
   285 		begin
   285         begin
   286 		FillLandCircleLinesEBC(x, y, dx, dy);
   286         FillLandCircleLinesEBC(x, y, dx, dy);
   287 		if (d < 0)
   287         if (d < 0)
   288 		then d:= d + 4 * dx + 6
   288         then d:= d + 4 * dx + 6
   289 		else begin
   289         else begin
   290 			d:= d + 4 * (dx - dy) + 10;
   290             d:= d + 4 * (dx - dy) + 10;
   291 			dec(dy)
   291             dec(dy)
   292 			end;
   292             end;
   293 		inc(dx)
   293         inc(dx)
   294 		end;
   294         end;
   295 	if (dx = dy) then FillLandCircleLinesEBC(x, y, dx, dy);
   295     if (dx = dy) then FillLandCircleLinesEBC(x, y, dx, dy);
   296 	end;
   296     end;
   297 
   297 
   298 tx:= max(X - Radius - 1, 0);
   298 tx:= max(X - Radius - 1, 0);
   299 dx:= min(X + Radius + 1, LAND_WIDTH) - tx;
   299 dx:= min(X + Radius + 1, LAND_WIDTH) - tx;
   300 ty:= max(Y - Radius - 1, 0);
   300 ty:= max(Y - Radius - 1, 0);
   301 dy:= min(Y + Radius + 1, LAND_HEIGHT) - ty;
   301 dy:= min(Y + Radius + 1, LAND_HEIGHT) - ty;
   304 
   304 
   305 procedure DrawHLinesExplosions(ar: PRangeArray; Radius: LongInt; y, dY: LongInt; Count: Byte);
   305 procedure DrawHLinesExplosions(ar: PRangeArray; Radius: LongInt; y, dY: LongInt; Count: Byte);
   306 var tx, ty, i: LongInt;
   306 var tx, ty, i: LongInt;
   307 begin
   307 begin
   308 for i:= 0 to Pred(Count) do
   308 for i:= 0 to Pred(Count) do
   309 	begin
   309     begin
   310 	for ty:= max(y - Radius, 0) to min(y + Radius, LAND_HEIGHT) do
   310     for ty:= max(y - Radius, 0) to min(y + Radius, LAND_HEIGHT) do
   311 		for tx:= max(0, ar^[i].Left - Radius) to min(LAND_WIDTH, ar^[i].Right + Radius) do
   311         for tx:= max(0, ar^[i].Left - Radius) to min(LAND_WIDTH, ar^[i].Right + Radius) do
   312 			if Land[ty, tx] = COLOR_LAND then
   312             if Land[ty, tx] = COLOR_LAND then
   313 				LandPixels[ty, tx]:= LandBackPixel(tx, ty)
   313                 LandPixels[ty, tx]:= LandBackPixel(tx, ty)
   314 			else if Land[ty, tx] = COLOR_OBJECT then
   314             else if Land[ty, tx] = COLOR_OBJECT then
   315 				LandPixels[ty, tx]:= 0;
   315                 LandPixels[ty, tx]:= 0;
   316 	inc(y, dY)
   316     inc(y, dY)
   317 	end;
   317     end;
   318 
   318 
   319 inc(Radius, 4);
   319 inc(Radius, 4);
   320 dec(y, Count * dY);
   320 dec(y, Count * dY);
   321 
   321 
   322 for i:= 0 to Pred(Count) do
   322 for i:= 0 to Pred(Count) do
   354     begin
   354     begin
   355     X:= nx - dX8;
   355     X:= nx - dX8;
   356     Y:= ny - dY8;
   356     Y:= ny - dY8;
   357     for t:= -8 to ticks + 8 do
   357     for t:= -8 to ticks + 8 do
   358     begin
   358     begin
   359 	X:= X + dX;
   359     X:= X + dX;
   360 	Y:= Y + dY;
   360     Y:= Y + dY;
   361 	tx:= hwRound(X);
   361     tx:= hwRound(X);
   362 	ty:= hwRound(Y);
   362     ty:= hwRound(Y);
   363 	if ((ty and LAND_HEIGHT_MASK) = 0) and
   363     if ((ty and LAND_HEIGHT_MASK) = 0) and
   364 	   ((tx and LAND_WIDTH_MASK) = 0) and
   364        ((tx and LAND_WIDTH_MASK) = 0) and
   365 	   ((Land[ty, tx] = COLOR_LAND) or 
   365        ((Land[ty, tx] = COLOR_LAND) or 
   366 	   (Land[ty, tx] = COLOR_OBJECT)) then
   366        (Land[ty, tx] = COLOR_OBJECT)) then
   367 		LandPixels[ty, tx]:= cExplosionBorderColor
   367         LandPixels[ty, tx]:= cExplosionBorderColor
   368     end;
   368     end;
   369     nx:= nx - dY;
   369     nx:= nx - dY;
   370     ny:= ny + dX;
   370     ny:= ny + dX;
   371     end;
   371     end;
   372 
   372 
   374     begin
   374     begin
   375     X:= nx - dX8;
   375     X:= nx - dX8;
   376     Y:= ny - dY8;
   376     Y:= ny - dY8;
   377     for t:= 0 to 7 do
   377     for t:= 0 to 7 do
   378     begin
   378     begin
   379 	X:= X + dX;
   379     X:= X + dX;
   380 	Y:= Y + dY;
   380     Y:= Y + dY;
   381 	tx:= hwRound(X);
   381     tx:= hwRound(X);
   382 	ty:= hwRound(Y);
   382     ty:= hwRound(Y);
   383 	if ((ty and LAND_HEIGHT_MASK) = 0) and
   383     if ((ty and LAND_HEIGHT_MASK) = 0) and
   384 	   ((tx and LAND_WIDTH_MASK) = 0) and
   384        ((tx and LAND_WIDTH_MASK) = 0) and
   385 	   ((Land[ty, tx] = COLOR_LAND) or 
   385        ((Land[ty, tx] = COLOR_LAND) or 
   386 	   (Land[ty, tx] = COLOR_OBJECT)) then
   386        (Land[ty, tx] = COLOR_OBJECT)) then
   387 		LandPixels[ty, tx]:= cExplosionBorderColor
   387         LandPixels[ty, tx]:= cExplosionBorderColor
   388     end;
   388     end;
   389     X:= nx;
   389     X:= nx;
   390     Y:= ny;
   390     Y:= ny;
   391     for t:= 0 to ticks do
   391     for t:= 0 to ticks do
   392         begin
   392         begin
   403             Land[ty, tx]:= 0;
   403             Land[ty, tx]:= 0;
   404             end
   404             end
   405         end;
   405         end;
   406     for t:= 0 to 7 do
   406     for t:= 0 to 7 do
   407     begin
   407     begin
   408 	X:= X + dX;
   408     X:= X + dX;
   409 	Y:= Y + dY;
   409     Y:= Y + dY;
   410 	tx:= hwRound(X);
   410     tx:= hwRound(X);
   411 	ty:= hwRound(Y);
   411     ty:= hwRound(Y);
   412 	if ((ty and LAND_HEIGHT_MASK) = 0) and
   412     if ((ty and LAND_HEIGHT_MASK) = 0) and
   413 	   ((tx and LAND_WIDTH_MASK) = 0) and
   413        ((tx and LAND_WIDTH_MASK) = 0) and
   414 	   ((Land[ty, tx] = COLOR_LAND) or 
   414        ((Land[ty, tx] = COLOR_LAND) or 
   415 	   (Land[ty, tx] = COLOR_OBJECT)) then
   415        (Land[ty, tx] = COLOR_OBJECT)) then
   416 		LandPixels[ty, tx]:= cExplosionBorderColor
   416         LandPixels[ty, tx]:= cExplosionBorderColor
   417     end;
   417     end;
   418     nx:= nx - dY;
   418     nx:= nx - dY;
   419     ny:= ny + dX;
   419     ny:= ny + dX;
   420     end;
   420     end;
   421 
   421 
   423     begin
   423     begin
   424     X:= nx - dX8;
   424     X:= nx - dX8;
   425     Y:= ny - dY8;
   425     Y:= ny - dY8;
   426     for t:= -8 to ticks + 8 do
   426     for t:= -8 to ticks + 8 do
   427     begin
   427     begin
   428 	X:= X + dX;
   428     X:= X + dX;
   429 	Y:= Y + dY;
   429     Y:= Y + dY;
   430 	tx:= hwRound(X);
   430     tx:= hwRound(X);
   431 	ty:= hwRound(Y);
   431     ty:= hwRound(Y);
   432 	if ((ty and LAND_HEIGHT_MASK) = 0) and
   432     if ((ty and LAND_HEIGHT_MASK) = 0) and
   433 	   ((tx and LAND_WIDTH_MASK) = 0) and
   433        ((tx and LAND_WIDTH_MASK) = 0) and
   434 	   ((Land[ty, tx] = COLOR_LAND) or 
   434        ((Land[ty, tx] = COLOR_LAND) or 
   435 	   (Land[ty, tx] = COLOR_OBJECT)) then
   435        (Land[ty, tx] = COLOR_OBJECT)) then
   436 		LandPixels[ty, tx]:= cExplosionBorderColor
   436         LandPixels[ty, tx]:= cExplosionBorderColor
   437     end;
   437     end;
   438     nx:= nx - dY;
   438     nx:= nx - dY;
   439     ny:= ny + dX;
   439     ny:= ny + dX;
   440     end;
   440     end;
   441 
   441 
   522 // was experimenting with applying as damage occurred.
   522 // was experimenting with applying as damage occurred.
   523 function Despeckle(X, Y: LongInt): boolean;
   523 function Despeckle(X, Y: LongInt): boolean;
   524 var nx, ny, i, j, c: LongInt;
   524 var nx, ny, i, j, c: LongInt;
   525 begin
   525 begin
   526 if (Land[Y, X] <> 0) and (Land[Y, X] <> COLOR_INDESTRUCTIBLE) and (LandPixels[Y, X] = cExplosionBorderColor)then // check neighbours
   526 if (Land[Y, X] <> 0) and (Land[Y, X] <> COLOR_INDESTRUCTIBLE) and (LandPixels[Y, X] = cExplosionBorderColor)then // check neighbours
   527 	begin
   527     begin
   528 	c:= 0;
   528     c:= 0;
   529 	for i:= -1 to 1 do
   529     for i:= -1 to 1 do
   530 		for j:= -1 to 1 do
   530         for j:= -1 to 1 do
   531 			if (i <> 0) or (j <> 0) then
   531             if (i <> 0) or (j <> 0) then
   532 				begin
   532                 begin
   533 				ny:= Y + i;
   533                 ny:= Y + i;
   534 				nx:= X + j;
   534                 nx:= X + j;
   535 				if ((ny and LAND_HEIGHT_MASK) = 0) and ((nx and LAND_WIDTH_MASK) = 0) then
   535                 if ((ny and LAND_HEIGHT_MASK) = 0) and ((nx and LAND_WIDTH_MASK) = 0) then
   536 					if Land[ny, nx] > 255 then
   536                     if Land[ny, nx] > 255 then
   537 						inc(c);
   537                         inc(c);
   538 				end;
   538                 end;
   539 
   539 
   540 	if c < 4 then // 0-3 neighbours
   540     if c < 4 then // 0-3 neighbours
   541 		begin
   541         begin
   542         if Land[Y, X] = COLOR_LAND then LandPixels[Y, X]:= LandBackPixel(X, Y) else LandPixels[Y, X]:= 0;
   542         if Land[Y, X] = COLOR_LAND then LandPixels[Y, X]:= LandBackPixel(X, Y) else LandPixels[Y, X]:= 0;
   543 		Land[Y, X]:= 0;
   543         Land[Y, X]:= 0;
   544 		exit(true);
   544         exit(true);
   545 		end;
   545         end;
   546 	end;
   546     end;
   547 Despeckle:= false
   547 Despeckle:= false
   548 end;
   548 end;
   549 
   549 
   550 function SweepDirty: boolean;
   550 function SweepDirty: boolean;
   551 var x, y, xx, yy: LongInt;
   551 var x, y, xx, yy: LongInt;
   552     bRes, updateBlock, resweep: boolean;
   552     bRes, updateBlock, resweep: boolean;
   553 begin
   553 begin
   554 bRes:= false;
   554 bRes:= false;
   555 
   555 
   556 for y:= 0 to LAND_HEIGHT div 32 - 1 do
   556 for y:= 0 to LAND_HEIGHT div 32 - 1 do
   557 	begin
   557     begin
   558 
   558 
   559 	for x:= 0 to LAND_WIDTH div 32 - 1 do
   559     for x:= 0 to LAND_WIDTH div 32 - 1 do
   560 		begin
   560         begin
   561 		if LandDirty[y, x] <> 0 then
   561         if LandDirty[y, x] <> 0 then
   562 			begin
   562             begin
   563 			updateBlock:= false;
   563             updateBlock:= false;
   564             resweep:= true;
   564             resweep:= true;
   565             while(resweep) do
   565             while(resweep) do
   566                 begin
   566                 begin
   567                 resweep:= false;
   567                 resweep:= false;
   568                 for yy:= y * 32 to y * 32 + 31 do
   568                 for yy:= y * 32 to y * 32 + 31 do
   572                             bRes:= true;
   572                             bRes:= true;
   573                             updateBlock:= true;
   573                             updateBlock:= true;
   574                             resweep:= true;
   574                             resweep:= true;
   575                             end;
   575                             end;
   576                 end;
   576                 end;
   577 			if updateBlock then UpdateLandTexture(x * 32, 32, y * 32, 32);
   577             if updateBlock then UpdateLandTexture(x * 32, 32, y * 32, 32);
   578 			LandDirty[y, x]:= 0;
   578             LandDirty[y, x]:= 0;
   579 			end;
   579             end;
   580 		end;
   580         end;
   581 	end;
   581     end;
   582 
   582 
   583 SweepDirty:= bRes;
   583 SweepDirty:= bRes;
   584 end;
   584 end;
   585 
   585 
   586 // Return true if outside of land or not the value tested, used right now for some X/Y movement that does not use normal hedgehog movement in GSHandlers.inc
   586 // Return true if outside of land or not the value tested, used right now for some X/Y movement that does not use normal hedgehog movement in GSHandlers.inc