hedgewars/uAIMisc.pas
author unc0rr
Mon, 29 Sep 2008 22:14:23 +0000
changeset 1301 c6fe8a4bfd34
parent 1141 44d4d6aaecb5
child 1352 405ad07cf875
permissions -rw-r--r--
Fix a bug screwing team selection up in network game (REMOVETEAM message doesn't have teamID, and after removing the team QMap still contains old info, when add and remove team with the same name, total hedgehogs number will be decreased by first team hh number)

(*
 * Hedgewars, a free turn based strategy game
 * Copyright (c) 2005-2008 Andrey Korotaev <unC0Rr@gmail.com>
 *
 * This program is free software; you can redistribute it and/or modify
 * it under the terms of the GNU General Public License as published by
 * the Free Software Foundation; version 2 of the License
 *
 * This program is distributed in the hope that it will be useful,
 * but WITHOUT ANY WARRANTY; without even the implied warranty of
 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 * GNU General Public License for more details.
 *
 * You should have received a copy of the GNU General Public License
 * along with this program; if not, write to the Free Software
 * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA
 *)

unit uAIMisc;
interface
uses SDLh, uConsts, uGears, uFloat;
{$INCLUDE options.inc}

type TTarget = record
               Point: TPoint;
               Score: LongInt;
               end;
     TTargets = record
                Count: Longword;
                ar: array[0..cMaxHHIndex*5] of TTarget;
                end;
     TJumpType = (jmpNone, jmpHJump, jmpLJump);
     TGoInfo = record
               Ticks: Longword;
               FallPix: Longword;
               JumpType: TJumpType;
               end;

procedure FillTargets;
procedure FillBonuses(isAfterAttack: boolean);
procedure AwareOfExplosion(x, y, r: LongInt);
function RatePlace(Gear: PGear): LongInt;
function TestColl(x, y, r: LongInt): boolean;
function RateExplosion(Me: PGear; x, y, r: LongInt): LongInt;
function RateShove(Me: PGear; x, y, r, power: LongInt): LongInt;
function RateShotgun(Me: PGear; x, y: LongInt): LongInt;
function HHGo(Gear, AltGear: PGear; var GoInfo: TGoInfo): boolean;
function AIrndSign(num: LongInt): LongInt;

var ThinkingHH: PGear;
    Targets: TTargets;

implementation
uses uTeams, uMisc, uLand, uCollisions;
const KillScore = 200;
      MAXBONUS = 1024;
      friendlyfactor: LongInt = 300;

type TBonus = record
              X, Y: LongInt;
              Radius: LongInt;
              Score: LongInt;
              end;
var bonuses: record
             Count: Longword;
             ar: array[0..Pred(MAXBONUS)] of TBonus;
             end;
    KnownExplosion: record
                    X, Y, Radius: LongInt
                    end = (X: 0; Y: 0; Radius: 0);

procedure FillTargets;
var i, t: Longword;
    f, e: Longword;
begin
Targets.Count:= 0;
f:= 0;
e:= 0;
for t:= 0 to Pred(TeamsCount) do
	with TeamsArray[t]^ do
	begin
	for i:= 0 to cMaxHHIndex do
		if (Hedgehogs[i].Gear <> nil)
			and (Hedgehogs[i].Gear <> ThinkingHH) then
			begin
			with Targets.ar[Targets.Count], Hedgehogs[i] do
				begin
				Point.X:= hwRound(Gear^.X);
				Point.Y:= hwRound(Gear^.Y);
				if Clan <> CurrentTeam^.Clan then
					begin
					Score:=  Gear^.Health;
					inc(e)
					end else
					begin
					Score:= -Gear^.Health;
					inc(f)
					end
				end;
			inc(Targets.Count)
			end;
	end;

if e > f then friendlyfactor:= 300 + (e - f) * 30
else friendlyfactor:= max(30, 300 - f * 80 div e)
end;

procedure FillBonuses(isAfterAttack: boolean);
var Gear: PGear;
    MyClan: PClan;

    procedure AddBonus(x, y: LongInt; r: Longword; s: LongInt);
    begin
    bonuses.ar[bonuses.Count].x:= x;
    bonuses.ar[bonuses.Count].y:= y;
    bonuses.ar[bonuses.Count].Radius:= r;
    bonuses.ar[bonuses.Count].Score:= s;
    inc(bonuses.Count);
    TryDo(bonuses.Count <= MAXBONUS, 'Bonuses overflow', true)
    end;

begin
bonuses.Count:= 0;
MyClan:= PHedgehog(ThinkingHH^.Hedgehog)^.Team^.Clan;
Gear:= GearsList;
while Gear <> nil do
      begin
      case Gear^.Kind of
           gtCase: AddBonus(hwRound(Gear^.X), hwRound(Gear^.Y), 33, 25);
           gtMine: if (Gear^.State and gstAttacking) = 0 then AddBonus(hwRound(Gear^.X), hwRound(Gear^.Y), 50, -50)
                                                        else AddBonus(hwRound(Gear^.X), hwRound(Gear^.Y), 100, -50); // mine is on
           gtDynamite: AddBonus(hwRound(Gear^.X), hwRound(Gear^.Y), 150, -75);
           gtHedgehog: begin
                       if Gear^.Damage >= Gear^.Health then AddBonus(hwRound(Gear^.X), hwRound(Gear^.Y), 60, -25) else
                          if isAfterAttack and (ThinkingHH^.Hedgehog <> Gear^.Hedgehog) then
                             if (MyClan = PHedgehog(Gear^.Hedgehog)^.Team^.Clan) then AddBonus(hwRound(Gear^.X), hwRound(Gear^.Y), 150, -3) // hedgehog-friend
                                                                                 else AddBonus(hwRound(Gear^.X), hwRound(Gear^.Y), 100, 3)
                       end;
           end;
      Gear:= Gear^.NextGear
      end;
if isAfterAttack and (KnownExplosion.Radius > 0) then
   with KnownExplosion do
        AddBonus(X, Y, Radius + 10, -Radius);
end;

procedure AwareOfExplosion(x, y, r: LongInt);
begin
KnownExplosion.X:= x;
KnownExplosion.Y:= y;
KnownExplosion.Radius:= r
end;

function RatePlace(Gear: PGear): LongInt;
var i, r: LongInt;
    Result: LongInt;
begin
Result:= 0;
for i:= 0 to Pred(bonuses.Count) do
    with bonuses.ar[i] do
         begin
         r:= hwRound(Distance(Gear^.X - int2hwFloat(X), Gear^.Y - int2hwFloat(Y)));
         if r < Radius then
            inc(Result, Score * (Radius - r))
         end;
    RatePlace:= Result
end;

function TestColl(x, y, r: LongInt): boolean;
var b: boolean;
begin
b:= (((x-r) and $FFFFF800) = 0)and(((y-r) and $FFFFFC00) = 0) and (Land[y-r, x-r] <> 0);
if b then exit(true);
b:=(((x-r) and $FFFFF800) = 0)and(((y+r) and $FFFFFC00) = 0) and (Land[y+r, x-r] <> 0);
if b then exit(true);
b:=(((x+r) and $FFFFF800) = 0)and(((y-r) and $FFFFFC00) = 0) and (Land[y-r, x+r] <> 0);
if b then exit(true);
TestColl:=(((x+r) and $FFFFF800) = 0)and(((y+r) and $FFFFFC00) = 0) and (Land[y+r, x+r] <> 0)
end;

function RateExplosion(Me: PGear; x, y, r: LongInt): LongInt;
var i, dmg, Result: LongInt;
begin
Result:= 0;
// add our virtual position
with Targets.ar[Targets.Count] do
     begin
     Point.x:= hwRound(Me^.X);
     Point.y:= hwRound(Me^.Y);
     Score:= - ThinkingHH^.Health
     end;
// rate explosion
for i:= 0 to Targets.Count do
    with Targets.ar[i] do
         begin
         dmg:= r + cHHRadius div 2 - hwRound(DistanceI(Point.x - x, Point.y - y));
         if dmg > 0 then
            begin
            dmg:= min(dmg div 2, r);
            if dmg >= abs(Score) then
               if Score > 0 then inc(Result, KillScore)
                            else dec(Result, KillScore * friendlyfactor div 100)
            else
               if Score > 0 then inc(Result, dmg)
                            else dec(Result, dmg * friendlyfactor div 100)
            end;
         end;
RateExplosion:= Result * 1024
end;

function RateShove(Me: PGear; x, y, r, power: LongInt): LongInt;
var i, dmg, Result: LongInt;
begin
Result:= 0;
for i:= 0 to Pred(Targets.Count) do
    with Targets.ar[i] do
         begin
         dmg:= r - hwRound(DistanceI(Point.x - x, Point.y - y));
         if dmg > 0 then
            begin
            if power >= abs(Score) then
               if Score > 0 then inc(Result, KillScore)
                            else dec(Result, KillScore * friendlyfactor div 100)
            else
               if Score > 0 then inc(Result, power)
                            else dec(Result, power * friendlyfactor div 100)
            end;
         end;
RateShove:= Result * 1024
end;

function RateShotgun(Me: PGear; x, y: LongInt): LongInt;
var i, dmg, Result: LongInt;
begin
Result:= 0;
// add our virtual position
with Targets.ar[Targets.Count] do
     begin
     Point.x:= hwRound(Me^.X);
     Point.y:= hwRound(Me^.Y);
     Score:= - ThinkingHH^.Health
     end;
// rate shot
for i:= 0 to Targets.Count do
    with Targets.ar[i] do
         begin
         dmg:= min(cHHRadius + cShotgunRadius - hwRound(DistanceI(Point.x - x, Point.y - y)), 25);
         if dmg > 0 then
            begin
            if dmg >= abs(Score) then
               if Score > 0 then inc(Result, KillScore)
                            else dec(Result, KillScore * friendlyfactor div 100)
            else
               if Score > 0 then inc(Result, dmg)
                            else dec(Result, dmg * friendlyfactor div 100)
            end;
         end;
RateShotgun:= Result * 1024
end;

function HHJump(Gear: PGear; JumpType: TJumpType; var GoInfo: TGoInfo): boolean;
var bX, bY: LongInt;
    Result: boolean;
begin
Result:= false;
GoInfo.Ticks:= 0;
GoInfo.FallPix:= 0;
GoInfo.JumpType:= jmpNone;
bX:= hwRound(Gear^.X);
bY:= hwRound(Gear^.Y);
case JumpType of
     jmpNone: exit(Result);
    jmpHJump: if not TestCollisionYwithGear(Gear, -1) then
                 begin
                 Gear^.dY:= -_0_2;
                 SetLittle(Gear^.dX);
                 Gear^.State:= Gear^.State or gstMoving or gstHHJumping;
                 end else exit(Result);
    jmpLJump: begin
              if not TestCollisionYwithGear(Gear, -1) then
                 if not TestCollisionXwithXYShift(Gear, _0, -2, hwSign(Gear^.dX)) then Gear^.Y:= Gear^.Y - int2hwFloat(2) else
                 if not TestCollisionXwithXYShift(Gear, _0, -1, hwSign(Gear^.dX)) then Gear^.Y:= Gear^.Y - _1;
              if not (TestCollisionXwithGear(Gear, hwSign(Gear^.dX))
                 or   TestCollisionYwithGear(Gear, -1)) then
                 begin
                 Gear^.dY:= -_0_15;
                 Gear^.dX:= SignAs(_0_15, Gear^.dX);
                 Gear^.State:= Gear^.State or gstMoving or gstHHJumping
                 end else exit(Result)
              end
    end;
    
repeat
if not (hwRound(Gear^.Y) + cHHRadius < cWaterLine) then exit(Result);
if (Gear^.State and gstMoving) <> 0 then
   begin
   if (GoInfo.Ticks = 350) then
      if (not (hwAbs(Gear^.dX) > cLittle)) and (Gear^.dY < -_0_02) then
         begin
         Gear^.dY:= -_0_25;
         Gear^.dX:= SignAs(_0_02, Gear^.dX)
         end;
   if TestCollisionXwithGear(Gear, hwSign(Gear^.dX)) then SetLittle(Gear^.dX);
   Gear^.X:= Gear^.X + Gear^.dX;
   inc(GoInfo.Ticks);
   Gear^.dY:= Gear^.dY + cGravity;
   if Gear^.dY > _0_4 then exit(Result);
   if (Gear^.dY.isNegative)and TestCollisionYwithGear(Gear, -1) then Gear^.dY:= _0;
   Gear^.Y:= Gear^.Y + Gear^.dY;
   if (not Gear^.dY.isNegative)and TestCollisionYwithGear(Gear, 1) then
      begin
      Gear^.State:= Gear^.State and not (gstMoving or gstHHJumping);
      Gear^.dY:= _0;
      case JumpType of
           jmpHJump: if bY - hwRound(Gear^.Y) > 5 then
                        begin
                        Result:= true;
                        GoInfo.JumpType:= jmpHJump;
                        inc(GoInfo.Ticks, 300 + 300) // 300 before jump, 300 after
                        end;
           jmpLJump: if abs(bX - hwRound(Gear^.X)) > 30 then
                        begin
                        Result:= true;
                        GoInfo.JumpType:= jmpLJump;
                        inc(GoInfo.Ticks, 300 + 300) // 300 before jump, 300 after
                        end;
           end;
      exit(Result)
      end;
   end;
until false
end;

function HHGo(Gear, AltGear: PGear; var GoInfo: TGoInfo): boolean;
var pX, pY: LongInt;
    Result: boolean;
begin
Result:= false;
AltGear^:= Gear^;

GoInfo.Ticks:= 0;
GoInfo.FallPix:= 0;
GoInfo.JumpType:= jmpNone;
repeat
pX:= hwRound(Gear^.X);
pY:= hwRound(Gear^.Y);
if pY + cHHRadius >= cWaterLine then exit(false);
if (Gear^.State and gstMoving) <> 0 then
   begin
   inc(GoInfo.Ticks);
   Gear^.dY:= Gear^.dY + cGravity;
   if Gear^.dY > _0_4 then
      begin
      Goinfo.FallPix:= 0;
      HHJump(AltGear, jmpLJump, GoInfo); // try ljump instead of fall with damage
      exit(Result)
      end;
   Gear^.Y:= Gear^.Y + Gear^.dY;
   if hwRound(Gear^.Y) > pY then inc(GoInfo.FallPix);
   if TestCollisionYwithGear(Gear, 1) then
      begin
      inc(GoInfo.Ticks, 300);
      Gear^.State:= Gear^.State and not (gstMoving or gstHHJumping);
      Gear^.dY:= _0;
      Result:= true;
      HHJump(AltGear, jmpLJump, GoInfo); // try ljump instead of fall
      exit(Result)
      end;
   continue
   end;
   if (Gear^.Message and gm_Left  )<>0 then Gear^.dX:= -cLittle else
   if (Gear^.Message and gm_Right )<>0 then Gear^.dX:=  cLittle else exit(Result);
   if TestCollisionXwithGear(Gear, hwSign(Gear^.dX)) then
      begin
      if not (TestCollisionXwithXYShift(Gear, _0, -6, hwSign(Gear^.dX))
         or TestCollisionYwithGear(Gear, -1)) then Gear^.Y:= Gear^.Y - _1;
      if not (TestCollisionXwithXYShift(Gear, _0, -5, hwSign(Gear^.dX))
         or TestCollisionYwithGear(Gear, -1)) then Gear^.Y:= Gear^.Y - _1;
      if not (TestCollisionXwithXYShift(Gear, _0, -4, hwSign(Gear^.dX))
         or TestCollisionYwithGear(Gear, -1)) then Gear^.Y:= Gear^.Y - _1;
      if not (TestCollisionXwithXYShift(Gear, _0, -3, hwSign(Gear^.dX))
         or TestCollisionYwithGear(Gear, -1)) then Gear^.Y:= Gear^.Y - _1;
      if not (TestCollisionXwithXYShift(Gear, _0, -2, hwSign(Gear^.dX))
         or TestCollisionYwithGear(Gear, -1)) then Gear^.Y:= Gear^.Y - _1;
      if not (TestCollisionXwithXYShift(Gear, _0, -1, hwSign(Gear^.dX))
         or TestCollisionYwithGear(Gear, -1)) then Gear^.Y:= Gear^.Y - _1;
      end;

   if not TestCollisionXwithGear(Gear, hwSign(Gear^.dX)) then
      begin
      Gear^.X:= Gear^.X + int2hwFloat(hwSign(Gear^.dX));
      inc(GoInfo.Ticks, cHHStepTicks)
      end;
   if not TestCollisionYwithGear(Gear, 1) then
   begin
   Gear^.Y:= Gear^.Y + _1;
   if not TestCollisionYwithGear(Gear, 1) then
   begin
   Gear^.Y:= Gear^.Y + _1;
   if not TestCollisionYwithGear(Gear, 1) then
   begin
   Gear^.Y:= Gear^.Y + _1;
   if not TestCollisionYwithGear(Gear, 1) then
   begin
   Gear^.Y:= Gear^.Y + _1;
   if not TestCollisionYwithGear(Gear, 1) then
   begin
   Gear^.Y:= Gear^.Y + _1;
   if not TestCollisionYwithGear(Gear, 1) then
   begin
   Gear^.Y:= Gear^.Y + _1;
   if not TestCollisionYwithGear(Gear, 1) then
      begin
      Gear^.Y:= Gear^.Y - _6;
      Gear^.dY:= _0;
      Gear^.State:= Gear^.State or gstMoving
      end
   end
   end
   end
   end
   end
   end;
if (pX <> hwRound(Gear^.X)) and ((Gear^.State and gstMoving) = 0) then
   exit(true);
until (pX = hwRound(Gear^.X)) and (pY = hwRound(Gear^.Y)) and ((Gear^.State and gstMoving) = 0);
HHJump(AltGear, jmpHJump, GoInfo);
HHGo:= Result
end;

function AIrndSign(num: LongInt): LongInt;
begin
if random(2) = 0 then AIrndSign:=   num
                 else AIrndSign:= - num
end;  

end.