hedgewars/uGearsUtils.pas
changeset 15986 7125918637e9
parent 15926 7f3d7f015aa5
child 16004 2146cb7be36f
equal deleted inserted replaced
15985:a4630009e733 15986:7125918637e9
    40 procedure ResurrectHedgehog(var gear: PGear);
    40 procedure ResurrectHedgehog(var gear: PGear);
    41 
    41 
    42 procedure FindPlace(var Gear: PGear; withFall: boolean; Left, Right: LongInt); inline;
    42 procedure FindPlace(var Gear: PGear; withFall: boolean; Left, Right: LongInt); inline;
    43 procedure FindPlace(var Gear: PGear; withFall: boolean; Left, Right: LongInt; skipProximity: boolean);
    43 procedure FindPlace(var Gear: PGear; withFall: boolean; Left, Right: LongInt; skipProximity: boolean);
    44 procedure FindPlace(var Gear: PGear; withFall: boolean; Left, Right: LongInt; skipProximity, deleteOnFail: boolean);
    44 procedure FindPlace(var Gear: PGear; withFall: boolean; Left, Right: LongInt; skipProximity, deleteOnFail: boolean);
       
    45 procedure FindPlace(var Gear: PGear; withFall: boolean; Left, Right, Bottom: LongInt; skipProximity, deleteOnFail: boolean);
    45 function CountLand(x, y, r, c: LongInt; mask, antimask: LongWord): LongInt;
    46 function CountLand(x, y, r, c: LongInt; mask, antimask: LongWord): LongInt;
    46 
    47 
    47 function  CheckGearNear(Kind: TGearType; X, Y: hwFloat; rX, rY: LongInt): PGear;
    48 function  CheckGearNear(Kind: TGearType; X, Y: hwFloat; rX, rY: LongInt): PGear;
    48 function  CheckGearNear(Gear: PGear; Kind: TGearType; rX, rY: LongInt): PGear;
    49 function  CheckGearNear(Gear: PGear; Kind: TGearType; rX, rY: LongInt): PGear;
    49 function  CheckGearDrowning(var Gear: PGear): boolean;
    50 function  CheckGearDrowning(var Gear: PGear): boolean;
   932 procedure FindPlace(var Gear: PGear; withFall: boolean; Left, Right: LongInt; skipProximity: boolean); inline;
   933 procedure FindPlace(var Gear: PGear; withFall: boolean; Left, Right: LongInt; skipProximity: boolean); inline;
   933 begin
   934 begin
   934     FindPlace(Gear, withFall, Left, Right, skipProximity, true);
   935     FindPlace(Gear, withFall, Left, Right, skipProximity, true);
   935 end;
   936 end;
   936 
   937 
   937 procedure FindPlace(var Gear: PGear; withFall: boolean; Left, Right: LongInt; skipProximity, deleteOnFail: boolean);
   938 procedure FindPlace(var Gear: PGear; withFall: boolean; Left, Right: LongInt; skipProximity, deleteOnFail: boolean); inline;
       
   939 begin
       
   940     FindPlace(Gear, withFall, Left, Right, cWaterLine, skipProximity, deleteOnFail);
       
   941 end;
       
   942 
       
   943 procedure FindPlace(var Gear: PGear; withFall: boolean; Left, Right, Bottom: LongInt; skipProximity, deleteOnFail: boolean);
   938 var x: LongInt;
   944 var x: LongInt;
   939     y, sy, dir: LongInt;
   945     y, sy, dir: LongInt;
   940     ar: array[0..1023] of TPoint;
   946     ar: array[0..1023] of TPoint;
   941     ar2: array[0..2047] of TPoint;
   947     ar2: array[0..2047] of TPoint;
   942     temp: TPoint;
   948     temp: TPoint;
   961         x:= max(LAND_WIDTH div 2048, LongInt(GetRandom(Delta)));
   967         x:= max(LAND_WIDTH div 2048, LongInt(GetRandom(Delta)));
   962         if dir = 1 then x:= Left + x else x:= Right - x; 
   968         if dir = 1 then x:= Left + x else x:= Right - x; 
   963         repeat
   969         repeat
   964             cnt:= 0;
   970             cnt:= 0;
   965             y:= min(1024, topY) - Gear^.Radius shl 1;
   971             y:= min(1024, topY) - Gear^.Radius shl 1;
   966             while y < cWaterLine do
   972             while y < Bottom do
   967                 begin
   973                 begin
   968                 repeat
   974                 repeat
   969                     inc(y, 2);
   975                     inc(y, 2);
   970                 until (y >= cWaterLine) or
   976                 until (y >= Bottom) or
   971                     (ignoreOverLap and (CountLand(x, y, Gear^.Radius - 1, 1, lfLandMask, 0) = 0)) or
   977                     (ignoreOverLap and (CountLand(x, y, Gear^.Radius - 1, 1, lfLandMask, 0) = 0)) or
   972                     (not ignoreOverLap and (CountLand(x, y, Gear^.Radius - 1, 1, lfAll, 0) = 0));
   978                     (not ignoreOverLap and (CountLand(x, y, Gear^.Radius - 1, 1, lfAll, 0) = 0));
   973 
   979 
   974                 sy:= y;
   980                 sy:= y;
   975 
   981 
   976                 repeat
   982                 repeat
   977                     inc(y);
   983                     inc(y);
   978                 until (y >= cWaterLine) or
   984                 until (y >= Bottom) or
   979                         (ignoreOverlap and 
   985                         (ignoreOverlap and 
   980                                 (CountLand(x, y, Gear^.Radius - 1, 1, lfAll, 0) <> 0)) or
   986                                 (CountLand(x, y, Gear^.Radius - 1, 1, lfAll, 0) <> 0)) or
   981                         (not ignoreOverlap and 
   987                         (not ignoreOverlap and 
   982                             (CountLand(x, y, Gear^.Radius - 1, 1, lfLandMask, 0) <> 0));
   988                             (CountLand(x, y, Gear^.Radius - 1, 1, lfLandMask, 0) <> 0));
   983 
   989 
   984                 if (y - sy > Gear^.Radius * 2) and (y < cWaterLine)
   990                 if (y - sy > Gear^.Radius * 2) and (y < Bottom)
   985                     and (((Gear^.Kind = gtExplosives)
   991                     and (((Gear^.Kind = gtExplosives)
   986                         and (ignoreNearObjects or NoGearsToAvoid(x, y - Gear^.Radius, 60, 60))
   992                         and (ignoreNearObjects or NoGearsToAvoid(x, y - Gear^.Radius, 60, 60))
   987                         and (isSteadyPosition(x, y+1, Gear^.Radius - 1, 3, lfAll)
   993                         and (isSteadyPosition(x, y+1, Gear^.Radius - 1, 3, lfAll)
   988                          or (CountLand(x, y+1, Gear^.Radius - 1, Gear^.Radius+1, lfAll, 0) > Gear^.Radius)
   994                          or (CountLand(x, y+1, Gear^.Radius - 1, Gear^.Radius+1, lfAll, 0) > Gear^.Radius)
   989                             ))
   995                             ))