hedgewars/uLandGraphics.pas
changeset 1738 00e8dadce69a
parent 1066 1f1b3686a2b0
child 1753 2ccba26f1aa4
equal deleted inserted replaced
1736:9ae3cd2204d3 1738:00e8dadce69a
    24 type PRangeArray = ^TRangeArray;
    24 type PRangeArray = ^TRangeArray;
    25      TRangeArray = array[0..31] of record
    25      TRangeArray = array[0..31] of record
    26                                    Left, Right: LongInt;
    26                                    Left, Right: LongInt;
    27                                    end;
    27                                    end;
    28 
    28 
       
    29 procedure SweepDirty;
       
    30 function Despeckle(X, Y: LongInt): boolean;
    29 procedure DrawExplosion(X, Y, Radius: LongInt);
    31 procedure DrawExplosion(X, Y, Radius: LongInt);
    30 procedure DrawHLinesExplosions(ar: PRangeArray; Radius: LongInt; y, dY: LongInt; Count: Byte);
    32 procedure DrawHLinesExplosions(ar: PRangeArray; Radius: LongInt; y, dY: LongInt; Count: Byte);
    31 procedure DrawTunnel(X, Y, dX, dY: hwFloat; ticks, HalfWidth: LongInt);
    33 procedure DrawTunnel(X, Y, dX, dY: hwFloat; ticks, HalfWidth: LongInt);
    32 procedure FillRoundInLand(X, Y, Radius: LongInt; Value: Longword);
    34 procedure FillRoundInLand(X, Y, Radius: LongInt; Value: Longword);
    33 procedure ChangeRoundInLand(X, Y, Radius: LongInt; doSet: boolean);
    35 procedure ChangeRoundInLand(X, Y, Radius: LongInt; doSet: boolean);
   136 procedure FillLandCircleLinesEBC(x, y, dx, dy: LongInt);
   138 procedure FillLandCircleLinesEBC(x, y, dx, dy: LongInt);
   137 var i: LongInt;
   139 var i: LongInt;
   138 begin
   140 begin
   139 if ((y + dy) and $FFFFFC00) = 0 then
   141 if ((y + dy) and $FFFFFC00) = 0 then
   140    for i:= max(x - dx, 0) to min(x + dx, 2047) do
   142    for i:= max(x - dx, 0) to min(x + dx, 2047) do
   141        if Land[y + dy, i] = COLOR_LAND then LandPixels[y + dy, i]:= cExplosionBorderColor;
   143        if Land[y + dy, i] = COLOR_LAND then 
       
   144           begin
       
   145           LandPixels[y + dy, i]:= cExplosionBorderColor;
       
   146 //          Despeckle(y + dy, i);
       
   147           LandDirty[(y + dy) div 32, i div 32]:= 1;
       
   148           end;
   142 if ((y - dy) and $FFFFFC00) = 0 then
   149 if ((y - dy) and $FFFFFC00) = 0 then
   143    for i:= max(x - dx, 0) to min(x + dx, 2047) do
   150    for i:= max(x - dx, 0) to min(x + dx, 2047) do
   144        if Land[y - dy, i] = COLOR_LAND then LandPixels[y - dy, i]:= cExplosionBorderColor;
   151        if Land[y - dy, i] = COLOR_LAND then
       
   152           begin
       
   153           LandPixels[y - dy, i]:= cExplosionBorderColor;
       
   154 //          Despeckle(y - dy, i);
       
   155           LandDirty[(y - dy) div 32, i div 32]:= 1;
       
   156           end;
   145 if ((y + dx) and $FFFFFC00) = 0 then
   157 if ((y + dx) and $FFFFFC00) = 0 then
   146    for i:= max(x - dy, 0) to min(x + dy, 2047) do
   158    for i:= max(x - dy, 0) to min(x + dy, 2047) do
   147        if Land[y + dx, i] = COLOR_LAND then LandPixels[y + dx, i]:= cExplosionBorderColor;
   159        if Land[y + dx, i] = COLOR_LAND then
       
   160            begin
       
   161            LandPixels[y + dx, i]:= cExplosionBorderColor;
       
   162 //           Despeckle(y + dx, i);
       
   163            LandDirty[(y + dx) div 32, i div 32]:= 1;
       
   164            end;
   148 if ((y - dx) and $FFFFFC00) = 0 then
   165 if ((y - dx) and $FFFFFC00) = 0 then
   149    for i:= max(x - dy, 0) to min(x + dy, 2047) do
   166    for i:= max(x - dy, 0) to min(x + dy, 2047) do
   150        if Land[y - dx, i] = COLOR_LAND then LandPixels[y - dx, i]:= cExplosionBorderColor;
   167        if Land[y - dx, i] = COLOR_LAND then
       
   168           begin
       
   169           LandPixels[y - dx, i]:= cExplosionBorderColor;
       
   170 //          Despeckle(y - dx, i);
       
   171           LandDirty[(y - dx) div 32, i div 32]:= 1;
       
   172           end;
   151 end;
   173 end;
   152 
   174 
   153 procedure DrawExplosion(X, Y, Radius: LongInt);
   175 procedure DrawExplosion(X, Y, Radius: LongInt);
   154 var dx, dy, d: LongInt;
   176 var dx, dy, d: LongInt;
   155 begin
   177 begin
   209 for i:= 0 to Pred(Count) do
   231 for i:= 0 to Pred(Count) do
   210     begin
   232     begin
   211     for ty:= max(y - Radius, 0) to min(y + Radius, 1023) do
   233     for ty:= max(y - Radius, 0) to min(y + Radius, 1023) do
   212         for tx:= max(0, ar^[i].Left - Radius) to min(2047, ar^[i].Right + Radius) do
   234         for tx:= max(0, ar^[i].Left - Radius) to min(2047, ar^[i].Right + Radius) do
   213             if Land[ty, tx] = $FFFFFF then
   235             if Land[ty, tx] = $FFFFFF then
   214                   LandPixels[ty, tx]:= cExplosionBorderColor;
   236                 begin
       
   237                 LandPixels[ty, tx]:= cExplosionBorderColor;
       
   238                 LandDirty[trunc((y + dy)/32), trunc(i/32)]:= 1;
       
   239                 end;
   215     inc(y, dY)
   240     inc(y, dY)
   216     end;
   241     end;
   217 
   242 
   218 
   243 
   219 UpdateLandTexture(0, 1023)
   244 UpdateLandTexture(0, 1023)
   347 y:= max(cpY, 0);
   372 y:= max(cpY, 0);
   348 h:= min(cpY + Image^.h, 1023) - y;
   373 h:= min(cpY + Image^.h, 1023) - y;
   349 UpdateLandTexture(y, h)
   374 UpdateLandTexture(y, h)
   350 end;
   375 end;
   351 
   376 
       
   377 // was experimenting with applying as damage occurred.
       
   378 function Despeckle(X, Y: LongInt): boolean;
       
   379 var nx, ny, i, j, c: LongInt;
       
   380 begin
       
   381 if Land[Y, X] <> 0 then // check neighbours
       
   382 	begin
       
   383 	c:= 0;
       
   384 	for i:= -1 to 1 do
       
   385 		for j:= -1 to 1 do
       
   386 			if (i <> 0) or (j <> 0) then
       
   387 				begin
       
   388 				ny:= Y + i;
       
   389 				nx:= X + j;
       
   390 				if ((ny and $FFFFFC00) = 0) and ((nx and $FFFFF800) = 0) then
       
   391 					if Land[ny, nx] <> 0 then
       
   392 						inc(c);
       
   393 				end;
       
   394 
       
   395 	if c < 4 then // 0-3 neighbours
       
   396 		begin
       
   397 		LandPixels[Y, X]:= 0;
       
   398 		Land[Y, X]:= 0;
       
   399 		exit(true);
       
   400 		end;
       
   401 	end;
       
   402 Despeckle:= false
       
   403 end;
       
   404 
       
   405 procedure SweepDirty;
       
   406 var x, y, xx, yy: LongInt;
       
   407     updatedRow, updatedCell: boolean;
       
   408 begin
       
   409 for y:= 0 to 31 do
       
   410 	begin
       
   411 	updatedRow:= false;
       
   412 	
       
   413 	for x:= 0 to 63 do
       
   414 		begin
       
   415 			repeat
       
   416 			updatedCell:= false;
       
   417 			if LandDirty[y, x] <> 0 then
       
   418 				begin
       
   419 				updatedRow:= true;
       
   420 				// testing. should make black squares
       
   421 				for yy:= y * 32 to y * 32 + 31 do
       
   422 					for xx:= x * 32 to x * 32 + 31 do
       
   423 						if Despeckle(xx, yy) then updatedCell:= true;
       
   424 				end;
       
   425 			if updatedCell then updatedRow:= true
       
   426 			until not updatedCell;
       
   427 		LandDirty[y, x]:= 0;
       
   428 		end;
       
   429 	
       
   430 	if updatedRow then
       
   431 		if y = 31 then
       
   432 			UpdateLandTexture(992, 31)
       
   433 		else
       
   434 			UpdateLandTexture(y*32, 32);
       
   435 	end;
       
   436 end;
   352 
   437 
   353 end.
   438 end.