hedgewars/uLandGraphics.pas
changeset 5267 e9ae019e9bb4
parent 5266 1c2a7547efaa
child 5274 941da059472b
equal deleted inserted replaced
5266:1c2a7547efaa 5267:e9ae019e9bb4
    28                                    end;
    28                                    end;
    29 
    29 
    30 function  addBgColor(OldColor, NewColor: LongWord): LongWord;
    30 function  addBgColor(OldColor, NewColor: LongWord): LongWord;
    31 function  SweepDirty: boolean;
    31 function  SweepDirty: boolean;
    32 function  Despeckle(X, Y: LongInt): boolean;
    32 function  Despeckle(X, Y: LongInt): boolean;
       
    33 procedure Smooth(X, Y: LongInt);
    33 function  CheckLandValue(X, Y: LongInt; LandFlag: Word): boolean;
    34 function  CheckLandValue(X, Y: LongInt; LandFlag: Word): boolean;
    34 function  DrawExplosion(X, Y, Radius: LongInt): Longword;
    35 function  DrawExplosion(X, Y, Radius: LongInt): Longword;
    35 procedure DrawHLinesExplosions(ar: PRangeArray; Radius: LongInt; y, dY: LongInt; Count: Byte);
    36 procedure DrawHLinesExplosions(ar: PRangeArray; Radius: LongInt; y, dY: LongInt; Count: Byte);
    36 procedure DrawTunnel(X, Y, dX, dY: hwFloat; ticks, HalfWidth: LongInt);
    37 procedure DrawTunnel(X, Y, dX, dY: hwFloat; ticks, HalfWidth: LongInt);
    37 procedure FillRoundInLand(X, Y, Radius: LongInt; Value: Longword);
    38 procedure FillRoundInLand(X, Y, Radius: LongInt; Value: Longword);
   746 
   747 
   747         Land[Y, X]:= 0;
   748         Land[Y, X]:= 0;
   748         if not pixelsweep then exit(true);
   749         if not pixelsweep then exit(true);
   749         end;
   750         end;
   750     end;
   751     end;
       
   752 Despeckle:= false
       
   753 end;
       
   754 
       
   755 procedure Smooth(X, Y: LongInt);
       
   756 begin
   751 // a bit of AA for explosions
   757 // a bit of AA for explosions
   752 if ((cReducedQuality and rqBlurryLand) = 0) and (Land[Y, X] = 0) and (Y > topY+1) and 
   758 if ((cReducedQuality and rqBlurryLand) = 0) and (Land[Y, X] = 0) and (Y > topY+1) and 
   753    (Y < LAND_HEIGHT-2) and (X>leftX+1) and (X<rightX-1) then
   759    (Y < LAND_HEIGHT-2) and (X>leftX+1) and (X<rightX-1) then
   754     begin
   760     begin
   755     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
   761     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
   778                             (((((LandPixels[y,x] and RMask shr RShift) * 3 div 4)+((cExplosionBorderColor and RMask) shr RShift) div 4) and $FF) shl RShift) or
   784                             (((((LandPixels[y,x] and RMask shr RShift) * 3 div 4)+((cExplosionBorderColor and RMask) shr RShift) div 4) and $FF) shl RShift) or
   779                             (((((LandPixels[y,x] and GMask shr GShift) * 3 div 4)+((cExplosionBorderColor and GMask) shr GShift) div 4) and $FF) shl GShift) or
   785                             (((((LandPixels[y,x] and GMask shr GShift) * 3 div 4)+((cExplosionBorderColor and GMask) shr GShift) div 4) and $FF) shl GShift) or
   780                             (((((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);
   786                             (((((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);
   781         Land[y,x]:= lfBasic
   787         Land[y,x]:= lfBasic
   782         end
   788         end
   783     end;
   789     end
   784 Despeckle:= false
       
   785 end;
   790 end;
   786 
   791 
   787 function SweepDirty: boolean;
   792 function SweepDirty: boolean;
   788 var x, y, xx, yy, ty, tx: LongInt;
   793 var x, y, xx, yy, ty, tx: LongInt;
   789     bRes, updateBlock, resweep, recheck: boolean;
   794     bRes, updateBlock, resweep, recheck, firstpass: boolean;
   790 begin
   795 begin
   791 bRes:= false;
   796 bRes:= false;
   792 reCheck:= true;
   797 reCheck:= true;
   793 
   798 
   794 while recheck do
   799 while recheck do
   800             begin
   805             begin
   801             if LandDirty[y, x] <> 0 then
   806             if LandDirty[y, x] <> 0 then
   802                 begin
   807                 begin
   803                 updateBlock:= false;
   808                 updateBlock:= false;
   804                 resweep:= true;
   809                 resweep:= true;
       
   810                 firstpass:= true;
   805                 ty:= y * 32;
   811                 ty:= y * 32;
   806                 tx:= x * 32;
   812                 tx:= x * 32;
   807                 while(resweep) do
   813                 while(resweep) do
   808                     begin
   814                     begin
   809                     resweep:= false;
   815                     resweep:= false;
   810                     for yy:= ty to ty + 31 do
   816                     for yy:= ty to ty + 31 do
   811                         for xx:= tx to tx + 31 do
   817                         for xx:= tx to tx + 31 do
       
   818                             begin
   812                             if Despeckle(xx, yy) then
   819                             if Despeckle(xx, yy) then
   813                                 begin
   820                                 begin
   814                                 bRes:= true;
   821                                 bRes:= true;
   815                                 updateBlock:= true;
   822                                 updateBlock:= true;
   816                                 resweep:= true;
   823                                 resweep:= true;
   833                                     begin
   840                                     begin
   834                                     LandDirty[y, x+1]:= 1;
   841                                     LandDirty[y, x+1]:= 1;
   835                                     recheck:= true;
   842                                     recheck:= true;
   836                                     end
   843                                     end
   837                                 end;
   844                                 end;
       
   845                             if firstpass then Smooth(xx,yy);
       
   846                             end;
       
   847                     firstpass:= false
   838                     end;
   848                     end;
   839                 if updateBlock then UpdateLandTexture(tx, 32, ty, 32);
   849                 if updateBlock then UpdateLandTexture(tx, 32, ty, 32);
   840                 LandDirty[y, x]:= 0;
   850                 LandDirty[y, x]:= 0;
   841                 end;
   851                 end;
   842             end;
   852             end;