hedgewars/uLandGraphics.pas
changeset 8602 f510cca2b988
parent 8601 7668f92734b8
child 8612 f7c194533d45
equal deleted inserted replaced
8601:7668f92734b8 8602:f510cca2b988
    40 procedure ChangeRoundInLand(X, Y, Radius: LongInt; doSet, isCurrent: boolean);
    40 procedure ChangeRoundInLand(X, Y, Radius: LongInt; doSet, isCurrent: boolean);
    41 function  LandBackPixel(x, y: LongInt): LongWord;
    41 function  LandBackPixel(x, y: LongInt): LongWord;
    42 procedure DrawLine(X1, Y1, X2, Y2: LongInt; Color: Longword);
    42 procedure DrawLine(X1, Y1, X2, Y2: LongInt; Color: Longword);
    43 procedure DrawThickLine(X1, Y1, X2, Y2, radius: LongInt; color: Longword);
    43 procedure DrawThickLine(X1, Y1, X2, Y2, radius: LongInt; color: Longword);
    44 procedure DumpLandToLog(x, y, r: LongInt);
    44 procedure DumpLandToLog(x, y, r: LongInt);
    45 
    45 procedure DrawIceBreak(x, y, iceRadius, iceHeight: Longint);
    46 function TryPlaceOnLand(cpX, cpY: LongInt; Obj: TSprite; Frame: LongInt; doPlace: boolean; indestructible: boolean): boolean;
    46 function TryPlaceOnLand(cpX, cpY: LongInt; Obj: TSprite; Frame: LongInt; doPlace: boolean; indestructible: boolean): boolean;
    47 
    47 
    48 implementation
    48 implementation
    49 uses SDLh, uLandTexture, uVariables, uUtils, uDebug;
    49 uses SDLh, uLandTexture, uVariables, uUtils, uDebug;
    50 
    50 
   261         for j := y - 1 to y + 1 do
   261         for j := y - 1 to y + 1 do
   262         begin
   262         begin
   263         if (i < 0) or
   263         if (i < 0) or
   264            (i > LAND_WIDTH - 1) or
   264            (i > LAND_WIDTH - 1) or
   265            (j < 0) or
   265            (j < 0) or
   266            (j > LAND_HEIGHT -1) or
   266            (j > LAND_HEIGHT -1) then
   267            ((Land[j, i] and $FF00) = 0) then
   267                begin               
       
   268                 result := 0;
       
   269                 exit;
       
   270                end;
       
   271 
       
   272         if ((Land[j, i] and $FF00) = 0) and ((Land[j, i] and lfIce) = 0) then
   268            begin
   273            begin
   269            result := result + 1;
   274            result := result + 1;
   270            end;
   275            end;
   271         end;
   276         end;
   272 end;
   277 end;
   334                         LandPixels[py, px] := IceEdgeColor
   339                         LandPixels[py, px] := IceEdgeColor
   335                     end
   340                     end
   336                 else if Land[t, i] > 255 then
   341                 else if Land[t, i] > 255 then
   337                     begin
   342                     begin
   338                     drawIcePixel(py, px)
   343                     drawIcePixel(py, px)
   339                     end
   344                     end;
       
   345                 if Land[t, i] > 255 then Land[t, i] := Land[t, i] or lfIce and not lfDamaged;
   340                 end;
   346                 end;
   341                 if Land[t, i] > 255 then Land[t, i] := Land[t, i] or lfIce and not lfDamaged;
       
   342     end
   347     end
   343 end;
   348 end;
   344 
   349 
   345 procedure FillRoundInLandWithIce(X, Y, Radius: LongInt);
   350 procedure FillRoundInLandWithIce(X, Y, Radius: LongInt);
   346 var dx, dy, d: LongInt;
   351 var dx, dy, d: LongInt;
   367 landRect.y := min(max(y - Radius, 0), LAND_HEIGHT - 1);
   372 landRect.y := min(max(y - Radius, 0), LAND_HEIGHT - 1);
   368 landRect.w := min(2*Radius, LAND_WIDTH - landRect.x - 1);
   373 landRect.w := min(2*Radius, LAND_WIDTH - landRect.x - 1);
   369 landRect.h := min(2*Radius, LAND_HEIGHT - landRect.y - 1);
   374 landRect.h := min(2*Radius, LAND_HEIGHT - landRect.y - 1);
   370 UpdateLandTexture(landRect.x, landRect.w, landRect.y, landRect.h, true);        
   375 UpdateLandTexture(landRect.x, landRect.w, landRect.y, landRect.h, true);        
   371 end;
   376 end;
       
   377 
       
   378 
       
   379 procedure DrawIceBreak(x, y, iceRadius, iceHeight: Longint);
       
   380 var
       
   381     i, j: integer;
       
   382     landRect: TSDL_Rect;
       
   383 begin
       
   384 for i := min(max(x - iceRadius, 0), LAND_WIDTH - 1) to min(max(x + iceRadius, 0), LAND_WIDTH - 1) do
       
   385     begin
       
   386     for j := min(max(y, 0), LAND_HEIGHT - 1) to min(max(y + iceHeight, 0), LAND_HEIGHT - 1) do
       
   387         begin
       
   388         if land[j, i] = 0 then
       
   389             begin
       
   390                 land[j, i] := lfIce;                
       
   391                 drawIcePixel(j, i);
       
   392             end;
       
   393         end;        
       
   394     end;
       
   395 landRect.x := min(max(x - iceRadius, 0), LAND_WIDTH - 1);
       
   396 landRect.y := min(max(y, 0), LAND_HEIGHT - 1);
       
   397 landRect.w := min(2*iceRadius, LAND_WIDTH - landRect.x - 1);
       
   398 landRect.h := min(iceHeight, LAND_HEIGHT - landRect.y - 1);
       
   399 UpdateLandTexture(landRect.x, landRect.w, landRect.y, landRect.h, true);        
       
   400 end;
       
   401 
   372 
   402 
   373 
   403 
   374 function FillLandCircleLinesBG(x, y, dx, dy: LongInt): Longword;
   404 function FillLandCircleLinesBG(x, y, dx, dy: LongInt): Longword;
   375 var i, t, by, bx: LongInt;
   405 var i, t, by, bx: LongInt;
   376     cnt: Longword;
   406     cnt: Longword;