--- a/hedgewars/SDLh.pas Tue Jun 20 20:08:17 2006 +0000
+++ b/hedgewars/SDLh.pas Tue Jun 20 21:18:49 2006 +0000
@@ -196,6 +196,8 @@
PByteArray = ^TByteArray;
TByteArray = array[0..32767] of Byte;
+ PSDL_Thread = Pointer;
+
function SDL_Init(flags: Longword): Integer; cdecl; external SDLLibName;
procedure SDL_Quit; cdecl; external SDLLibName;
@@ -239,6 +241,9 @@
procedure SDL_WM_SetCaption(title: PChar; icon: PChar); cdecl; external SDLLibName;
+function SDL_CreateThread(fn: pointer; data: pointer): PSDL_Thread; cdecl; external SDLLibName;
+procedure SDL_WaitThread(thread: PSDL_Thread; status: PInteger); cdecl; external SDLLibName;
+
(* TTF *)
const {$IFDEF WIN32}
--- a/hedgewars/uAI.pas Tue Jun 20 20:08:17 2006 +0000
+++ b/hedgewars/uAI.pas Tue Jun 20 21:18:49 2006 +0000
@@ -40,75 +40,139 @@
implementation
uses uTeams, uConsts, SDLh, uAIMisc, uGears, uAIAmmoTests, uAIActions, uMisc;
-var Targets: TTargets;
- Actions, BestActions: TActions;
+var BestActions: TActions;
+ ThinkThread: PSDL_Thread = nil;
+ StopThinking: boolean;
procedure FreeActionsList;
begin
+if ThinkThread <> nil then
+ begin
+ StopThinking:= true;
+ SDL_WaitThread(ThinkThread, nil);
+ ThinkThread:= nil
+ end;
BestActions.Count:= 0;
-BestActions.Pos:= 0;
+BestActions.Pos:= 0
end;
-procedure TestAmmos(Me: PGear);
-var MyPoint: TPoint;
- Time: Longword;
+procedure TestAmmos(var Actions: TActions; Me: PGear);
+var Time: Longword;
Angle, Power, Score: integer;
i: integer;
+ a, aa: TAmmoType;
begin
-Mypoint.x:= round(Me.X);
-Mypoint.y:= round(Me.Y);
for i:= 0 to Pred(Targets.Count) do
- begin
- Score:= TestBazooka(MyPoint, Targets.ar[i].Point, Time, Angle, Power);
- if Actions.Score + Score + Targets.ar[i].Score > BestActions.Score then
- begin
- BestActions:= Actions;
- inc(BestActions.Score, Score + Targets.ar[i].Score);
- AddAction(BestActions, aia_Weapon, Longword(amBazooka), 500);
- if (Angle > 0) then AddAction(BestActions, aia_LookRight, 0, 200)
- else if (Angle < 0) then AddAction(BestActions, aia_LookLeft, 0, 200);
- Angle:= integer(Me.Angle) - Abs(Angle);
- if Angle > 0 then
- begin
- AddAction(BestActions, aia_Up, aim_push, 500);
- AddAction(BestActions, aia_Up, aim_release, Angle)
- end else if Angle < 0 then
- begin
- AddAction(BestActions, aia_Down, aim_push, 500);
- AddAction(BestActions, aia_Down, aim_release, -Angle)
- end;
- AddAction(BestActions, aia_attack, aim_push, 300);
- AddAction(BestActions, aia_attack, aim_release, Power);
- end
- end
+ if Targets.ar[i].Score >= 0 then
+ begin
+ a:= Low(TAmmoType);
+ aa:= a;
+ repeat
+ if Assigned(AmmoTests[a]) then
+ begin
+ Score:= AmmoTests[a](Me, Targets.ar[i].Point, Time, Angle, Power);
+ if Actions.Score + Score + Targets.ar[i].Score > BestActions.Score then
+ begin
+ BestActions:= Actions;
+ inc(BestActions.Score, Score + Targets.ar[i].Score);
+ AddAction(BestActions, aia_Weapon, Longword(a), 500);
+ if Time <> 0 then AddAction(BestActions, aia_Timer, Time div 1000, 400);
+ if (Angle > 0) then AddAction(BestActions, aia_LookRight, 0, 200)
+ else if (Angle < 0) then AddAction(BestActions, aia_LookLeft, 0, 200);
+ Angle:= integer(Me.Angle) - Abs(Angle);
+ if Angle > 0 then
+ begin
+ AddAction(BestActions, aia_Up, aim_push, 500);
+ AddAction(BestActions, aia_Up, aim_release, Angle)
+ end else if Angle < 0 then
+ begin
+ AddAction(BestActions, aia_Down, aim_push, 500);
+ AddAction(BestActions, aia_Down, aim_release, -Angle)
+ end;
+ AddAction(BestActions, aia_attack, aim_push, 300);
+ AddAction(BestActions, aia_attack, aim_release, Power);
+ end
+ end;
+ if a = High(TAmmoType) then a:= Low(TAmmoType)
+ else inc(a)
+ until isInMultiShoot or (a = aa) or (CurrentTeam.Hedgehogs[CurrentTeam.CurrHedgehog].AttacksNum > 0)
+ end
end;
procedure Walk(Me: PGear);
+var Actions: TActions;
+ BackMe: TGear;
+ Dir, t, avoidt, steps: integer;
begin
-TestAmmos(Me)
-end;
-
-procedure Think(Me: PGear);
-begin
-FillTargets(Targets);
Actions.Score:= 0;
Actions.Count:= 0;
Actions.Pos:= 0;
+BackMe:= Me^;
+if (Me.State and gstAttacked) = 0 then TestAmmos(Actions, Me);
+avoidt:= CheckBonuses(Me);
+for Dir:= aia_Left to aia_Right do
+ begin
+ Me.Message:= Dir;
+ steps:= 0;
+ while HHGo(Me) do
+ begin
+ inc(steps);
+ Actions.Count:= 0;
+ AddAction(Actions, Dir, aim_push, 50);
+ AddAction(Actions, aia_WaitX, round(Me.X), 0);
+ AddAction(Actions, Dir, aim_release, 0);
+ t:= CheckBonuses(Me);
+ if t < avoidt then break
+ else if (t > 0) or (t > avoidt) then
+ begin
+ BestActions:= Actions;
+ exit
+ end;
+ if ((Me.State and gstAttacked) = 0)
+ and ((steps mod 4) = 0) then TestAmmos(Actions, Me);
+ if StopThinking then exit;
+ end;
+ Me^:= BackMe
+ end
+end;
+
+procedure Think(Me: PGear); cdecl;
+var BackMe: TGear;
+ StartTicks: Longword;
+begin
+{$IFDEF DEBUGFILE}AddFileLog('Enter Think Thread');{$ENDIF}
+StartTicks:= GameTicks;
+ThinkingHH:= Me;
+FillTargets;
+FillBonuses;
BestActions.Score:= Low(integer);
if Targets.Count > 0 then
- Walk(Me)
+ begin
+ BackMe:= Me^;
+ Walk(@BackMe);
+ end;
+if StartTicks > GameTicks - 1000 then SDL_Delay(500);
+Me.State:= Me.State and not gstHHThinking;
+{$IFDEF DEBUGFILE}AddFileLog('Exit Think Thread');{$ENDIF}
+ThinkThread:= nil
+end;
+
+procedure StartThink(Me: PGear);
+begin
+Me.State:= Me.State or gstHHThinking;
+StopThinking:= false;
+ThinkThread:= SDL_CreateThread(@Think, Me)
end;
procedure ProcessBot;
-var Me: PGear;
begin
with CurrentTeam.Hedgehogs[CurrentTeam.CurrHedgehog] do
- if (Gear <> nil)and((Gear.State and gstHHDriven) <> 0) and (TurnTimeLeft < 29990) then
- begin
- Me:= CurrentTeam.Hedgehogs[CurrentTeam.CurrHedgehog].Gear;
- if BestActions.Count = BestActions.Pos then Think(Me);
- ProcessAction(BestActions, Me)
- end
+ if (Gear <> nil)
+ and ((Gear.State and gstHHDriven) <> 0)
+ and (TurnTimeLeft < 29990)
+ and ((Gear.State and gstHHThinking) = 0) then
+ if (BestActions.Pos = BestActions.Count) then StartThink(Gear)
+ else ProcessAction(BestActions, Gear)
end;
end.
--- a/hedgewars/uAIActions.pas Tue Jun 20 20:08:17 2006 +0000
+++ b/hedgewars/uAIActions.pas Tue Jun 20 21:18:49 2006 +0000
@@ -54,7 +54,7 @@
begin
actions[Count].Action:= Action;
actions[Count].Param:= Param;
- if Count > 0 then actions[Count].Time:= actions[Pred(Count)].Time + TimeDelta
+ if Count > 0 then actions[Count].Time:= TimeDelta
else actions[Count].Time:= GameTicks + TimeDelta;
inc(Count);
TryDo(Count < MAXACTIONS, 'AI: actions overflow', true);
@@ -105,7 +105,9 @@
ParseCommand(s)
end
end;
-inc(Actions.Pos)
+inc(Actions.Pos);
+if Actions.Pos <= Actions.Count then
+ inc(Actions.actions[Actions.Pos].Time, GameTicks)
end;
end.
--- a/hedgewars/uAIAmmoTests.pas Tue Jun 20 20:08:17 2006 +0000
+++ b/hedgewars/uAIAmmoTests.pas Tue Jun 20 21:18:49 2006 +0000
@@ -1,19 +1,34 @@
unit uAIAmmoTests;
interface
-uses SDLh;
+uses SDLh, uGears, uConsts;
+
+function TestBazooka(Me: PGear; Targ: TPoint; out Time: Longword; out Angle, Power: integer): integer;
+function TestGrenade(Me: PGear; Targ: TPoint; out Time: Longword; out Angle, Power: integer): integer;
-function TestBazooka(Me, Targ: TPoint; out Time: Longword; out Angle, Power: integer): integer;
+type TAmmoTestProc = function (Me: PGear; Targ: TPoint; out Time: Longword; out Angle, Power: integer): integer;
+const AmmoTests: array[TAmmoType] of TAmmoTestProc =
+ (
+{amGrenade} TestGrenade,
+{amBazooka} TestBazooka,
+{amUFO} nil,
+{amShotgun} nil,
+{amPickHammer} nil,
+{amSkip} nil,
+{amRope} nil,
+{amMine} nil,
+{amDEagle} nil,
+{amDynamite} nil
+ );
implementation
uses uMisc, uAIMisc;
-const cMyHHDamageScore = -3000;
function Metric(x1, y1, x2, y2: integer): integer;
begin
Result:= abs(x1 - x2) + abs(y1 - y2)
end;
-function TestBazooka(Me, Targ: TPoint; out Time: Longword; out Angle, Power: integer): integer;
+function TestBazooka(Me: PGear; Targ: TPoint; out Time: Longword; out Angle, Power: integer): integer;
var Vx, Vy, r: real;
rTime: real;
Score: integer;
@@ -34,9 +49,7 @@
dY:= dY + cGravity;
dec(t)
until TestColl(round(x), round(y), 5) or (t <= 0);
- if NoMyHHNear(round(x), round(y), 110) then
- Result:= - Metric(round(x), round(y), Targ.x, Targ.y) div 16
- else Result:= cMyHHDamageScore;
+ Result:= RateExplosion(Me, round(x), round(y), 101) - Metric(Targ.X, Targ.Y, round(x), round(y)) div 16
end;
begin
@@ -44,7 +57,7 @@
rTime:= 10;
Result:= Low(integer);
repeat
- rTime:= rTime + 70 + random*200;
+ rTime:= rTime + 100 + random*250;
Vx:= - cWindSpeed * rTime / 2 + (Targ.X - Me.X) / rTime;
Vy:= cGravity * rTime / 2 - (Targ.Y - Me.Y) / rTime;
r:= sqr(Vx) + sqr(Vy);
@@ -62,4 +75,51 @@
until (rTime >= 5000)
end;
+function TestGrenade(Me: PGear; Targ: TPoint; out Time: Longword; out Angle, Power: integer): integer;
+const tDelta = 10;
+var Vx, Vy, r: real;
+ Score: integer;
+ TestTime: Longword;
+
+ function CheckTrace: integer;
+ var x, y, dY: real;
+ t: integer;
+ begin
+ x:= Me.X;
+ y:= Me.Y;
+ dY:= -Vy;
+ t:= TestTime;
+ repeat
+ x:= x + Vx;
+ y:= y + dY;
+ dY:= dY + cGravity;
+ dec(t)
+ until TestColl(round(x), round(y), 5) or (t = 0);
+ if t < 50 then Result:= RateExplosion(Me, round(x), round(y), 101)
+ else Result:= Low(integer)
+ end;
+
+begin
+Result:= Low(integer);
+TestTime:= 0;
+repeat
+ inc(TestTime, 1000);
+ Vx:= (Targ.X - Me.X) / (TestTime + tDelta);
+ Vy:= cGravity*((TestTime + tDelta) div 2) - (Targ.Y - Me.Y) / (TestTime + tDelta);
+ r:= sqr(Vx) + sqr(Vy);
+ if r <= 1 then
+ begin
+ Score:= CheckTrace;
+ if Result <= Score then
+ begin
+ r:= sqrt(r);
+ Angle:= DxDy2AttackAngle(Vx, Vy);
+ Power:= round(r * cMaxPower);
+ Time:= TestTime;
+ Result:= Score
+ end;
+ end
+until (TestTime = 5000)
+end;
+
end.
--- a/hedgewars/uAIMisc.pas Tue Jun 20 20:08:17 2006 +0000
+++ b/hedgewars/uAIMisc.pas Tue Jun 20 21:18:49 2006 +0000
@@ -1,6 +1,6 @@
unit uAIMisc;
interface
-uses SDLh, uConsts;
+uses SDLh, uConsts, uGears;
type TTarget = record
Point: TPoint;
@@ -11,15 +11,33 @@
ar: array[0..cMaxHHIndex*5] of TTarget;
end;
-procedure FillTargets(var Targets: TTargets);
+procedure FillTargets;
+procedure FillBonuses;
+function CheckBonuses(Gear: PGear): integer;
function DxDy2AttackAngle(const _dY, _dX: Extended): integer;
function TestColl(x, y, r: integer): boolean;
-function NoMyHHNear(x, y, r: integer): boolean;
+function RateExplosion(Me: PGear; x, y, r: integer): integer;
+function HHGo(Gear: PGear): boolean;
+
+var ThinkingHH: PGear;
+ Targets: TTargets;
implementation
-uses uTeams, uMisc, uLand;
+uses uTeams, uMisc, uLand, uCollisions;
+const KillScore = 200;
+ MAXBONUS = 1024;
+
+type TBonus = record
+ X, Y: integer;
+ Radius: Longword;
+ Score: integer;
+ end;
+var bonuses: record
+ Count: Longword;
+ ar: array[0..Pred(MAXBONUS)] of TBonus;
+ end;
-procedure FillTargets(var Targets: TTargets);
+procedure FillTargets;
var t: PTeam;
i: Longword;
begin
@@ -27,22 +45,61 @@
t:= TeamsList;
while t <> nil do
begin
- if t <> CurrentTeam then
- for i:= 0 to cMaxHHIndex do
- if t.Hedgehogs[i].Gear <> nil then
- begin
- with Targets.ar[Targets.Count], t.Hedgehogs[i] do
- begin
- Point.X:= Round(Gear.X);
- Point.Y:= Round(Gear.Y);
- Score:= 100 - Gear.Health
- end;
- inc(Targets.Count)
- end;
+ for i:= 0 to cMaxHHIndex do
+ if (t.Hedgehogs[i].Gear <> nil)
+ and (t.Hedgehogs[i].Gear <> ThinkingHH) then
+ begin
+ with Targets.ar[Targets.Count], t.Hedgehogs[i] do
+ begin
+ Point.X:= Round(Gear.X);
+ Point.Y:= Round(Gear.Y);
+ if t <> CurrentTeam then Score:= Gear.Health
+ else Score:= -Gear.Health
+ end;
+ inc(Targets.Count)
+ end;
t:= t.Next
end
end;
+procedure FillBonuses;
+var Gear: PGear;
+
+ procedure AddBonus(x, y: integer; r: Longword; s: integer);
+ 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;
+Gear:= GearsList;
+while Gear <> nil do
+ begin
+ case Gear.Kind of
+ gtCase: AddBonus(round(Gear.X), round(Gear.Y), 32, 25);
+ gtMine: AddBonus(round(Gear.X), round(Gear.Y), 45, -50);
+ gtAmmo_Bomb: AddBonus(round(Gear.X), round(Gear.Y), 50, -100);
+ gtHedgehog: if Gear.Damage >= Gear.Health then AddBonus(round(Gear.X), round(Gear.Y), 50, -25);
+ end;
+ Gear:= Gear.NextGear
+ end
+end;
+
+function CheckBonuses(Gear: PGear): integer;
+var i: integer;
+begin
+Result:= 0;
+for i:= 0 to Pred(bonuses.Count) do
+ with bonuses.ar[i] do
+ if sqrt(sqr(Gear.X - X) + sqr(Gear.Y - y)) <= Radius then
+ inc(Result, Score)
+end;
+
function DxDy2AttackAngle(const _dY, _dX: Extended): integer;
const piDIVMaxAngle: Extended = pi/cMaxAngle;
asm
@@ -67,22 +124,126 @@
Result:=(((x+r) and $FFFFF800) = 0)and(((y+r) and $FFFFFC00) = 0) and (Land[y+r, x+r] <> 0);
end;
-function NoMyHHNear(x, y, r: integer): boolean;
-var i: integer;
+function RateExplosion(Me: PGear; x, y, r: integer): integer;
+var i, dmg: integer;
begin
-i:= 0;
-r:= sqr(r);
-Result:= true;
+Result:= 0;
+// add our virtual position
+with Targets.ar[Targets.Count] do
+ begin
+ Point.x:= round(Me.X);
+ Point.y:= round(Me.Y);
+ Score:= - ThinkingHH.Health
+ end;
+// rate explosion
+for i:= 0 to Targets.Count do
+ with Targets.ar[i] do
+ begin
+ dmg:= r - Round(sqrt(sqr(Point.x - x) + sqr(Point.y - y)));
+ if dmg > 0 then
+ begin
+ dmg:= dmg shr 1;
+ if dmg > abs(Score) then
+ if Score > 0 then inc(Result, KillScore)
+ else dec(Result, KillScore * 3)
+ else
+ if Score > 0 then inc(Result, dmg)
+ else dec(Result, dmg * 3)
+ end;
+ end;
+end;
+
+function HHGo(Gear: PGear): boolean;
+var pX, pY: integer;
+begin
+Result:= false;
repeat
- with CurrentTeam.Hedgehogs[i] do
- if Gear <> nil then
- if sqr(Gear.X - x) + sqr(Gear.Y - y) <= r then
- begin
- Result:= false;
- exit
- end;
-inc(i)
-until i > cMaxHHIndex
+pX:= round(Gear.X);
+pY:= round(Gear.Y);
+if pY + cHHRadius >= cWaterLine then exit;
+if (Gear.State and gstFalling) <> 0 then
+ begin
+ Gear.dY:= Gear.dY + cGravity;
+ if Gear.dY > 0.35 then exit;
+ Gear.Y:= Gear.Y + Gear.dY;
+ if TestCollisionYwithGear(Gear, 1) then
+ begin
+ Gear.State:= Gear.State and not (gstFalling or gstHHJumping);
+ Gear.dY:= 0
+ end;
+ continue
+ end;
+ {if ((Gear.Message and gm_LJump )<>0) then
+ begin
+ Gear.Message:= 0;
+ if not HHTestCollisionYwithGear(Gear, -1) then
+ if not TestCollisionXwithXYShift(Gear, 0, -2, Sign(Gear.dX)) then Gear.Y:= Gear.Y - 2 else
+ if not TestCollisionXwithXYShift(Gear, 0, -1, Sign(Gear.dX)) then Gear.Y:= Gear.Y - 1;
+ if not (TestCollisionXwithGear(Gear, Sign(Gear.dX))
+ or HHTestCollisionYwithGear(Gear, -1)) then
+ begin
+ Gear.dY:= -0.15;
+ Gear.dX:= Sign(Gear.dX) * 0.15;
+ Gear.State:= Gear.State or gstFalling or gstHHJumping;
+ exit
+ end;
+ end;}
+ if (Gear.Message and gm_Left )<>0 then Gear.dX:= -1.0 else
+ if (Gear.Message and gm_Right )<>0 then Gear.dX:= 1.0 else exit;
+ if TestCollisionXwithGear(Gear, Sign(Gear.dX)) then
+ begin
+ if not (TestCollisionXwithXYShift(Gear, 0, -6, Sign(Gear.dX))
+ or TestCollisionYwithGear(Gear, -1)) then Gear.Y:= Gear.Y - 1;
+ if not (TestCollisionXwithXYShift(Gear, 0, -5, Sign(Gear.dX))
+ or TestCollisionYwithGear(Gear, -1)) then Gear.Y:= Gear.Y - 1;
+ if not (TestCollisionXwithXYShift(Gear, 0, -4, Sign(Gear.dX))
+ or TestCollisionYwithGear(Gear, -1)) then Gear.Y:= Gear.Y - 1;
+ if not (TestCollisionXwithXYShift(Gear, 0, -3, Sign(Gear.dX))
+ or TestCollisionYwithGear(Gear, -1)) then Gear.Y:= Gear.Y - 1;
+ if not (TestCollisionXwithXYShift(Gear, 0, -2, Sign(Gear.dX))
+ or TestCollisionYwithGear(Gear, -1)) then Gear.Y:= Gear.Y - 1;
+ if not (TestCollisionXwithXYShift(Gear, 0, -1, Sign(Gear.dX))
+ or TestCollisionYwithGear(Gear, -1)) then Gear.Y:= Gear.Y - 1;
+ end;
+
+ if not TestCollisionXwithGear(Gear, Sign(Gear.dX)) then Gear.X:= Gear.X + Gear.dX;
+ 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.dX:= 0.0000001 * Sign(Gear.dX);
+ Gear.State:= Gear.State or gstFalling
+ end
+ end
+ end
+ end
+ end
+ end
+ end;
+if (pX <> round(Gear.X))and ((Gear.State and gstFalling) = 0) then
+ begin
+ Result:= true;
+ exit
+ end;
+until (pX = round(Gear.X)) and (pY = round(Gear.Y)) and ((Gear.State and gstFalling) = 0);
end;
end.