hedgewars/uLandGraphics.pas
changeset 6011 519f8a58c021
parent 5895 212d3b459658
child 6077 d8fa5a85d24f
equal deleted inserted replaced
6010:10913a80cb50 6011:519f8a58c021
    45 uses SDLh, uLandTexture, uVariables, uUtils, uDebug;
    45 uses SDLh, uLandTexture, uVariables, uUtils, uDebug;
    46 
    46 
    47 function addBgColor(OldColor, NewColor: LongWord): LongWord;
    47 function addBgColor(OldColor, NewColor: LongWord): LongWord;
    48 // Factor ranges from 0 to 100% NewColor
    48 // Factor ranges from 0 to 100% NewColor
    49 var
    49 var
    50     oRed, oBlue, oGreen, oAlpha, nRed, nBlue, nGreen, nAlpha: LongWord;
    50     oRed, oBlue, oGreen, oAlpha, nRed, nBlue, nGreen, nAlpha: byte;
    51 begin
    51 begin
    52     oAlpha := (OldColor shr AShift) and $FF;
    52     oAlpha := (OldColor shr AShift);
    53     nAlpha := (NewColor shr AShift) and $FF;
    53     nAlpha := (NewColor shr AShift);
    54     // shortcircuit
    54     // shortcircuit
    55     if (oAlpha = 0) or (nAlpha = $FF) then
    55     if (oAlpha = 0) or (nAlpha = $FF) then
    56         begin
    56         begin
    57         addBgColor:= NewColor;
    57         addBgColor:= NewColor;
    58         exit
    58         exit
    59         end; 
    59         end; 
    60     // Get colors
    60     // Get colors
    61     oRed   := (OldColor shr RShift) and $FF;
    61     oRed   := (OldColor shr RShift);
    62     oGreen := (OldColor shr GShift) and $FF;
    62     oGreen := (OldColor shr GShift);
    63     oBlue  := (OldColor shr BShift) and $FF;
    63     oBlue  := (OldColor shr BShift);
    64 
    64 
    65     nRed   := (NewColor shr RShift) and $FF;
    65     nRed   := (NewColor shr RShift);
    66     nGreen := (NewColor shr GShift) and $FF;
    66     nGreen := (NewColor shr GShift);
    67     nBlue  := (NewColor shr BShift) and $FF;
    67     nBlue  := (NewColor shr BShift);
    68 
    68 
    69     // Mix colors
    69     // Mix colors
    70     nRed   := min(255,((nRed*nAlpha) div 255) + ((oRed*oAlpha*(255-nAlpha)) div 65025));
    70     nRed   := min(255,((nRed*nAlpha) div 255) + ((oRed*oAlpha*byte(255-nAlpha)) div 65025));
    71     nGreen := min(255,((nGreen*nAlpha) div 255) + ((oGreen*oAlpha*(255-nAlpha)) div 65025));
    71     nGreen := min(255,((nGreen*nAlpha) div 255) + ((oGreen*oAlpha*byte(255-nAlpha)) div 65025));
    72     nBlue  := min(255,((nBlue*nAlpha) div 255) + ((oBlue*oAlpha*(255-nAlpha)) div 65025)); 
    72     nBlue  := min(255,((nBlue*nAlpha) div 255) + ((oBlue*oAlpha*byte(255-nAlpha)) div 65025)); 
    73     nAlpha := min(255, oAlpha + nAlpha);
    73     nAlpha := min(255, oAlpha + nAlpha);
    74 
    74 
    75     addBgColor := (nAlpha shl AShift) or (nRed shl RShift) or (nGreen shl GShift) or (nBlue shl BShift);
    75     addBgColor := (nAlpha shl AShift) or (nRed shl RShift) or (nGreen shl GShift) or (nBlue shl BShift);
    76 end;
    76 end;
    77 
    77 
   778 end;
   778 end;
   779 
   779 
   780 procedure Smooth(X, Y: LongInt);
   780 procedure Smooth(X, Y: LongInt);
   781 begin
   781 begin
   782 // a bit of AA for explosions
   782 // a bit of AA for explosions
   783 if (Land[Y, X] = 0) and (Y > topY+1) and 
   783 if (Land[Y, X] = 0) and (Y > LongInt(topY) + 1) and 
   784    (Y < LAND_HEIGHT-2) and (X>leftX+1) and (X<rightX-1) then
   784    (Y < LAND_HEIGHT-2) and (X > LongInt(leftX) + 1) and (X < LongInt(rightX) - 1) then
   785     begin
   785     begin
   786     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
   786     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
   787        (((Land[y, x+1] and lfDamaged) <> 0) and (((Land[y-1,x] and lfDamaged) <> 0) or ((Land[y+1,x] and lfDamaged) <> 0)))) then
   787        (((Land[y, x+1] and lfDamaged) <> 0) and (((Land[y-1,x] and lfDamaged) <> 0) or ((Land[y+1,x] and lfDamaged) <> 0)))) then
   788         begin
   788         begin
   789         if (cReducedQuality and rqBlurryLand) = 0 then
   789         if (cReducedQuality and rqBlurryLand) = 0 then