hedgewars/uGearsUtils.pas
changeset 6888 32a54322d262
parent 6804 06bedc419d04
child 6986 409dd3851309
equal deleted inserted replaced
6887:19d77932ea91 6888:32a54322d262
    30 procedure CheckHHDamage(Gear: PGear);
    30 procedure CheckHHDamage(Gear: PGear);
    31 procedure CalcRotationDirAngle(Gear: PGear);
    31 procedure CalcRotationDirAngle(Gear: PGear);
    32 procedure ResurrectHedgehog(gear: PGear);
    32 procedure ResurrectHedgehog(gear: PGear);
    33 procedure FindPlace(var Gear: PGear; withFall: boolean; Left, Right: LongInt; skipProximity: boolean = false);
    33 procedure FindPlace(var Gear: PGear; withFall: boolean; Left, Right: LongInt; skipProximity: boolean = false);
    34 function  CheckGearNear(Gear: PGear; Kind: TGearType; rX, rY: LongInt): PGear;
    34 function  CheckGearNear(Gear: PGear; Kind: TGearType; rX, rY: LongInt): PGear;
    35 function  CheckGearsNear(mX, mY: LongInt; Kind: TGearsType; rX, rY: LongInt): PGear;
       
    36 function  CheckGearDrowning(Gear: PGear): boolean;
    35 function  CheckGearDrowning(Gear: PGear): boolean;
    37 
    36 
    38 var doStepHandlers: array[TGearType] of TGearStepProcedure;
    37 var doStepHandlers: array[TGearType] of TGearStepProcedure;
    39 
    38 
    40 
    39 
   473                 exit(count)
   472                 exit(count)
   474             end;
   473             end;
   475 CountNonZeroz:= count;
   474 CountNonZeroz:= count;
   476 end;
   475 end;
   477 
   476 
       
   477 
       
   478 function NoGearsToAvoid(mX, mY: LongInt; rX, rY: LongInt): boolean;
       
   479 var t: PGear;
       
   480 begin
       
   481 t:= GearsList;
       
   482 rX:= sqr(rX);
       
   483 rY:= sqr(rY);
       
   484 while t <> nil do
       
   485     begin
       
   486     if t^.Kind <= gtExplosives then
       
   487         if not (hwSqr(int2hwFloat(mX) - t^.X) / rX + hwSqr(int2hwFloat(mY) - t^.Y) / rY > _1) then
       
   488             exit(false);
       
   489     t:= t^.NextGear
       
   490     end;
       
   491 NoGearsToAvoid:= true
       
   492 end;
       
   493 
       
   494 
   478 procedure FindPlace(var Gear: PGear; withFall: boolean; Left, Right: LongInt; skipProximity: boolean);
   495 procedure FindPlace(var Gear: PGear; withFall: boolean; Left, Right: LongInt; skipProximity: boolean);
   479 var x: LongInt;
   496 var x: LongInt;
   480     y, sy: LongInt;
   497     y, sy: LongInt;
   481     ar: array[0..511] of TPoint;
   498     ar: array[0..511] of TPoint;
   482     ar2: array[0..1023] of TPoint;
   499     ar2: array[0..1023] of TPoint;
   509                 until (y >= cWaterLine) or (CountNonZeroz(x, y, Gear^.Radius - 1, 1) <> 0);
   526                 until (y >= cWaterLine) or (CountNonZeroz(x, y, Gear^.Radius - 1, 1) <> 0);
   510 
   527 
   511                 if (y - sy > Gear^.Radius * 2)
   528                 if (y - sy > Gear^.Radius * 2)
   512                     and (((Gear^.Kind = gtExplosives)
   529                     and (((Gear^.Kind = gtExplosives)
   513                     and (y < cWaterLine)
   530                     and (y < cWaterLine)
   514                     and (reallySkip or (CheckGearsNear(x, y - Gear^.Radius, [gtFlame, gtHedgehog, gtMine, gtCase, gtExplosives], 60, 60) = nil))
   531                     and (reallySkip or NoGearsToAvoid(x, y - Gear^.Radius, 60, 60))
   515                     and (CountNonZeroz(x, y+1, Gear^.Radius - 1, Gear^.Radius+1) > Gear^.Radius))
   532                     and (CountNonZeroz(x, y+1, Gear^.Radius - 1, Gear^.Radius+1) > Gear^.Radius))
   516                 or
   533                 or
   517                     ((Gear^.Kind <> gtExplosives)
   534                     ((Gear^.Kind <> gtExplosives)
   518                     and (y < cWaterLine)
   535                     and (y < cWaterLine)
   519                     and (reallySkip or (CheckGearsNear(x, y - Gear^.Radius, [gtFlame, gtHedgehog, gtMine, gtCase, gtExplosives], 110, 110) = nil)))) then
   536                     and (reallySkip or NoGearsToAvoid(x, y - Gear^.Radius, 110, 110))
   520                  
   537                     )) then
   521                           begin
   538                     begin
   522                     ar[cnt].X:= x;
   539                     ar[cnt].X:= x;
   523                     if withFall then
   540                     if withFall then
   524                         ar[cnt].Y:= sy + Gear^.Radius
   541                         ar[cnt].Y:= sy + Gear^.Radius
   525                     else
   542                     else
   526                         ar[cnt].Y:= y - Gear^.Radius;
   543                         ar[cnt].Y:= y - Gear^.Radius;
   580     end;
   597     end;
   581 
   598 
   582 CheckGearNear:= nil
   599 CheckGearNear:= nil
   583 end;
   600 end;
   584 
   601 
   585 
       
   586 function CheckGearsNear(mX, mY: LongInt; Kind: TGearsType; rX, rY: LongInt): PGear;
       
   587 var t: PGear;
       
   588 begin
       
   589 t:= GearsList;
       
   590 rX:= sqr(rX);
       
   591 rY:= sqr(rY);
       
   592 while t <> nil do
       
   593     begin
       
   594     if t^.Kind in Kind then
       
   595         if not (hwSqr(int2hwFloat(mX) - t^.X) / rX + hwSqr(int2hwFloat(mY) - t^.Y) / rY > _1) then
       
   596             exit(t);
       
   597     t:= t^.NextGear
       
   598     end;
       
   599 CheckGearsNear:= nil
       
   600 end;
       
   601 end.
   602 end.