hedgewars/uLandGraphics.pas
changeset 9876 641c334eab46
parent 9768 08799c901a42
child 9877 2f3355b29420
equal deleted inserted replaced
9875:7641e99c7633 9876:641c334eab46
    38 function  CheckLandValue(X, Y: LongInt; LandFlag: Word): boolean;
    38 function  CheckLandValue(X, Y: LongInt; LandFlag: Word): boolean;
    39 function  DrawExplosion(X, Y, Radius: LongInt): Longword;
    39 function  DrawExplosion(X, Y, Radius: LongInt): Longword;
    40 procedure DrawHLinesExplosions(ar: PRangeArray; Radius: LongInt; y, dY: LongInt; Count: Byte);
    40 procedure DrawHLinesExplosions(ar: PRangeArray; Radius: LongInt; y, dY: LongInt; Count: Byte);
    41 procedure DrawTunnel(X, Y, dX, dY: hwFloat; ticks, HalfWidth: LongInt);
    41 procedure DrawTunnel(X, Y, dX, dY: hwFloat; ticks, HalfWidth: LongInt);
    42 procedure FillRoundInLand(X, Y, Radius: LongInt; Value: Longword);
    42 procedure FillRoundInLand(X, Y, Radius: LongInt; Value: Longword);
    43 function FillRoundInLand(X, Y, Radius: LongInt; fill: fillType): LongWord;
    43 function FillRoundInLandFT(X, Y, Radius: LongInt; fill: fillType): Longword;
    44 procedure ChangeRoundInLand(X, Y, Radius: LongInt; doSet, isCurrent: boolean);
    44 procedure ChangeRoundInLand(X, Y, Radius: LongInt; doSet, isCurrent: boolean);
    45 function  LandBackPixel(x, y: LongInt): LongWord;
    45 function  LandBackPixel(x, y: LongInt): LongWord;
    46 procedure DrawLine(X1, Y1, X2, Y2: LongInt; Color: Longword);
    46 procedure DrawLine(X1, Y1, X2, Y2: LongInt; Color: Longword);
    47 procedure DrawThickLine(X1, Y1, X2, Y2, radius: LongInt; color: Longword);
    47 procedure DrawThickLine(X1, Y1, X2, Y2, radius: LongInt; color: Longword);
    48 procedure DumpLandToLog(x, y, r: LongInt);
    48 procedure DumpLandToLog(x, y, r: LongInt);
   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 FillLandCircleLine(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;
   176 begin
   176 begin
   177 //get rid of compiler warning
   177 //get rid of compiler warning
   178     px := 0;
   178     px := 0;
   179     py := 0;
   179     py := 0;
   180     FillLandCircleLine := 0;
   180     FillLandCircleLineFT := 0;
   181     case fill of
   181     case fill of
   182     backgroundPixel:
   182     backgroundPixel:
   183     for i:= fromPix to toPix do
   183     for i:= fromPix to toPix do
   184         begin
   184         begin
   185         calculatePixelsCoordinates(i, y, px, py);
   185         calculatePixelsCoordinates(i, y, px, py);
   186         inc(FillLandCircleLine, drawPixelBG(i, y, px, py));
   186         inc(FillLandCircleLineFT, drawPixelBG(i, y, px, py));
   187         end;
   187         end;
   188     ebcPixel:
   188     ebcPixel:
   189     for i:= fromPix to toPix do
   189     for i:= fromPix to toPix do
   190         begin
   190         begin
   191         calculatePixelsCoordinates(i, y, px, py);
   191         calculatePixelsCoordinates(i, y, px, py);
   227             Land[y, i]:= (Land[y, i] and lfNotObjMask) or ((Land[y, i] and lfObjMask) + 1)
   227             Land[y, i]:= (Land[y, i] and lfNotObjMask) or ((Land[y, i] and lfObjMask) + 1)
   228         end;
   228         end;
   229     end;
   229     end;
   230 end;
   230 end;
   231 
   231 
   232 function FillLandCircleSegment(x, y, dx, dy: LongInt; fill : fillType): Longword; inline;
   232 function FillLandCircleSegmentFT(x, y, dx, dy: LongInt; fill : fillType): Longword; inline;
   233 begin
   233 begin
   234     FillLandCircleSegment := 0;
   234     FillLandCircleSegmentFT := 0;
   235 if ((y + dy) and LAND_HEIGHT_MASK) = 0 then
   235 if ((y + dy) and LAND_HEIGHT_MASK) = 0 then
   236     inc(FillLandCircleSegment, FillLandCircleLine(y + dy, Max(x - dx, 0), Min(x + dx, LAND_WIDTH - 1), fill));
   236     inc(FillLandCircleSegmentFT, FillLandCircleLineFT(y + dy, Max(x - dx, 0), Min(x + dx, LAND_WIDTH - 1), fill));
   237 if ((y - dy) and LAND_HEIGHT_MASK) = 0 then
   237 if ((y - dy) and LAND_HEIGHT_MASK) = 0 then
   238     inc(FillLandCircleSegment, FillLandCircleLine(y - dy, Max(x - dx, 0), Min(x + dx, LAND_WIDTH - 1), fill));
   238     inc(FillLandCircleSegmentFT, FillLandCircleLineFT(y - dy, Max(x - dx, 0), Min(x + dx, LAND_WIDTH - 1), fill));
   239 if ((y + dx) and LAND_HEIGHT_MASK) = 0 then
   239 if ((y + dx) and LAND_HEIGHT_MASK) = 0 then
   240     inc(FillLandCircleSegment, FillLandCircleLine(y + dx, Max(x - dy, 0), Min(x + dy, LAND_WIDTH - 1), fill));
   240     inc(FillLandCircleSegmentFT, FillLandCircleLineFT(y + dx, Max(x - dy, 0), Min(x + dy, LAND_WIDTH - 1), fill));
   241 if ((y - dx) and LAND_HEIGHT_MASK) = 0 then
   241 if ((y - dx) and LAND_HEIGHT_MASK) = 0 then
   242     inc(FillLandCircleSegment, FillLandCircleLine(y - dx, Max(x - dy, 0), Min(x + dy, LAND_WIDTH - 1), fill));
   242     inc(FillLandCircleSegmentFT, FillLandCircleLineFT(y - dx, Max(x - dy, 0), Min(x + dy, LAND_WIDTH - 1), fill));
   243 end;
   243 end;
   244 
   244 
   245 function FillRoundInLand(X, Y, Radius: LongInt; fill: fillType): Longword; inline;
   245 function FillRoundInLandFT(X, Y, Radius: LongInt; fill: fillType): Longword; inline;
   246 var dx, dy, d: LongInt;
   246 var dx, dy, d: LongInt;
   247 begin
   247 begin
   248 dx:= 0;
   248 dx:= 0;
   249 dy:= Radius;
   249 dy:= Radius;
   250 d:= 3 - 2 * Radius;
   250 d:= 3 - 2 * Radius;
   251 FillRoundInLand := 0;
   251 FillRoundInLandFT := 0;
   252 while (dx < dy) do
   252 while (dx < dy) do
   253     begin
   253     begin
   254     inc(FillRoundInLand, FillLandCircleSegment(x, y, dx, dy, fill));
   254     inc(FillRoundInLandFT, FillLandCircleSegmentFT(x, y, dx, dy, fill));
   255     if (d < 0) then
   255     if (d < 0) then
   256         d:= d + 4 * dx + 6
   256         d:= d + 4 * dx + 6
   257     else
   257     else
   258         begin
   258         begin
   259         d:= d + 4 * (dx - dy) + 10;
   259         d:= d + 4 * (dx - dy) + 10;
   260         dec(dy)
   260         dec(dy)
   261         end;
   261         end;
   262     inc(dx)
   262     inc(dx)
   263     end;
   263     end;
   264 if (dx = dy) then
   264 if (dx = dy) then
   265     inc (FillRoundInLand, FillLandCircleSegment(x, y, dx, dy, fill));
   265     inc (FillRoundInLandFT, FillLandCircleSegmentFT(x, y, dx, dy, fill));
   266 end;
   266 end;
   267 
   267 
   268 
   268 
   269 function addBgColor(OldColor, NewColor: LongWord): LongWord;
   269 function addBgColor(OldColor, NewColor: LongWord): LongWord;
   270 // Factor ranges from 0 to 100% NewColor
   270 // Factor ranges from 0 to 100% NewColor
   341 end;
   341 end;
   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     FillRoundInLand(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     FillRoundInLand(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     FillRoundInLand(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     FillRoundInLand(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
   357     i, j: integer;
   357     i, j: integer;
   377 
   377 
   378 function DrawExplosion(X, Y, Radius: LongInt): Longword;
   378 function DrawExplosion(X, Y, Radius: LongInt): Longword;
   379 var
   379 var
   380     tx, ty, dx, dy: Longint;
   380     tx, ty, dx, dy: Longint;
   381 begin
   381 begin
   382     DrawExplosion := FillRoundInLand(x, y, Radius, backgroundPixel);
   382     DrawExplosion := FillRoundInLandFT(x, y, Radius, backgroundPixel);
   383     if Radius > 20 then
   383     if Radius > 20 then
   384         FillRoundInLand(x, y, Radius - 15, nullPixel);
   384         FillRoundInLandFT(x, y, Radius - 15, nullPixel);
   385     FillRoundInLand(X, Y, Radius, 0);
   385     FillRoundInLand(X, Y, Radius, 0);
   386     FillRoundInLand(x, y, Radius + 4, ebcPixel);
   386     FillRoundInLandFT(x, y, Radius + 4, ebcPixel);
   387     tx:= Max(X - Radius - 5, 0);
   387     tx:= Max(X - Radius - 5, 0);
   388     dx:= Min(X + Radius + 5, LAND_WIDTH) - tx;
   388     dx:= Min(X + Radius + 5, LAND_WIDTH) - tx;
   389     ty:= Max(Y - Radius - 5, 0);
   389     ty:= Max(Y - Radius - 5, 0);
   390     dy:= Min(Y + Radius + 5, LAND_HEIGHT) - ty;
   390     dy:= Min(Y + Radius + 5, LAND_HEIGHT) - ty;
   391     UpdateLandTexture(tx, dx, ty, dy, false);
   391     UpdateLandTexture(tx, dx, ty, dy, false);