hedgewars/uGearsUtils.pas
changeset 15741 8997e212be4c
parent 15740 0a172cfe8840
child 15753 72f735c03fec
equal deleted inserted replaced
15740:0a172cfe8840 15741:8997e212be4c
    39 procedure CalcRotationDirAngle(Gear: PGear);
    39 procedure CalcRotationDirAngle(Gear: PGear);
    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 function CountLand(x, y, r, c: LongInt; mask, antimask: LongWord): LongInt;
    45 function CountLand(x, y, r, c: LongInt; mask, antimask: LongWord): LongInt;
    45 
    46 
    46 function  CheckGearNear(Kind: TGearType; X, Y: hwFloat; rX, rY: LongInt): PGear;
    47 function  CheckGearNear(Kind: TGearType; X, Y: hwFloat; rX, rY: LongInt): PGear;
    47 function  CheckGearNear(Gear: PGear; Kind: TGearType; rX, rY: LongInt): PGear;
    48 function  CheckGearNear(Gear: PGear; Kind: TGearType; rX, rY: LongInt): PGear;
    48 function  CheckGearDrowning(var Gear: PGear): boolean;
    49 function  CheckGearDrowning(var Gear: PGear): boolean;
   921 NoGearsToAvoid:= true
   922 NoGearsToAvoid:= true
   922 end;
   923 end;
   923 
   924 
   924 procedure FindPlace(var Gear: PGear; withFall: boolean; Left, Right: LongInt); inline;
   925 procedure FindPlace(var Gear: PGear; withFall: boolean; Left, Right: LongInt); inline;
   925 begin
   926 begin
   926     FindPlace(Gear, withFall, Left, Right, false);
   927     FindPlace(Gear, withFall, Left, Right, false, true);
   927 end;
   928 end;
   928 
   929 
   929 procedure FindPlace(var Gear: PGear; withFall: boolean; Left, Right: LongInt; skipProximity: boolean);
   930 procedure FindPlace(var Gear: PGear; withFall: boolean; Left, Right: LongInt; skipProximity: boolean); inline;
       
   931 begin
       
   932     FindPlace(Gear, withFall, Left, Right, skipProximity, true);
       
   933 end;
       
   934 
       
   935 procedure FindPlace(var Gear: PGear; withFall: boolean; Left, Right: LongInt; skipProximity, deleteOnFail: boolean);
   930 var x: LongInt;
   936 var x: LongInt;
   931     y, sy, dir: LongInt;
   937     y, sy, dir: LongInt;
   932     ar: array[0..1023] of TPoint;
   938     ar: array[0..1023] of TPoint;
   933     ar2: array[0..2047] of TPoint;
   939     ar2: array[0..2047] of TPoint;
   934     temp: TPoint;
   940     temp: TPoint;
  1025     temp := ar2[GetRandom(cnt2)];
  1031     temp := ar2[GetRandom(cnt2)];
  1026     with temp do
  1032     with temp do
  1027         begin
  1033         begin
  1028         Gear^.X:= int2hwFloat(x);
  1034         Gear^.X:= int2hwFloat(x);
  1029         Gear^.Y:= int2hwFloat(y);
  1035         Gear^.Y:= int2hwFloat(y);
  1030         AddFileLog('Assigned Gear coordinates (' + inttostr(x) + ',' + inttostr(y) + ')');
  1036         AddFileLog('FindPlace: Assigned Gear coordinates (' + inttostr(x) + ',' + inttostr(y) + ')');
  1031         end
  1037         end
  1032     end
  1038     end
  1033 else
  1039 else
  1034     begin
  1040     begin
  1035     OutError('Can''t find place for Gear', false);
  1041     OutError('FindPlace: Can''t find place for Gear', false);
  1036     if Gear^.Kind = gtHedgehog then
  1042     if Gear^.Kind = gtHedgehog then
  1037         begin
  1043         begin
  1038         cnt:= 0;
  1044         cnt:= 0;
  1039         if GameTicks = 0 then
  1045         if GameTicks = 0 then
  1040             begin
  1046             begin
  1041             //AddFileLog('Trying to make a hole');
       
  1042             while (cnt < 1000) do
  1047             while (cnt < 1000) do
  1043                 begin
  1048                 begin
  1044                 inc(cnt);
  1049                 inc(cnt);
  1045                 x:= left+GetRandom(right-left-2*cHHRadius)+cHHRadius;
  1050                 x:= left+GetRandom(right-left-2*cHHRadius)+cHHRadius;
  1046                 y:= topY+GetRandom(LAND_HEIGHT-topY-64)+48;
  1051                 y:= topY+GetRandom(LAND_HEIGHT-topY-64)+48;
  1047                 if NoGearsToAvoid(x, y, 100 div max(1,cnt div 100), 100 div max(1,cnt div 100)) then
  1052                 if NoGearsToAvoid(x, y, 100 div max(1,cnt div 100), 100 div max(1,cnt div 100)) then
  1048                     begin
  1053                     begin
  1049                     Gear^.State:= Gear^.State or gsttmpFlag;
  1054                     Gear^.State:= Gear^.State or gsttmpFlag;
  1050                     Gear^.X:= int2hwFloat(x);
  1055                     Gear^.X:= int2hwFloat(x);
  1051                     Gear^.Y:= int2hwFloat(y);
  1056                     Gear^.Y:= int2hwFloat(y);
  1052                     AddFileLog('Picked a spot for hog at coordinates (' + inttostr(hwRound(Gear^.X)) + ',' + inttostr(hwRound(Gear^.Y)) + ')');
  1057                     AddFileLog('FindPlace: Picked alternative spot for hog at coordinates (' + inttostr(hwRound(Gear^.X)) + ',' + inttostr(hwRound(Gear^.Y)) + ')');
  1053                     cnt:= 2000
  1058                     cnt:= 2000
  1054                     end
  1059                     end
  1055                 end;
  1060                 end;
  1056             end;
  1061             end;
  1057         if cnt < 2000 then
  1062         if (deleteOnFail) and (cnt < 2000) then
  1058             begin
  1063             begin
       
  1064             AddFileLog('FindPlace: No place found, deleting hog');
  1059             Gear^.Hedgehog^.Effects[heResurrectable] := 0;
  1065             Gear^.Hedgehog^.Effects[heResurrectable] := 0;
  1060             DeleteGear(Gear);
  1066             DeleteGear(Gear);
  1061             Gear:= nil
  1067             Gear:= nil
  1062             end
  1068             end
  1063         end
  1069         end
  1064     else
  1070     else if (deleteOnFail) then
  1065         begin
  1071         begin
       
  1072         AddFileLog('FindPlace: No place found, deleting Gear');
  1066         DeleteGear(Gear);
  1073         DeleteGear(Gear);
  1067         Gear:= nil
  1074         Gear:= nil
  1068         end
  1075         end
  1069     end
  1076     end
  1070 end;
  1077 end;