Mercurial Mercurial > hedgewars / comparison
summary | shortlog | changelog | graph | tags | bookmarks | branches | files | changeset | file | latest | revisions | annotate | diff | comparison | raw | help
Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
hedgewars/uLandGraphics.pas
branchwebgl
changeset 9950 2759212a27de
parent 9521 8054d9d775fd
parent 9879 141c0d6c2179
child 9954 bf51bc7e2808
equal deleted inserted replaced
9521:8054d9d775fd 9950:2759212a27de 
    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 FillRoundInLand2(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);
 
    49 procedure DrawIceBreak(x, y, iceRadius, iceHeight: Longint);
 
    49 procedure DrawIceBreak(x, y, iceRadius, iceHeight: Longint);
 
    50 function TryPlaceOnLand(cpX, cpY: LongInt; Obj: TSprite; Frame: LongInt; doPlace: boolean; indestructible: boolean): boolean;
 
    50 function TryPlaceOnLand(cpX, cpY: LongInt; Obj: TSprite; Frame: LongInt; doPlace, indestructible: boolean): boolean; inline;
 
       
    51 function TryPlaceOnLand(cpX, cpY: LongInt; Obj: TSprite; Frame: LongInt; doPlace, indestructible: boolean; LandFlags: Word): boolean;
 
    51 
    52 
    52 implementation
 
    53 implementation
 
    53 uses SDLh, uLandTexture, uVariables, uUtils, uDebug;
 
    54 uses SDLh, uLandTexture, uVariables, uUtils, uDebug;
 
    54 
    55 
    55 
    56 
   168     end;
 
   169     end;
 
   169 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);
 
   170 end;
 
   171 end;
 
   171 
   172 
   172 
   173 
   173 function FillLandCircleLine(y, fromPix, toPix: LongInt; fill : fillType): Longword;
 
   174 function FillLandCircleLineFT(y, fromPix, toPix: LongInt; fill : fillType): Longword;
 
   174 var px, py, i: LongInt;
 
   175 var px, py, i: LongInt;
 
   175 begin
 
   176 begin
 
   176 //get rid of compiler warning
 
   177 //get rid of compiler warning
 
   177     px := 0;
 
   178     px := 0;
 
   178     py := 0;
 
   179     py := 0;
 
   179     FillLandCircleLine := 0;
 
   180     FillLandCircleLineFT := 0;
 
   180     case fill of
 
   181     case fill of
 
   181     backgroundPixel:
 
   182     backgroundPixel:
 
   182     for i:= fromPix to toPix do
 
   183         for i:= fromPix to toPix do
 
   183         begin
 
   184             begin
 
   184         calculatePixelsCoordinates(i, y, px, py);
 
   185             calculatePixelsCoordinates(i, y, px, py);
 
   185         inc(FillLandCircleLine, drawPixelBG(i, y, px, py));
 
   186             inc(FillLandCircleLineFT, drawPixelBG(i, y, px, py));
 
   186         end;
 
   187             end;
 
   187     ebcPixel:
 
   188     ebcPixel:
 
   188     for i:= fromPix to toPix do
 
   189         for i:= fromPix to toPix do
 
   189         begin
 
   190             begin
 
   190         calculatePixelsCoordinates(i, y, px, py);
 
   191             calculatePixelsCoordinates(i, y, px, py);
 
   191         drawPixelEBC(i, y, px, py);
 
   192             drawPixelEBC(i, y, px, py);
 
   192         end;
 
   193             end;
 
   193     nullPixel:
 
   194     nullPixel:
 
   194     for i:= fromPix to toPix do
 
   195         for i:= fromPix to toPix do
 
   195         begin
 
   196             begin
 
   196         calculatePixelsCoordinates(i, y, px, py);
 
   197             calculatePixelsCoordinates(i, y, px, py);
 
   197         if ((Land[y, i] and lfIndestructible) = 0) and (not disableLandBack or (Land[y, i] > 255))  then
 
   198             if ((Land[y, i] and lfIndestructible) = 0) and (not disableLandBack or (Land[y, i] > 255))  then
 
   198             LandPixels[py, px]:= 0
 
   199                 LandPixels[py, px]:= 0
 
   199         end;
 
   200             end;
 
   200     icePixel:
 
   201     icePixel:
 
   201     for i:= fromPix to toPix do
 
   202         for i:= fromPix to toPix do
 
   202         begin
 
   203             begin
 
   203         calculatePixelsCoordinates(i, y, px, py);
 
   204             calculatePixelsCoordinates(i, y, px, py);
 
   204         DrawPixelIce(i, y, px, py);
 
   205             DrawPixelIce(i, y, px, py);
 
   205         end;
 
   206             end;
 
   206     setNotCurrentMask:
 
   207     setNotCurrentMask:
 
   207     for i:= fromPix to toPix do
 
   208         for i:= fromPix to toPix do
 
   208         begin
 
   209             begin
 
   209         Land[y, i]:= Land[y, i] and lfNotCurrentMask;
 
   210             Land[y, i]:= Land[y, i] and lfNotCurrentMask;
 
   210         end;
 
   211             end;
 
   211     changePixelSetNotCurrent:
 
   212     changePixelSetNotCurrent:
 
   212     for i:= fromPix to toPix do
 
   213         for i:= fromPix to toPix do
 
   213         begin
 
   214             begin
 
   214         if Land[y, i] and lfObjMask > 0 then
 
   215             if Land[y, i] and lfObjMask > 0 then
 
   215             Land[y, i]:= (Land[y, i] and lfNotObjMask) or ((Land[y, i] and lfObjMask) - 1);
 
   216                 Land[y, i]:= Land[y, i] - 1;
 
   216         end;
 
   217             end;
 
   217     setCurrentHog:
 
   218     setCurrentHog:
 
   218     for i:= fromPix to toPix do
 
   219         for i:= fromPix to toPix do
 
   219         begin
 
   220             begin
 
   220         Land[y, i]:= Land[y, i] or lfCurrentHog
 
   221             Land[y, i]:= Land[y, i] or lfCurrentHog
 
   221         end;
 
   222             end;
 
   222     changePixelNotSetNotCurrent:
 
   223     changePixelNotSetNotCurrent:
 
   223     for i:= fromPix to toPix do
 
   224         for i:= fromPix to toPix do
 
   224         begin
 
   225             begin
 
   225         if Land[y, i] and lfObjMask < lfObjMask then
 
   226             if Land[y, i] and lfObjMask < lfObjMask then
 
   226             Land[y, i]:= (Land[y, i] and lfNotObjMask) or ((Land[y, i] and lfObjMask) + 1)
 
   227                 Land[y, i]:= Land[y, i] + 1
 
   227         end;
 
   228             end;
 
   228     end;
 
   229     end;
 
   229 end;
 
   230 end;
 
   230 
   231 
   231 function FillLandCircleSegment(x, y, dx, dy: LongInt; fill : fillType): Longword; inline;
 
   232 function FillLandCircleSegmentFT(x, y, dx, dy: LongInt; fill : fillType): Longword; inline;
 
   232 begin
 
   233 begin
 
   233     FillLandCircleSegment := 0;
 
   234     FillLandCircleSegmentFT := 0;
 
   234 if ((y + dy) and LAND_HEIGHT_MASK) = 0 then
 
   235 if ((y + dy) and LAND_HEIGHT_MASK) = 0 then
 
   235     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));
 
   236 if ((y - dy) and LAND_HEIGHT_MASK) = 0 then
 
   237 if ((y - dy) and LAND_HEIGHT_MASK) = 0 then
 
   237     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));
 
   238 if ((y + dx) and LAND_HEIGHT_MASK) = 0 then
 
   239 if ((y + dx) and LAND_HEIGHT_MASK) = 0 then
 
   239     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));
 
   240 if ((y - dx) and LAND_HEIGHT_MASK) = 0 then
 
   241 if ((y - dx) and LAND_HEIGHT_MASK) = 0 then
 
   241     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));
 
   242 end;
 
   243 end;
 
   243 
   244 
   244 function FillRoundInLand2(X, Y, Radius: LongInt; fill: fillType): Longword; inline;
 
   245 function FillRoundInLandFT(X, Y, Radius: LongInt; fill: fillType): Longword; inline;
 
   245 var dx, dy, d, r: LongInt;
 
   246 var dx, dy, d: LongInt;
 
   246 begin
 
   247 begin
 
   247 dx:= 0;
 
   248 dx:= 0;
 
   248 dy:= Radius;
 
   249 dy:= Radius;
 
   249 d:= 3 - 2 * Radius;
 
   250 d:= 3 - 2 * Radius;
 
   250 r := 0;
 
   251 FillRoundInLandFT := 0;
 
   251 while (dx < dy) do
 
   252 while (dx < dy) do
 
   252     begin
 
   253     begin
 
   253     inc(r, FillLandCircleSegment(x, y, dx, dy, fill));
 
   254     inc(FillRoundInLandFT, FillLandCircleSegmentFT(x, y, dx, dy, fill));
 
   254     if (d < 0) then
 
   255     if (d < 0) then
 
   255         d:= d + 4 * dx + 6
 
   256         d:= d + 4 * dx + 6
 
   256     else
 
   257     else
 
   257         begin
 
   258         begin
 
   258         d:= d + 4 * (dx - dy) + 10;
 
   259         d:= d + 4 * (dx - dy) + 10;
 
   259         dec(dy)
 
   260         dec(dy)
 
   260         end;
 
   261         end;
 
   261     inc(dx)
 
   262     inc(dx)
 
   262     end;
 
   263     end;
 
   263 if (dx = dy) then
 
   264 if (dx = dy) then
 
   264     inc(r, FillLandCircleSegment(x, y, dx, dy, fill));
 
   265     inc (FillRoundInLandFT, FillLandCircleSegmentFT(x, y, dx, dy, fill));
 
   265 
       
   266 FillRoundInLand2:= r
 
       
   267 end;
 
   266 end;
 
   268 
   267 
   269 
   268 
   270 function addBgColor(OldColor, NewColor: LongWord): LongWord;
 
   269 function addBgColor(OldColor, NewColor: LongWord): LongWord;
 
   271 // Factor ranges from 0 to 100% NewColor
 
   270 // Factor ranges from 0 to 100% NewColor
 
   342 end;
 
   341 end;
 
   343 
   342 
   344 procedure ChangeRoundInLand(X, Y, Radius: LongInt; doSet, isCurrent: boolean);
 
   343 procedure ChangeRoundInLand(X, Y, Radius: LongInt; doSet, isCurrent: boolean);
 
   345 begin
 
   344 begin
 
   346 if not doSet and isCurrent then
 
   345 if not doSet and isCurrent then
 
   347     FillRoundInLand2(X, Y, Radius, setNotCurrentMask)
 
   346     FillRoundInLandFT(X, Y, Radius, setNotCurrentMask)
 
   348 else if not doSet and (not IsCurrent) then
 
   347 else if not doSet and not IsCurrent then
 
   349     FillRoundInLand2(X, Y, Radius, changePixelSetNotCurrent)
 
   348     FillRoundInLandFT(X, Y, Radius, changePixelSetNotCurrent)
 
   350 else if doSet and IsCurrent then
 
   349 else if doSet and IsCurrent then
 
   351     FillRoundInLand2(X, Y, Radius, setCurrentHog)
 
   350     FillRoundInLandFT(X, Y, Radius, setCurrentHog)
 
   352 else if doSet and (not IsCurrent) then
 
   351 else if doSet and not IsCurrent then
 
   353     FillRoundInLand2(X, Y, Radius, changePixelNotSetNotCurrent);
 
   352     FillRoundInLandFT(X, Y, Radius, changePixelNotSetNotCurrent);
 
   354 end;
 
   353 end;
 
   355 
   354 
   356 procedure DrawIceBreak(x, y, iceRadius, iceHeight: Longint);
 
   355 procedure DrawIceBreak(x, y, iceRadius, iceHeight: Longint);
 
   357 var
 
   356 var
 
   358     i, j: integer;
 
   357     i, j: integer;
 
   378 
   377 
   379 function DrawExplosion(X, Y, Radius: LongInt): Longword;
 
   378 function DrawExplosion(X, Y, Radius: LongInt): Longword;
 
   380 var
 
   379 var
 
   381     tx, ty, dx, dy: Longint;
 
   380     tx, ty, dx, dy: Longint;
 
   382 begin
 
   381 begin
 
   383     DrawExplosion := FillRoundInLand2(x, y, Radius, backgroundPixel);
 
   382     DrawExplosion := FillRoundInLandFT(x, y, Radius, backgroundPixel);
 
   384     if Radius > 20 then
 
   383     if Radius > 20 then
 
   385         FillRoundInLand2(x, y, Radius - 15, nullPixel);
 
   384         FillRoundInLandFT(x, y, Radius - 15, nullPixel);
 
   386     FillRoundInLand(X, Y, Radius, 0);
 
   385     FillRoundInLand(X, Y, Radius, 0);
 
   387     FillRoundInLand2(x, y, Radius + 4, ebcPixel);
 
   386     FillRoundInLandFT(x, y, Radius + 4, ebcPixel);
 
   388     tx:= Max(X - Radius - 5, 0);
 
   387     tx:= Max(X - Radius - 5, 0);
 
   389     dx:= Min(X + Radius + 5, LAND_WIDTH) - tx;
 
   388     dx:= Min(X + Radius + 5, LAND_WIDTH) - tx;
 
   390     ty:= Max(Y - Radius - 5, 0);
 
   389     ty:= Max(Y - Radius - 5, 0);
 
   391     dy:= Min(Y + Radius + 5, LAND_HEIGHT) - ty;
 
   390     dy:= Min(Y + Radius + 5, LAND_HEIGHT) - ty;
 
   392     UpdateLandTexture(tx, dx, ty, dy, false);
 
   391     UpdateLandTexture(tx, dx, ty, dy, false);
 
   585 ddy:= Min(stY + HalfWidth * 2 + 4 + abs(hwRound(dY * ticks)), LAND_HEIGHT) - ty;
 
   584 ddy:= Min(stY + HalfWidth * 2 + 4 + abs(hwRound(dY * ticks)), LAND_HEIGHT) - ty;
 
   586 
   585 
   587 UpdateLandTexture(tx, ddx, ty, ddy, false)
 
   586 UpdateLandTexture(tx, ddx, ty, ddy, false)
 
   588 end;
 
   587 end;
 
   589 
   588 
   590 function TryPlaceOnLand(cpX, cpY: LongInt; Obj: TSprite; Frame: LongInt; doPlace: boolean; indestructible: boolean): boolean;
 
   589 function TryPlaceOnLand(cpX, cpY: LongInt; Obj: TSprite; Frame: LongInt; doPlace, indestructible: boolean): boolean; inline;
 
       
   590 begin
 
       
   591 TryPlaceOnLand:= TryPlaceOnLand(cpX, cpY, Obj, Frame, doPlace, indestructible, 0);
 
       
   592 end;
 
       
   593 
       
   594 function TryPlaceOnLand(cpX, cpY: LongInt; Obj: TSprite; Frame: LongInt; doPlace, indestructible: boolean; LandFlags: Word): boolean;
 
   591 var X, Y, bpp, h, w, row, col, gx, gy, numFramesFirstCol: LongInt;
 
   595 var X, Y, bpp, h, w, row, col, gx, gy, numFramesFirstCol: LongInt;
 
   592     p: PByteArray;
 
   596     p: PByteArray;
 
   593     Image: PSDL_Surface;
 
   597     Image: PSDL_Surface;
 
   594 begin
 
   598 begin
 
   595 TryPlaceOnLand:= false;
 
   599 TryPlaceOnLand:= false;
 
   650                      begin
 
   654                      begin
 
   651                      gX:= (cpX + x) div 2;
 
   655                      gX:= (cpX + x) div 2;
 
   652                      gY:= (cpY + y) div 2;
 
   656                      gY:= (cpY + y) div 2;
 
   653                     end;
 
   657                     end;
 
   654                 if indestructible then
 
   658                 if indestructible then
 
   655                     Land[cpY + y, cpX + x]:= lfIndestructible
 
   659                     Land[cpY + y, cpX + x]:= lfIndestructible or LandFlags
 
   656                 else if (LandPixels[gY, gX] and AMask) shr AShift = 255 then  // This test assumes lfBasic and lfObject differ only graphically
 
   660                 else if (LandPixels[gY, gX] and AMask) shr AShift = 255 then  // This test assumes lfBasic and lfObject differ only graphically
 
   657                     Land[cpY + y, cpX + x]:= lfBasic
 
   661                     Land[cpY + y, cpX + x]:= lfBasic or LandFlags
 
   658                 else
 
   662                 else
 
   659                     Land[cpY + y, cpX + x]:= lfObject;
 
   663                     Land[cpY + y, cpX + x]:= lfObject or LandFlags;
 
   660                 // For testing only. Intent is to flag this on objects with masks, or use it for an ice ray gun
 
   664                 LandPixels[gY, gX]:= PLongword(@(p^[x * 4]))^
 
   661                 if (Theme = 'Snow') or (Theme = 'Christmas') then
 
       
   662                     Land[cpY + y, cpX + x]:= Land[cpY + y, cpX + x] or lfIce;
 
       
   663                     LandPixels[gY, gX]:= PLongword(@(p^[x * 4]))^
 
       
   664                 end;
 
   665                 end;
 
   665         p:= @(p^[Image^.pitch]);
 
   666         p:= @(p^[Image^.pitch]);
 
   666         end;
 
   667         end;
 
   667     end;
 
   668     end;
 
   668 if SDL_MustLock(Image) then
 
   669 if SDL_MustLock(Image) then
hedgewars