hedgewars/uLandGraphics.pas
changeset 5270 df1588234b96
parent 5267 e9ae019e9bb4
child 5274 941da059472b
--- a/hedgewars/uLandGraphics.pas	Fri Jun 17 18:03:12 2011 +0200
+++ b/hedgewars/uLandGraphics.pas	Mon Jun 20 20:43:11 2011 +0200
@@ -30,6 +30,7 @@
 function  addBgColor(OldColor, NewColor: LongWord): LongWord;
 function  SweepDirty: boolean;
 function  Despeckle(X, Y: LongInt): boolean;
+procedure Smooth(X, Y: LongInt);
 function  CheckLandValue(X, Y: LongInt; LandFlag: Word): boolean;
 function  DrawExplosion(X, Y, Radius: LongInt): Longword;
 procedure DrawHLinesExplosions(ar: PRangeArray; Radius: LongInt; y, dY: LongInt; Count: Byte);
@@ -751,9 +752,46 @@
 Despeckle:= false
 end;
 
+procedure Smooth(X, Y: LongInt);
+begin
+// a bit of AA for explosions
+if ((cReducedQuality and rqBlurryLand) = 0) and (Land[Y, X] = 0) and (Y > topY+1) and 
+   (Y < LAND_HEIGHT-2) and (X>leftX+1) and (X<rightX-1) then
+    begin
+    if ((((Land[y, x-1] and lfDamaged) <> 0) and (((Land[y+1,x] and lfDamaged) <> 0)) or ((Land[y-1,x] and lfDamaged) <> 0)) or
+       (((Land[y, x+1] and lfDamaged) <> 0) and (((Land[y-1,x] and lfDamaged) <> 0) or ((Land[y+1,x] and lfDamaged) <> 0)))) then
+        begin
+        if (LandPixels[y,x] = 0) then LandPixels[y,x]:= (cExplosionBorderColor and not AMask) or (128 shl AShift)
+        else
+            LandPixels[y,x]:=
+                            (((((LandPixels[y,x] and RMask shr RShift) div 2)+((cExplosionBorderColor and RMask) shr RShift) div 2) and $FF) shl RShift) or
+                            (((((LandPixels[y,x] and GMask shr GShift) div 2)+((cExplosionBorderColor and GMask) shr GShift) div 2) and $FF) shl GShift) or
+                            (((((LandPixels[y,x] and BMask shr BShift) div 2)+((cExplosionBorderColor and BMask) shr BShift) div 2) and $FF) shl BShift) or ($FF shl AShift);
+        Land[y,x]:= lfBasic
+        end
+    else if ((((Land[y, x-1] and lfDamaged) <> 0) and ((Land[y+1,x-1] and lfDamaged) <> 0) and ((Land[y+2,x] and lfDamaged) <> 0)) or
+            (((Land[y, x-1] and lfDamaged) <> 0) and ((Land[y-1,x-1] and lfDamaged) <> 0) and ((Land[y-2,x] and lfDamaged) <> 0)) or
+            (((Land[y, x+1] and lfDamaged) <> 0) and ((Land[y+1,x+1] and lfDamaged) <> 0) and ((Land[y+2,x] and lfDamaged) <> 0)) or
+            (((Land[y, x+1] and lfDamaged) <> 0) and ((Land[y-1,x+1] and lfDamaged) <> 0) and ((Land[y-2,x] and lfDamaged) <> 0)) or
+            (((Land[y+1, x] and lfDamaged) <> 0) and ((Land[y+1,x+1] and lfDamaged) <> 0) and ((Land[y,x+2] and lfDamaged) <> 0)) or
+            (((Land[y-1, x] and lfDamaged) <> 0) and ((Land[y-1,x+1] and lfDamaged) <> 0) and ((Land[y,x+2] and lfDamaged) <> 0)) or
+            (((Land[y+1, x] and lfDamaged) <> 0) and ((Land[y+1,x-1] and lfDamaged) <> 0) and ((Land[y,x-2] and lfDamaged) <> 0)) or
+            (((Land[y-1, x] and lfDamaged) <> 0) and ((Land[y-1,x-1] and lfDamaged) <> 0) and ((Land[y,x-2] and lfDamaged) <> 0))) then
+        begin
+        if (LandPixels[y,x] = 0) then LandPixels[y,x]:= (cExplosionBorderColor and not AMask) or (64 shl AShift)
+        else
+            LandPixels[y,x]:=
+                            (((((LandPixels[y,x] and RMask shr RShift) * 3 div 4)+((cExplosionBorderColor and RMask) shr RShift) div 4) and $FF) shl RShift) or
+                            (((((LandPixels[y,x] and GMask shr GShift) * 3 div 4)+((cExplosionBorderColor and GMask) shr GShift) div 4) and $FF) shl GShift) or
+                            (((((LandPixels[y,x] and BMask shr BShift) * 3 div 4)+((cExplosionBorderColor and BMask) shr BShift) div 4) and $FF) shl BShift) or ($FF shl AShift);
+        Land[y,x]:= lfBasic
+        end
+    end
+end;
+
 function SweepDirty: boolean;
 var x, y, xx, yy, ty, tx: LongInt;
-    bRes, updateBlock, resweep, recheck: boolean;
+    bRes, updateBlock, resweep, recheck, firstpass: boolean;
 begin
 bRes:= false;
 reCheck:= true;
@@ -769,6 +807,7 @@
                 begin
                 updateBlock:= false;
                 resweep:= true;
+                firstpass:= true;
                 ty:= y * 32;
                 tx:= x * 32;
                 while(resweep) do
@@ -776,6 +815,7 @@
                     resweep:= false;
                     for yy:= ty to ty + 31 do
                         for xx:= tx to tx + 31 do
+                            begin
                             if Despeckle(xx, yy) then
                                 begin
                                 bRes:= true;
@@ -802,6 +842,9 @@
                                     recheck:= true;
                                     end
                                 end;
+                            if firstpass then Smooth(xx,yy);
+                            end;
+                    firstpass:= false
                     end;
                 if updateBlock then UpdateLandTexture(tx, 32, ty, 32);
                 LandDirty[y, x]:= 0;