hedgewars/uLandGraphics.pas
changeset 10015 4feced261c68
parent 9998 736015b847e3
parent 9954 bf51bc7e2808
child 10040 4ac87acbaed9
equal deleted inserted replaced
10014:56d2f2d5aad8 10015:4feced261c68
    86 procedure drawPixelEBC(landX, landY, pixelX, pixelY: Longint); inline;
    86 procedure drawPixelEBC(landX, landY, pixelX, pixelY: Longint); inline;
    87 begin
    87 begin
    88 if ((Land[landY, landX] and lfBasic) <> 0) or ((Land[landY, landX] and lfObject) <> 0) then
    88 if ((Land[landY, landX] and lfBasic) <> 0) or ((Land[landY, landX] and lfObject) <> 0) then
    89     begin
    89     begin
    90     LandPixels[pixelY, pixelX]:= ExplosionBorderColor;
    90     LandPixels[pixelY, pixelX]:= ExplosionBorderColor;
    91     Land[landY, landX]:= (Land[landY, landX] or lfDamaged) and not lfIce;
    91     Land[landY, landX]:= (Land[landY, landX] or lfDamaged) and (not lfIce);
    92     LandDirty[landY div 32, landX div 32]:= 1;
    92     LandDirty[landY div 32, landX div 32]:= 1;
    93     end;
    93     end;
    94 end;
    94 end;
    95 
    95 
    96 function isLandscapeEdge(weight:Longint):boolean; inline;
    96 function isLandscapeEdge(weight:Longint):boolean; inline;
    97 begin
    97 begin
    98 result := (weight < 8) and (weight >= 2);
    98 isLandscapeEdge := (weight < 8) and (weight >= 2);
    99 end;
    99 end;
   100 
   100 
   101 function getPixelWeight(x, y:Longint): Longint;
   101 function getPixelWeight(x, y:Longint): Longint;
   102 var
   102 var
   103     i, j:Longint;
   103     i, j, r: Longint;
   104 begin
   104 begin
   105 result := 0;
   105 r := 0;
   106 for i := x - 1 to x + 1 do
   106 for i := x - 1 to x + 1 do
   107     for j := y - 1 to y + 1 do
   107     for j := y - 1 to y + 1 do
   108     begin
   108     begin
   109     if (i < 0) or
   109     if (i < 0) or
   110        (i > LAND_WIDTH - 1) or
   110        (i > LAND_WIDTH - 1) or
   111        (j < 0) or
   111        (j < 0) or
   112        (j > LAND_HEIGHT -1) then
   112        (j > LAND_HEIGHT -1) then
   113        begin
   113        exit(9);
   114        result := 9;
   114 
   115        exit;
   115     if Land[j, i] and lfLandMask and (not lfIce) = 0 then
   116        end;
   116        inc(r)
   117     if Land[j, i] and lfLandMask and not lfIce = 0 then
   117     end;
   118        result := result + 1;
   118 
   119     end;
   119     getPixelWeight:= r
   120 end;
   120 end;
   121 
   121 
   122 
   122 
   123 procedure fillPixelFromIceSprite(pixelX, pixelY:Longint); inline;
   123 procedure fillPixelFromIceSprite(pixelX, pixelY:Longint); inline;
   124 var
   124 var
   142         LandPixels[pixelY, pixelX]:= addBgColor(w, IceColor);
   142         LandPixels[pixelY, pixelX]:= addBgColor(w, IceColor);
   143         LandPixels[pixelY, pixelX]:= addBgColor(LandPixels[pixelY, pixelX], icePixels^[iceSurface^.w * (pixelY mod iceSurface^.h) + (pixelX mod iceSurface^.w)])
   143         LandPixels[pixelY, pixelX]:= addBgColor(LandPixels[pixelY, pixelX], icePixels^[iceSurface^.w * (pixelY mod iceSurface^.h) + (pixelX mod iceSurface^.w)])
   144         end
   144         end
   145     else
   145     else
   146         begin
   146         begin
   147         LandPixels[pixelY, pixelX]:= IceColor and not AMask or $E8 shl AShift;
   147         LandPixels[pixelY, pixelX]:= IceColor and (not AMask) or $E8 shl AShift;
   148         LandPixels[pixelY, pixelX]:= addBgColor(LandPixels[pixelY, pixelX], icePixels^[iceSurface^.w * (pixelY mod iceSurface^.h) + (pixelX mod iceSurface^.w)]);
   148         LandPixels[pixelY, pixelX]:= addBgColor(LandPixels[pixelY, pixelX], icePixels^[iceSurface^.w * (pixelY mod iceSurface^.h) + (pixelX mod iceSurface^.w)]);
   149         // silly workaround to avoid having to make background erasure a tadb it smarter about sea ice
   149         // silly workaround to avoid having to make background erasure a tadb it smarter about sea ice
   150         if LandPixels[pixelY, pixelX] and AMask shr AShift = 255 then
   150         if LandPixels[pixelY, pixelX] and AMask shr AShift = 255 then
   151             LandPixels[pixelY, pixelX]:= LandPixels[pixelY, pixelX] and not AMask or 254 shl AShift;
   151             LandPixels[pixelY, pixelX]:= LandPixels[pixelY, pixelX] and (not AMask) or 254 shl AShift;
   152         end;
   152         end;
   153 end;
   153 end;
   154 
   154 
   155 
   155 
   156 procedure DrawPixelIce(landX, landY, pixelX, pixelY: Longint); inline;
   156 procedure DrawPixelIce(landX, landY, pixelX, pixelY: Longint); inline;
   157 begin
   157 begin
   158 if ((Land[landY, landX] and lfIce) <> 0) then exit;
   158 if ((Land[landY, landX] and lfIce) <> 0) then exit;
   159 if isLandscapeEdge(getPixelWeight(landX, landY)) then
   159 if isLandscapeEdge(getPixelWeight(landX, landY)) then
   160     begin
   160     begin
   161     if (LandPixels[pixelY, pixelX] and AMask < 255) and (LandPixels[pixelY, pixelX] and AMask > 0) then
   161     if (LandPixels[pixelY, pixelX] and AMask < 255) and (LandPixels[pixelY, pixelX] and AMask > 0) then
   162         LandPixels[pixelY, pixelX] := (IceEdgeColor and not AMask) or (LandPixels[pixelY, pixelX] and AMask)
   162         LandPixels[pixelY, pixelX] := (IceEdgeColor and (not AMask)) or (LandPixels[pixelY, pixelX] and AMask)
   163     else if (LandPixels[pixelY, pixelX] and AMask < 255) or (Land[landY, landX] > 255) then
   163     else if (LandPixels[pixelY, pixelX] and AMask < 255) or (Land[landY, landX] > 255) then
   164         LandPixels[pixelY, pixelX] := IceEdgeColor
   164         LandPixels[pixelY, pixelX] := IceEdgeColor
   165     end
   165     end
   166 else if Land[landY, landX] > 255 then
   166 else if Land[landY, landX] > 255 then
   167     begin
   167     begin
   168         fillPixelFromIceSprite(pixelX, pixelY);
   168         fillPixelFromIceSprite(pixelX, pixelY);
   169     end;
   169     end;
   170 if Land[landY, landX] > 255 then Land[landY, landX] := Land[landY, landX] or lfIce and not lfDamaged;
   170 if Land[landY, landX] > 255 then Land[landY, landX] := Land[landY, landX] or lfIce and (not lfDamaged);
   171 end;
   171 end;
   172 
   172 
   173 
   173 
   174 function FillLandCircleLineFT(y, fromPix, toPix: LongInt; fill : fillType): Longword;
   174 function FillLandCircleLineFT(y, fromPix, toPix: LongInt; fill : fillType): Longword;
   175 var px, py, i: LongInt;
   175 var px, py, i: LongInt;
   342 
   342 
   343 procedure ChangeRoundInLand(X, Y, Radius: LongInt; doSet, isCurrent: boolean);
   343 procedure ChangeRoundInLand(X, Y, Radius: LongInt; doSet, isCurrent: boolean);
   344 begin
   344 begin
   345 if not doSet and isCurrent then
   345 if not doSet and isCurrent then
   346     FillRoundInLandFT(X, Y, Radius, setNotCurrentMask)
   346     FillRoundInLandFT(X, Y, Radius, setNotCurrentMask)
   347 else if not doSet and not IsCurrent then
   347 else if not doSet and (not IsCurrent) then
   348     FillRoundInLandFT(X, Y, Radius, changePixelSetNotCurrent)
   348     FillRoundInLandFT(X, Y, Radius, changePixelSetNotCurrent)
   349 else if doSet and IsCurrent then
   349 else if doSet and IsCurrent then
   350     FillRoundInLandFT(X, Y, Radius, setCurrentHog)
   350     FillRoundInLandFT(X, Y, Radius, setCurrentHog)
   351 else if doSet and not IsCurrent then
   351 else if doSet and (not IsCurrent) then
   352     FillRoundInLandFT(X, Y, Radius, changePixelNotSetNotCurrent);
   352     FillRoundInLandFT(X, Y, Radius, changePixelNotSetNotCurrent);
   353 end;
   353 end;
   354 
   354 
   355 procedure DrawIceBreak(x, y, iceRadius, iceHeight: Longint);
   355 procedure DrawIceBreak(x, y, iceRadius, iceHeight: Longint);
   356 var
   356 var
   430                  if (cReducedQuality and rqBlurryLand) = 0 then
   430                  if (cReducedQuality and rqBlurryLand) = 0 then
   431                     LandPixels[ty, tx]:= ExplosionBorderColor
   431                     LandPixels[ty, tx]:= ExplosionBorderColor
   432                 else
   432                 else
   433                     LandPixels[ty div 2, tx div 2]:= ExplosionBorderColor;
   433                     LandPixels[ty div 2, tx div 2]:= ExplosionBorderColor;
   434 
   434 
   435                 Land[ty, tx]:= (Land[ty, tx] or lfDamaged) and not lfIce;
   435                 Land[ty, tx]:= (Land[ty, tx] or lfDamaged) and (not lfIce);
   436                 LandDirty[ty div 32, tx div 32]:= 1;
   436                 LandDirty[ty div 32, tx div 32]:= 1;
   437                 end;
   437                 end;
   438     inc(y, dY)
   438     inc(y, dY)
   439     end;
   439     end;
   440 
   440 
   455     tx:= hwRound(X);
   455     tx:= hwRound(X);
   456     ty:= hwRound(Y);
   456     ty:= hwRound(Y);
   457     if ((ty and LAND_HEIGHT_MASK) = 0) and ((tx and LAND_WIDTH_MASK) = 0) and (((Land[ty, tx] and lfBasic) <> 0)
   457     if ((ty and LAND_HEIGHT_MASK) = 0) and ((tx and LAND_WIDTH_MASK) = 0) and (((Land[ty, tx] and lfBasic) <> 0)
   458     or ((Land[ty, tx] and lfObject) <> 0)) then
   458     or ((Land[ty, tx] and lfObject) <> 0)) then
   459         begin
   459         begin
   460         Land[ty, tx]:= (Land[ty, tx] or lfDamaged) and not lfIce;
   460         Land[ty, tx]:= (Land[ty, tx] or lfDamaged) and (not lfIce);
   461         if despeckle then
   461         if despeckle then
   462             LandDirty[ty div 32, tx div 32]:= 1;
   462             LandDirty[ty div 32, tx div 32]:= 1;
   463         if (cReducedQuality and rqBlurryLand) = 0 then
   463         if (cReducedQuality and rqBlurryLand) = 0 then
   464             LandPixels[ty, tx]:= ExplosionBorderColor
   464             LandPixels[ty, tx]:= ExplosionBorderColor
   465         else
   465         else
   499     ty:= hwRound(Y);
   499     ty:= hwRound(Y);
   500     if ((ty and LAND_HEIGHT_MASK) = 0)
   500     if ((ty and LAND_HEIGHT_MASK) = 0)
   501     and ((tx and LAND_WIDTH_MASK) = 0)
   501     and ((tx and LAND_WIDTH_MASK) = 0)
   502     and (((Land[ty, tx] and lfBasic) <> 0) or ((Land[ty, tx] and lfObject) <> 0)) then
   502     and (((Land[ty, tx] and lfBasic) <> 0) or ((Land[ty, tx] and lfObject) <> 0)) then
   503         begin
   503         begin
   504         Land[ty, tx]:= Land[ty, tx] and not lfIce;
   504         Land[ty, tx]:= Land[ty, tx] and (not lfIce);
   505         if despeckle then
   505         if despeckle then
   506             begin
   506             begin
   507             Land[ty, tx]:= Land[ty, tx] or lfDamaged;
   507             Land[ty, tx]:= Land[ty, tx] or lfDamaged;
   508             LandDirty[ty div 32, tx div 32]:= 1
   508             LandDirty[ty div 32, tx div 32]:= 1
   509             end;
   509             end;
   563     tx:= hwRound(X);
   563     tx:= hwRound(X);
   564     ty:= hwRound(Y);
   564     ty:= hwRound(Y);
   565     if ((ty and LAND_HEIGHT_MASK) = 0) and ((tx and LAND_WIDTH_MASK) = 0) and (((Land[ty, tx] and lfBasic) <> 0)
   565     if ((ty and LAND_HEIGHT_MASK) = 0) and ((tx and LAND_WIDTH_MASK) = 0) and (((Land[ty, tx] and lfBasic) <> 0)
   566     or ((Land[ty, tx] and lfObject) <> 0)) then
   566     or ((Land[ty, tx] and lfObject) <> 0)) then
   567         begin
   567         begin
   568         Land[ty, tx]:= (Land[ty, tx] or lfDamaged) and not lfIce;
   568         Land[ty, tx]:= (Land[ty, tx] or lfDamaged) and (not lfIce);
   569         if despeckle then
   569         if despeckle then
   570             LandDirty[ty div 32, tx div 32]:= 1;
   570             LandDirty[ty div 32, tx div 32]:= 1;
   571         if (cReducedQuality and rqBlurryLand) = 0 then
   571         if (cReducedQuality and rqBlurryLand) = 0 then
   572             LandPixels[ty, tx]:= ExplosionBorderColor
   572             LandPixels[ty, tx]:= ExplosionBorderColor
   573         else
   573         else