hedgewars/uLandGraphics.pas
changeset 5885 ae257409bcff
parent 5832 f730c8a9777b
child 5887 7d69b76ce923
equal deleted inserted replaced
5884:bd96b82e0fc8 5885:ae257409bcff
    27                                    Left, Right: LongInt;
    27                                    Left, Right: LongInt;
    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; gfxOnly: boolean): LongWord;
    32 function  Despeckle(X, Y: LongInt): Boolean;
    33 procedure Smooth(X, Y: LongInt);
    33 procedure Smooth(X, Y: LongInt);
    34 function  CheckLandValue(X, Y: LongInt; LandFlag: Word): boolean;
    34 function  CheckLandValue(X, Y: LongInt; LandFlag: Word): boolean;
    35 function  DrawExplosion(X, Y, Radius: LongInt): Longword;
    35 function  DrawExplosion(X, Y, Radius: LongInt): Longword;
    36 procedure DrawHLinesExplosions(ar: PRangeArray; Radius: LongInt; y, dY: LongInt; Count: Byte);
    36 procedure DrawHLinesExplosions(ar: PRangeArray; Radius: LongInt; y, dY: LongInt; Count: Byte);
    37 procedure DrawTunnel(X, Y, dX, dY: hwFloat; ticks, HalfWidth: LongInt);
    37 procedure DrawTunnel(X, Y, dX, dY: hwFloat; ticks, HalfWidth: LongInt);
   719 y:= Max(cpY, topY);
   719 y:= Max(cpY, topY);
   720 h:= Min(cpY + Image^.h, LAND_HEIGHT) - y;
   720 h:= Min(cpY + Image^.h, LAND_HEIGHT) - y;
   721 UpdateLandTexture(x, w, y, h)
   721 UpdateLandTexture(x, w, y, h)
   722 end;
   722 end;
   723 
   723 
   724 // was experimenting with applying as damage occurred.
   724 function Despeckle(X, Y: LongInt): boolean;
   725 function Despeckle(X, Y: LongInt; gfxOnly: boolean): LongWord;
       
   726 var nx, ny, i, j, c, xx, yy: LongInt;
   725 var nx, ny, i, j, c, xx, yy: LongInt;
   727     pixelsweep: boolean;
   726     pixelsweep: boolean;
   728 begin
   727 begin
   729 if (cReducedQuality and rqBlurryLand) = 0 then
   728 if (cReducedQuality and rqBlurryLand) = 0 then
   730    begin
   729    begin
   735    begin
   734    begin
   736    xx:= X div 2;
   735    xx:= X div 2;
   737    yy:= Y div 2;
   736    yy:= Y div 2;
   738    end;
   737    end;
   739 pixelsweep:= ((Land[Y, X] and $FF00) = 0) and (LandPixels[yy, xx] <> 0);
   738 pixelsweep:= ((Land[Y, X] and $FF00) = 0) and (LandPixels[yy, xx] <> 0);
   740 if not pixelsweep and gfxOnly then exit(0);
   739 if (((Land[Y, X] and lfDamaged) <> 0) and ((Land[Y, X] and lfIndestructible) = 0)) or pixelsweep then
   741 if ((Land[Y, X] > 255) and ((Land[Y, X] and lfIndestructible) = 0)) or pixelsweep then
       
   742     begin
   740     begin
   743     c:= 0;
   741     c:= 0;
   744     for i:= -1 to 1 do
   742     for i:= -1 to 1 do
   745         for j:= -1 to 1 do
   743         for j:= -1 to 1 do
   746             if (i <> 0) or (j <> 0) then
   744             if (i <> 0) or (j <> 0) then
   759                         if LandPixels[ny, nx] <> 0 then inc(c);
   757                         if LandPixels[ny, nx] <> 0 then inc(c);
   760                         end
   758                         end
   761                     else if Land[ny, nx] > 255 then inc(c);
   759                     else if Land[ny, nx] > 255 then inc(c);
   762                     end
   760                     end
   763                 end;
   761                 end;
   764     if (c < 2) or
   762 
   765        ((c < 4) and (((Land[Y, X] and lfDamaged) <> 0) or pixelsweep)) then
   763     if c < 4 then // 0-3 neighbours
   766         begin
   764         begin
   767         if ((Land[Y, X] and lfBasic) <> 0) and not disableLandBack then
   765         if ((Land[Y, X] and lfBasic) <> 0) and not disableLandBack then
   768             LandPixels[yy, xx]:= LandBackPixel(X, Y)
   766             LandPixels[yy, xx]:= LandBackPixel(X, Y)
   769         else
   767         else
   770             LandPixels[yy, xx]:= 0;
   768             LandPixels[yy, xx]:= 0;
   771 
   769 
   772         Land[Y, X]:= 0;
   770         Land[Y, X]:= 0;
   773         if not pixelsweep then exit(1)
   771         if not pixelsweep then exit(true);
   774         else exit(2)
       
   775         end;
   772         end;
   776     end;
   773     end;
   777 Despeckle:= 0
   774 Despeckle:= false
   778 end;
   775 end;
   779 
   776 
   780 procedure Smooth(X, Y: LongInt);
   777 procedure Smooth(X, Y: LongInt);
   781 begin
   778 begin
   782 // a bit of AA for explosions
   779 // a bit of AA for explosions
   825         end
   822         end
   826     end
   823     end
   827 end;
   824 end;
   828 
   825 
   829 function SweepDirty: boolean;
   826 function SweepDirty: boolean;
   830 var x, y, xx, yy, ty, tx, d: LongInt;
   827 var x, y, xx, yy, ty, tx: LongInt;
   831     bRes, updateBlock, resweepCol, resweepGfx, gfxOnly, recheck, firstpass: boolean;
   828     bRes, updateBlock, resweep, recheck: boolean;
   832 begin
   829 begin
   833 bRes:= false;
   830 bRes:= false;
   834 reCheck:= true;
   831 reCheck:= true;
   835 d:= 0;
   832 for y:= 0 to LAND_HEIGHT div 32 - 1 do
       
   833     for x:= 0 to LAND_WIDTH div 32 - 1 do
       
   834         if LandDirty[y, x] <> 0 then
       
   835             begin
       
   836             ty:= y * 32;
       
   837             tx:= x * 32;
       
   838             for yy:= ty to ty + 31 do
       
   839                 for xx:= tx to tx + 31 do
       
   840                     Smooth(xx,yy)
       
   841             end;
   836 
   842 
   837 while recheck do
   843 while recheck do
   838     begin
   844     begin
   839     recheck:= false;
   845     recheck:= false;
   840     for y:= 0 to LAND_HEIGHT div 32 - 1 do
   846     for y:= 0 to LAND_HEIGHT div 32 - 1 do
   842         for x:= 0 to LAND_WIDTH div 32 - 1 do
   848         for x:= 0 to LAND_WIDTH div 32 - 1 do
   843             begin
   849             begin
   844             if LandDirty[y, x] <> 0 then
   850             if LandDirty[y, x] <> 0 then
   845                 begin
   851                 begin
   846                 updateBlock:= false;
   852                 updateBlock:= false;
   847                 resweepCol:= true;
   853                 resweep:= true;
   848                 resweepGfx:= true;
       
   849                 firstpass:= true;
       
   850                 ty:= y * 32;
   854                 ty:= y * 32;
   851                 tx:= x * 32;
   855                 tx:= x * 32;
   852                 while(resweepCol or resweepGfx) do
   856                 while(resweep) do
   853                     begin
   857                     begin
   854                     gfxOnly:= resweepGfx and not resweepCol;
   858                     resweep:= false;
   855                     resweepCol:= false;
       
   856                     resweepGfx:= false;
       
   857                     for yy:= ty to ty + 31 do
   859                     for yy:= ty to ty + 31 do
   858                         for xx:= tx to tx + 31 do
   860                         for xx:= tx to tx + 31 do
   859                             begin
   861                             if Despeckle(xx, yy) then
   860                             d:= Despeckle(xx, yy, gfxOnly);
       
   861                             if d <> 0 then
       
   862                                 begin
   862                                 begin
   863                                 bRes:= true;
   863                                 bRes:= true;
   864                                 updateBlock:= true;
   864                                 updateBlock:= true;
   865                                 if d = 1 then resweepCol:= true
   865                                 resweep:= true;
   866                                 else resweepGfx:= true;
   866                                 if (yy = ty) and (y > 0) then
   867                                 if d = 1 then
   867                                     begin
   868                                     if (yy = ty) and (y > 0) then
   868                                     LandDirty[y-1, x]:= 1;
   869                                         begin
   869                                     recheck:= true;
   870                                         LandDirty[y-1, x]:= 1;
   870                                     end
   871                                         recheck:= true;
   871                                 else if (yy = ty+31) and (y < LAND_HEIGHT div 32 - 1) then
   872                                         end
   872                                     begin
   873                                     else if (yy = ty+31) and (y < LAND_HEIGHT div 32 - 1) then
   873                                     LandDirty[y+1, x]:= 1;
   874                                         begin
   874                                     recheck:= true;
   875                                         LandDirty[y+1, x]:= 1;
   875                                     end;
   876                                         recheck:= true;
   876                                 if (xx = tx) and (x > 0) then
   877                                         end;
   877                                     begin
   878                                     if (xx = tx) and (x > 0) then
   878                                     LandDirty[y, x-1]:= 1;
   879                                         begin
   879                                     recheck:= true;
   880                                         LandDirty[y, x-1]:= 1;
   880                                     end
   881                                         recheck:= true;
   881                                 else if (xx = tx+31) and (x < LAND_WIDTH div 32 - 1) then
   882                                         end
   882                                     begin
   883                                     else if (xx = tx+31) and (x < LAND_WIDTH div 32 - 1) then
   883                                     LandDirty[y, x+1]:= 1;
   884                                         begin
   884                                     recheck:= true;
   885                                         LandDirty[y, x+1]:= 1;
   885                                     end
   886                                         recheck:= true;
       
   887                                         end
       
   888                                 end;
   886                                 end;
   889                             if firstpass then Smooth(xx,yy);
       
   890                             end;
       
   891                     firstpass:= false
       
   892                     end;
   887                     end;
   893                 if updateBlock then UpdateLandTexture(tx, 32, ty, 32);
   888                 if updateBlock then UpdateLandTexture(tx, 32, ty, 32);
   894                 LandDirty[y, x]:= 0;
   889                 LandDirty[y, x]:= 0;
   895                 end;
   890                 end;
   896             end;
   891             end;
   898      end;
   893      end;
   899 
   894 
   900 SweepDirty:= bRes;
   895 SweepDirty:= bRes;
   901 end;
   896 end;
   902 
   897 
       
   898 
   903 // 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
   899 // 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
   904 function CheckLandValue(X, Y: LongInt; LandFlag: Word): boolean;
   900 function CheckLandValue(X, Y: LongInt; LandFlag: Word): boolean;
   905 begin
   901 begin
   906      CheckLandValue:= ((X and LAND_WIDTH_MASK <> 0) or (Y and LAND_HEIGHT_MASK <> 0)) or ((Land[Y, X] and LandFlag) = 0)
   902      CheckLandValue:= ((X and LAND_WIDTH_MASK <> 0) or (Y and LAND_HEIGHT_MASK <> 0)) or ((Land[Y, X] and LandFlag) = 0)
   907 end;
   903 end;