--- a/hedgewars/Makefile Fri Feb 24 16:06:12 2006 +0000
+++ b/hedgewars/Makefile Wed Jun 14 15:50:22 2006 +0000
@@ -1,2 +1,4 @@
fpc-compile:
+ ppc386 -Fl/usr/local/lib getrevnum.dpr
+ ./getrevnum < /dev/null > revision.inc
ppc386 -B -Sd -Xs -OG -Or -O2 -Fl/usr/local/lib hwengine.dpr
--- a/hedgewars/hwengine.dpr Fri Feb 24 16:06:12 2006 +0000
+++ b/hedgewars/hwengine.dpr Wed Jun 14 15:50:22 2006 +0000
@@ -48,14 +48,14 @@
uSound in 'uSound.pas',
uRandom in 'uRandom.pas',
uAI in 'uAI.pas',
- uAIActions in 'uAIActions.pas',
- uAIMisc in 'uAIMisc.pas',
- uAIAmmoTests in 'uAIAmmoTests.pas',
uCollisions in 'uCollisions.pas',
uLand in 'uLand.pas',
uLandTemplates in 'uLandTemplates.pas',
uLandObjects in 'uLandObjects.pas',
- uLandGraphics in 'uLandGraphics.pas';
+ uLandGraphics in 'uLandGraphics.pas',
+ uAIMisc in 'uAIMisc.pas',
+ uAIAmmoTests in 'uAIAmmoTests.pas',
+ uAIActions in 'uAIActions.pas';
{$INCLUDE options.inc}
--- a/hedgewars/uAI.pas Fri Feb 24 16:06:12 2006 +0000
+++ b/hedgewars/uAI.pas Wed Jun 14 15:50:22 2006 +0000
@@ -35,132 +35,79 @@
interface
{$INCLUDE options.inc}
procedure ProcessBot;
+procedure FreeActionsList;
implementation
-uses uAIActions, uAIMisc, uMisc, uTeams, uConsts, uAIAmmoTests, uGears, SDLh, uConsole;
+uses uTeams, uConsts, SDLh, uAIMisc, uGears, uAIAmmoTests, uAIActions, uMisc;
-procedure Think;
var Targets: TTargets;
- Angle, Power: integer;
- Time: Longword;
+ Actions, BestActions: TActions;
- procedure FindTarget(Flags: Longword);
- var t: integer;
- a, aa: TAmmoType;
- Me: TPoint;
- begin
- t:= 0;
- with CurrentTeam.Hedgehogs[CurrentTeam.CurrHedgehog] do
- begin
- Me.X:= round(Gear.X);
- Me.Y:= round(Gear.Y);
- end;
- repeat
- if isInMultiShoot or (CurrentTeam.Hedgehogs[CurrentTeam.CurrHedgehog].AttacksNum > 0)
- then with CurrentTeam.Hedgehogs[CurrentTeam.CurrHedgehog] do
- a:= Ammo[CurSlot, CurAmmo].AmmoType
- else a:= TAmmoType(random(ord(High(TAmmoType))));
- aa:= a;
- repeat
- if Assigned(AmmoTests[a].Test)
- and ((Flags = 0) or ((Flags and AmmoTests[a].Flags) <> 0)) then
- if AmmoTests[a].Test(Me, Targets.ar[t], Flags, Time, Angle, Power) then
- begin
- AddAction(aia_Weapon, ord(a), 1000);
- if Time <> 0 then AddAction(aia_Timer, Time div 1000, 400);
- exit
- end;
- if a = High(TAmmoType) then a:= Low(TAmmoType)
- else inc(a)
- until isInMultiShoot or (a = aa) or (CurrentTeam.Hedgehogs[CurrentTeam.CurrHedgehog].AttacksNum > 0);
- inc(t)
- until (t >= Targets.Count)
- end;
+procedure FreeActionsList;
+begin
+BestActions.Count:= 0;
+BestActions.Pos:= 0;
+end;
- procedure TryGo(lvl, Flags: Longword);
- var tmpGear: TGear;
- i, t: integer;
- begin
- with CurrentTeam.Hedgehogs[CurrentTeam.CurrHedgehog] do
- for t:= aia_Left to aia_Right do
- if IsActionListEmpty then
- begin
- tmpGear:= Gear^;
- i:= 0;
- Gear.Message:= t;
- while HHGo(Gear) do
- begin
- if (i mod 5 = 0) then
- begin
- FindTarget(Flags);
- if not IsActionListEmpty then
- begin
- if i > 0 then
- begin
- AddAction(t, aim_push, 1000);
- AddAction(aia_WaitX, round(Gear.X), 0);
- AddAction(t, aim_release, 0)
- end;
- Gear^:= tmpGear;
- exit
- end
- end;
- inc(i)
- end;
- Gear^:= tmpGear
- end
- end;
-
+procedure TestAmmos(Me: PGear);
+var MyPoint: TPoint;
+ Time: Longword;
+ Angle, Power, Score: integer;
+ i: integer;
begin
-with CurrentTeam.Hedgehogs[CurrentTeam.CurrHedgehog] do
- if ((Gear.State and (gstAttacked or gstAttacking or gstMoving or gstFalling)) <> 0)
- or isInMultiShoot then exit;
-
-FillTargets(Targets);
-
-TryGo(0, 0);
-
-if IsActionListEmpty then
- TryGo(0, ctfNotFull);
-if IsActionListEmpty then
- TryGo(0, ctfBreach);
-
-if IsActionListEmpty then
+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
- if CurrentTeam.Hedgehogs[CurrentTeam.CurrHedgehog].AttacksNum = 0 then
+ 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(aia_Weapon, ord(amSkip), 1000);
- AddAction(aia_Attack, aim_push, 1000);
- end else ParseCommand('skip');
- exit
- end;
+ 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
+end;
-with CurrentTeam.Hedgehogs[CurrentTeam.CurrHedgehog] do
- begin
- if (Angle > 0) then AddAction(aia_LookRight, 0, 200)
- else if (Angle < 0) then AddAction(aia_LookLeft, 0, 200);
- Angle:= integer(Gear.Angle) - Abs(Angle);
- if Angle > 0 then
- begin
- AddAction(aia_Up, aim_push, 500);
- AddAction(aia_Up, aim_release, Angle)
- end else if Angle < 0 then
- begin
- AddAction(aia_Down, aim_push, 500);
- AddAction(aia_Down, aim_release, -Angle)
- end;
- AddAction(aia_attack, aim_push, 300);
- AddAction(aia_attack, aim_release, Power);
- end
+procedure Walk(Me: PGear);
+begin
+TestAmmos(Me)
+end;
+
+procedure Think(Me: PGear);
+begin
+FillTargets(Targets);
+Actions.Score:= 0;
+Actions.Count:= 0;
+Actions.Pos:= 0;
+BestActions.Score:= Low(integer);
+if Targets.Count > 0 then
+ Walk(Me)
end;
procedure ProcessBot;
+var Me: PGear;
begin
-with CurrentTeam.Hedgehogs[CurrentTeam.CurrHedgehog] do //HACK: v--- temp hack to make AI work
+with CurrentTeam.Hedgehogs[CurrentTeam.CurrHedgehog] do
if (Gear <> nil)and((Gear.State and gstHHDriven) <> 0) and (TurnTimeLeft < 29990) then
begin
- if IsActionListEmpty then Think;
- ProcessAction
+ Me:= CurrentTeam.Hedgehogs[CurrentTeam.CurrHedgehog].Gear;
+ if BestActions.Count = BestActions.Pos then Think(Me);
+ ProcessAction(BestActions, Me)
end
end;
--- a/hedgewars/uAIActions.pas Fri Feb 24 16:06:12 2006 +0000
+++ b/hedgewars/uAIActions.pas Wed Jun 14 15:50:22 2006 +0000
@@ -1,40 +1,8 @@
-(*
- * Hedgewars, a worms-like game
- * Copyright (c) 2005 Andrey Korotaev <unC0Rr@gmail.com>
- *
- * Distributed under the terms of the BSD-modified licence:
- *
- * Permission is hereby granted, free of charge, to any person obtaining a copy
- * of this software and associated documentation files (the "Software"), to deal
- * with the Software without restriction, including without limitation the
- * rights to use, copy, modify, merge, publish, distribute, sublicense, and/or
- * sell copies of the Software, and to permit persons to whom the Software is
- * furnished to do so, subject to the following conditions:
- *
- * 1. Redistributions of source code must retain the above copyright notice,
- * this list of conditions and the following disclaimer.
- * 2. Redistributions in binary form must reproduce the above copyright notice,
- * this list of conditions and the following disclaimer in the documentation
- * and/or other materials provided with the distribution.
- * 3. The name of the author may not be used to endorse or promote products
- * derived from this software without specific prior written permission.
- *
- * THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR IMPLIED
- * WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
- * MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO
- * EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
- * SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
- * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS;
- * OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
- * WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
- * OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
- * ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
- *)
-
unit uAIActions;
interface
-{$INCLUDE options.inc}
-const aia_none = 0;
+uses uGears;
+const MAXACTIONS = 256;
+ aia_none = 0;
aia_Left = 1;
aia_Right = 2;
aia_Timer = 3;
@@ -53,20 +21,21 @@
aim_release = $80000001;
ai_specmask = $80000000;
-type PAction = ^TAction;
- TAction = record
+type TAction = record
Action, Param: Longword;
Time: Longword;
- Next: PAction;
end;
+ TActions = record
+ Count, Pos: Longword;
+ actions: array[0..Pred(MAXACTIONS)] of TAction;
+ Score: integer;
+ end;
-function AddAction(Action, Param, TimeDelta: Longword): PAction;
-procedure FreeActionsList;
-function IsActionListEmpty: boolean;
-procedure ProcessAction;
+procedure AddAction(var Actions: TActions; Action, Param, TimeDelta: Longword);
+procedure ProcessAction(var Actions: TActions; Me: PGear);
implementation
-uses uMisc, uConsts, uConsole, uTeams;
+uses uMisc, uTeams, uConsts, uConsole;
const ActionIdToStr: array[0..7] of string[16] = (
{aia_none} '',
@@ -77,98 +46,53 @@
{aia_attack} 'attack',
{aia_Up} 'up',
{aia_Down} 'down'
- );
-
+ );
-var ActionList,
- FinAction: PAction;
-
-function AddAction(Action, Param, TimeDelta: Longword): PAction;
+procedure AddAction(var Actions: TActions; Action, Param, TimeDelta: Longword);
begin
-New(Result);
-TryDo(Result <> nil, 'AddAction: Result = nil', true);
-FillChar(Result^, sizeof(TAction), 0);
-Result.Action:= Action;
-Result.Param:= Param;
-if ActionList = nil then
- begin
- Result.Time:= GameTicks + TimeDelta;
- ActionList:= Result;
- FinAction := Result
- end else
- begin
- Result.Time:= TimeDelta;
- FinAction.Next:= Result;
- FinAction:= Result
- end
-end;
-
-procedure DeleteCurrAction;
-var t: PAction;
-begin
-t:= ActionList;
-ActionList:= ActionList.Next;
-if ActionList = nil then FinAction:= nil
- else inc(ActionList.Time, t.Time);
-Dispose(t)
-end;
-
-function IsActionListEmpty: boolean;
-begin
-Result:= ActionList = nil
-end;
-
-procedure FreeActionsList;
-begin
-while ActionList <> nil do DeleteCurrAction;
+with Actions do
+ begin
+ actions[Count].Action:= Action;
+ actions[Count].Param:= Param;
+ if Count > 0 then actions[Count].Time:= actions[Pred(Count)].Time + TimeDelta
+ else actions[Count].Time:= GameTicks + TimeDelta;
+ inc(Count);
+ TryDo(Count < MAXACTIONS, 'AI: actions overflow', true);
+ end
end;
procedure SetWeapon(weap: Longword);
-var t: integer;
begin
-t:= 0;
with CurrentTeam^ do
with Hedgehogs[CurrHedgehog] do
while Ammo[CurSlot, CurAmmo].AmmoType <> TAmmotype(weap) do
- begin
ParseCommand('/slot ' + chr(49 + Ammoz[TAmmoType(weap)].Slot));
- inc(t);
- if t > 10 then OutError('AI: incorrect try to change weapon!', true)
- end
end;
-procedure ProcessAction;
+procedure ProcessAction(var Actions: TActions; Me: PGear);
var s: shortstring;
begin
-if ActionList = nil then exit;
-with ActionList^ do
+if Actions.Pos >= Actions.Count then exit;
+with Actions.actions[Actions.Pos] do
begin
if Time > GameTicks then exit;
if (Action and ai_specmask) <> 0 then
case Action of
aia_Weapon: SetWeapon(Param);
- aia_WaitX: with CurrentTeam^ do
- with Hedgehogs[CurrHedgehog] do
- if round(Gear.X) = Param then Time:= GameTicks
- else exit;
- aia_WaitY: with CurrentTeam^ do
- with Hedgehogs[CurrHedgehog] do
- if round(Gear.Y) = Param then Time:= GameTicks
- else exit;
- aia_LookLeft: with CurrentTeam^ do
- with Hedgehogs[CurrHedgehog] do
- if Gear.dX >= 0 then
- begin
- ParseCommand('+left');
- exit
- end else ParseCommand('-left');
- aia_LookRight: with CurrentTeam^ do
- with Hedgehogs[CurrHedgehog] do
- if Gear.dX < 0 then
- begin
- ParseCommand('+right');
- exit
- end else ParseCommand('-right');
+ aia_WaitX: if round(Me.X) = Param then Time:= GameTicks
+ else exit;
+ aia_WaitY: if round(Me.Y) = Param then Time:= GameTicks
+ else exit;
+ aia_LookLeft: if Me.dX >= 0 then
+ begin
+ ParseCommand('+left');
+ exit
+ end else ParseCommand('-left');
+ aia_LookRight: if Me.dX < 0 then
+ begin
+ ParseCommand('+right');
+ exit
+ end else ParseCommand('-right');
end else
begin
s:= ActionIdToStr[Action];
@@ -181,7 +105,7 @@
ParseCommand(s)
end
end;
-DeleteCurrAction
+inc(Actions.Pos)
end;
end.
--- a/hedgewars/uAIAmmoTests.pas Fri Feb 24 16:06:12 2006 +0000
+++ b/hedgewars/uAIAmmoTests.pas Wed Jun 14 15:50:22 2006 +0000
@@ -1,138 +1,24 @@
-(*
- * Hedgewars, a worms-like game
- * Copyright (c) 2005, 2006 Andrey Korotaev <unC0Rr@gmail.com>
- *
- * Distributed under the terms of the BSD-modified licence:
- *
- * Permission is hereby granted, free of charge, to any person obtaining a copy
- * of this software and associated documentation files (the "Software"), to deal
- * with the Software without restriction, including without limitation the
- * rights to use, copy, modify, merge, publish, distribute, sublicense, and/or
- * sell copies of the Software, and to permit persons to whom the Software is
- * furnished to do so, subject to the following conditions:
- *
- * 1. Redistributions of source code must retain the above copyright notice,
- * this list of conditions and the following disclaimer.
- * 2. Redistributions in binary form must reproduce the above copyright notice,
- * this list of conditions and the following disclaimer in the documentation
- * and/or other materials provided with the distribution.
- * 3. The name of the author may not be used to endorse or promote products
- * derived from this software without specific prior written permission.
- *
- * THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR IMPLIED
- * WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
- * MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO
- * EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
- * SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
- * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS;
- * OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
- * WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
- * OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
- * ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
- *)
-
unit uAIAmmoTests;
interface
-uses uConsts, SDLh;
-{$INCLUDE options.inc}
-const ctfNotFull = $00000001;
- ctfBreach = $00000002;
-
-function TestGrenade(Me, Targ: TPoint; Flags: Longword; out Time: Longword; out Angle, Power: integer): boolean;
-function TestBazooka(Me, Targ: TPoint; Flags: Longword; out Time: Longword; out Angle, Power: integer): boolean;
-function TestShotgun(Me, Targ: TPoint; Flags: Longword; out Time: Longword; out Angle, Power: integer): boolean;
-function TestDEagle(Me, Targ: TPoint; Flags: Longword; out Time: Longword; out Angle, Power: integer): boolean;
+uses SDLh;
-type TAmmoTestProc = function (Me, Targ: TPoint; Flags: Longword; out Time: Longword; out Angle, Power: integer): boolean;
-const AmmoTests: array[TAmmoType] of
- record
- Test: TAmmoTestProc;
- Flags: Longword;
- end = (
- ( Test: TestGrenade;
- Flags: ctfNotFull;
- ),
- ( Test: TestBazooka;
- Flags: ctfNotFull or ctfBreach;
- ),
- ( Test: nil;
- Flags: 0;
- ),
- ( Test: TestShotgun;
- Flags: ctfBreach;
- ),
- ( Test: nil;
- Flags: 0;
- ),
- ( Test: nil;
- Flags: 0;
- ),
- ( Test: nil;
- Flags: 0;
- ),
- ( Test: nil;
- Flags: 0;
- ),
- ( Test: TestDEagle;
- Flags: 0;
- ),
- ( Test: nil;
- Flags: 0;
- )
- );
+function TestBazooka(Me, Targ: TPoint; out Time: Longword; out Angle, Power: integer): integer;
implementation
-uses uMisc, uAIMisc, uLand;
-
-function TestGrenade(Me, Targ: TPoint; Flags: Longword; out Time: Longword; out Angle, Power: integer): boolean;
-var Vx, Vy, r: real;
- flHasTrace: boolean;
+uses uMisc, uAIMisc;
+const cMyHHDamageScore = -3000;
- function CheckTrace: boolean;
- var x, y, dY: real;
- t: integer;
- begin
- x:= Me.X;
- y:= Me.Y;
- dY:= -Vy;
- Result:= false;
- if (Flags and ctfNotFull) = 0 then t:= Time
- else t:= Time - 100;
- repeat
- x:= x + Vx;
- y:= y + dY;
- dY:= dY + cGravity;
- if TestColl(round(x), round(y), 5) then exit;
- dec(t);
- until t <= 0;
- Result:= true
- end;
-
+function Metric(x1, y1, x2, y2: integer): integer;
begin
-Result:= false;
-Time:= 0;
-flHasTrace:= false;
-repeat
- inc(Time, 1000);
- Vx:= (Targ.X - Me.X) / Time;
- Vy:= cGravity*(Time div 2) - (Targ.Y - Me.Y) / Time;
- r:= sqr(Vx) + sqr(Vy);
- if r <= 1 then flHasTrace:= CheckTrace
- else exit
-until flHasTrace or (Time = 5000);
-if not flHasTrace then exit;
-r:= sqrt(r);
-Angle:= DxDy2Angle(Vx, Vy);
-Power:= round(r * cMaxPower);
-Result:= true
+Result:= abs(x1 - x2) + abs(y1 - y2)
end;
-function TestBazooka(Me, Targ: TPoint; Flags: Longword; out Time: Longword; out Angle, Power: integer): boolean;
+function TestBazooka(Me, Targ: TPoint; out Time: Longword; out Angle, Power: integer): integer;
var Vx, Vy, r: real;
rTime: real;
- flHasTrace: boolean;
+ Score: integer;
- function CheckTrace: boolean;
+ function CheckTrace: integer;
var x, y, dX, dY: real;
t: integer;
begin
@@ -140,97 +26,40 @@
y:= Me.Y;
dX:= Vx;
dY:= -Vy;
- Result:= false;
- if (Flags and ctfNotFull) = 0 then t:= trunc(rTime)
- else t:= trunc(rTime) - 100;
+ t:= trunc(rTime);
repeat
x:= x + dX;
y:= y + dY;
dX:= dX + cWindSpeed;
dY:= dY + cGravity;
- if TestColl(round(x), round(y), 5) then
- begin
- if (Flags and ctfBreach) <> 0 then
- Result:= NoMyHHNear(round(x), round(y), 110);
- exit
- end;
dec(t)
- until t <= 0;
- Result:= true
+ 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;
end;
begin
Time:= 0;
-Result:= false;
rTime:= 10;
-flHasTrace:= false;
+Result:= Low(integer);
repeat
- rTime:= rTime + 100 + random*300;
+ rTime:= rTime + 70 + random*200;
Vx:= - cWindSpeed * rTime / 2 + (Targ.X - Me.X) / rTime;
Vy:= cGravity * rTime / 2 - (Targ.Y - Me.Y) / rTime;
r:= sqr(Vx) + sqr(Vy);
- if r <= 1 then flHasTrace:= CheckTrace
-until flHasTrace or (rTime >= 5000);
-if not flHasTrace then exit;
-r:= sqrt(r);
-Angle:= DxDy2Angle(Vx, Vy);
-Power:= round(r * cMaxPower);
-Result:= true
-end;
-
-function TestShotgun(Me, Targ: TPoint; Flags: Longword; out Time: Longword; out Angle, Power: integer): boolean;
-var Vx, Vy, x, y: real;
-begin
-if abs(Me.X - Targ.X) + abs(Me.Y - Targ.Y) < 80 then
- begin
- Result:= false;
- exit
- end;
-Time:= 0;
-Power:= 1;
-Vx:= (Targ.X - Me.X)/1024;
-Vy:= (Targ.Y - Me.Y)/1024;
-x:= Me.X;
-y:= Me.Y;
-Angle:= DxDy2Angle(Vx, -Vy);
-repeat
- x:= x + vX;
- y:= y + vY;
- if TestColl(round(x), round(y), 2) then
+ if r <= 1 then
begin
- if (Flags and ctfBreach) <> 0 then
- Result:= NoMyHHNear(round(x), round(y), 27)
- else Result:= false;
- exit
+ Score:= CheckTrace;
+ if Result <= Score then
+ begin
+ r:= sqrt(r);
+ Angle:= DxDy2AttackAngle(Vx, Vy);
+ Power:= round(r * cMaxPower);
+ Result:= Score
+ end;
end
-until (abs(Targ.X - x) + abs(Targ.Y - y) < 4) or (x < 0) or (y < 0) or (x > 2048) or (y > 1024);
-Result:= true
-end;
-
-function TestDEagle(Me, Targ: TPoint; Flags: Longword; out Time: Longword; out Angle, Power: integer): boolean;
-var Vx, Vy, x, y: real;
- d: Longword;
-begin
-if abs(Me.X - Targ.X) + abs(Me.Y - Targ.Y) < 80 then
- begin
- Result:= false;
- exit
- end;
-Time:= 0;
-Power:= 1;
-Vx:= (Targ.X - Me.X)/1024;
-Vy:= (Targ.Y - Me.Y)/1024;
-x:= Me.X;
-y:= Me.Y;
-Angle:= DxDy2Angle(Vx, -Vy);
-d:= 0;
-repeat
- x:= x + vX;
- y:= y + vY;
- if ((round(x) and $FFFFF800) = 0)and((round(y) and $FFFFFC00) = 0)
- and (Land[round(y), round(x)] <> 0) then inc(d);
-until (abs(Targ.X - x) + abs(Targ.Y - y) < 2) or (x < 0) or (y < 0) or (x > 2048) or (y > 1024);
-Result:= d < 50
+until (rTime >= 5000)
end;
end.
--- a/hedgewars/uAIMisc.pas Fri Feb 24 16:06:12 2006 +0000
+++ b/hedgewars/uAIMisc.pas Wed Jun 14 15:50:22 2006 +0000
@@ -1,93 +1,30 @@
-(*
- * Hedgewars, a worms-like game
- * Copyright (c) 2005 Andrey Korotaev <unC0Rr@gmail.com>
- *
- * Distributed under the terms of the BSD-modified licence:
- *
- * Permission is hereby granted, free of charge, to any person obtaining a copy
- * of this software and associated documentation files (the "Software"), to deal
- * with the Software without restriction, including without limitation the
- * rights to use, copy, modify, merge, publish, distribute, sublicense, and/or
- * sell copies of the Software, and to permit persons to whom the Software is
- * furnished to do so, subject to the following conditions:
- *
- * 1. Redistributions of source code must retain the above copyright notice,
- * this list of conditions and the following disclaimer.
- * 2. Redistributions in binary form must reproduce the above copyright notice,
- * this list of conditions and the following disclaimer in the documentation
- * and/or other materials provided with the distribution.
- * 3. The name of the author may not be used to endorse or promote products
- * derived from this software without specific prior written permission.
- *
- * THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR IMPLIED
- * WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
- * MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO
- * EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
- * SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
- * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS;
- * OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
- * WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
- * OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
- * ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
- *)
-
unit uAIMisc;
interface
-uses uConsts, uGears, SDLh;
-{$INCLUDE options.inc}
+uses SDLh, uConsts;
-type TTargets = record
- Count: integer;
- ar: array[0..cMaxHHIndex*5] of TPoint;
+type TTarget = record
+ Point: TPoint;
+ Score: integer;
+ end;
+ TTargets = record
+ Count: Longword;
+ ar: array[0..cMaxHHIndex*5] of TTarget;
end;
-
+
procedure FillTargets(var Targets: TTargets);
-function DxDy2Angle(const _dY, _dX: Extended): integer;
+function DxDy2AttackAngle(const _dY, _dX: Extended): integer;
function TestColl(x, y, r: integer): boolean;
function NoMyHHNear(x, y, r: integer): boolean;
-function HHGo(Gear: PGear): boolean;
implementation
-uses uTeams, uStore, uMisc, uLand, uCollisions;
+uses uTeams, uMisc, uLand;
procedure FillTargets(var Targets: TTargets);
var t: PTeam;
- i, k: integer;
- r: integer;
- MaxHealth: integer;
- score: array[0..cMaxHHIndex*5] of integer;
-
- procedure qSort(iLo, iHi: Integer);
- var
- Lo, Hi, Mid, T: Integer;
- P: TPoint;
- begin
- Lo := iLo;
- Hi := iHi;
- Mid := score[(Lo + Hi) div 2];
- repeat
- while score[Lo] > Mid do Inc(Lo);
- while score[Hi] < Mid do Dec(Hi);
- if Lo <= Hi then
- begin
- T := score[Lo];
- score[Lo] := score[Hi];
- score[Hi] := T;
- P := Targets.ar[Lo];
- Targets.ar[Lo] := Targets.ar[Hi];
- Targets.ar[Hi] := P;
- Inc(Lo);
- Dec(Hi)
- end;
- until Lo > Hi;
- if Hi > iLo then qSort(iLo, Hi);
- if Lo < iHi then qSort(Lo, iHi);
- end;
-
+ i: Longword;
begin
Targets.Count:= 0;
t:= TeamsList;
-MaxHealth:= 0;
while t <> nil do
begin
if t <> CurrentTeam then
@@ -96,44 +33,17 @@
begin
with Targets.ar[Targets.Count], t.Hedgehogs[i] do
begin
- X:= Round(Gear.X);
- Y:= Round(Gear.Y);
- if integer(Gear.Health) > MaxHealth then MaxHealth:= Gear.Health;
- score[Targets.Count]:= random(3) - integer(Gear.Health div 5)
+ Point.X:= Round(Gear.X);
+ Point.Y:= Round(Gear.Y);
+ Score:= 100 - Gear.Health
end;
inc(Targets.Count)
end;
t:= t.Next
- end;
-// выставляем оценку за попадание в ёжика:
-// - если есть соседи-противники, то оценка увеличивается
-// - чем меньше хелса у ёжика, тем больше оценка (код см. выше)
-// - если есть соседи-"свои", то уменьшается
-with Targets do
- for i:= 0 to Targets.Count - 1 do
- begin
- for k:= Succ(i) to Pred(Targets.Count) do
- begin
- r:= 100 - round(sqrt(sqr(ar[i].X - ar[k].X) + sqr(ar[i].Y - ar[k].Y)));
- if r > 0 then
- begin
- inc(score[i], r);
- inc(score[k], r)
- end;
- end;
- for k:= 0 to cMaxHHIndex do
- with CurrentTeam.Hedgehogs[k] do
- if Gear <> nil then
- begin
- r:= 100 - round(sqrt(sqr(ar[i].X - round(Gear.X)) + sqr(ar[i].Y - round(Gear.Y))));
- if r > 0 then dec(score[i], (r * 3) div 2 + MaxHealth + 5 - integer(Gear.Health));
- end;
- end;
-// сортируем по убыванию согласно оценке
-if Targets.Count >= 2 then qSort(0, Pred(Targets.Count));
+ end
end;
-function DxDy2Angle(const _dY, _dX: Extended): integer;
+function DxDy2AttackAngle(const _dY, _dX: Extended): integer;
const piDIVMaxAngle: Extended = pi/cMaxAngle;
asm
fld _dY
@@ -175,97 +85,4 @@
until i > cMaxHHIndex
end;
-function HHGo(Gear: PGear): boolean; // false если нельзя двигаться
-var pX, pY: integer;
-begin
-Result:= false;
-repeat
-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 HHTestCollisionYwithGear(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 HHTestCollisionYwithGear(Gear, -1)) then Gear.Y:= Gear.Y - 1;
- if not (TestCollisionXwithXYShift(Gear, 0, -5, Sign(Gear.dX))
- or HHTestCollisionYwithGear(Gear, -1)) then Gear.Y:= Gear.Y - 1;
- if not (TestCollisionXwithXYShift(Gear, 0, -4, Sign(Gear.dX))
- or HHTestCollisionYwithGear(Gear, -1)) then Gear.Y:= Gear.Y - 1;
- if not (TestCollisionXwithXYShift(Gear, 0, -3, Sign(Gear.dX))
- or HHTestCollisionYwithGear(Gear, -1)) then Gear.Y:= Gear.Y - 1;
- if not (TestCollisionXwithXYShift(Gear, 0, -2, Sign(Gear.dX))
- or HHTestCollisionYwithGear(Gear, -1)) then Gear.Y:= Gear.Y - 1;
- if not (TestCollisionXwithXYShift(Gear, 0, -1, Sign(Gear.dX))
- or HHTestCollisionYwithGear(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 HHTestCollisionYwithGear(Gear, 1) then
- begin
- Gear.Y:= Gear.Y + 1;
- if not HHTestCollisionYwithGear(Gear, 1) then
- begin
- Gear.Y:= Gear.Y + 1;
- if not HHTestCollisionYwithGear(Gear, 1) then
- begin
- Gear.Y:= Gear.Y + 1;
- if not HHTestCollisionYwithGear(Gear, 1) then
- begin
- Gear.Y:= Gear.Y + 1;
- if not HHTestCollisionYwithGear(Gear, 1) then
- begin
- Gear.Y:= Gear.Y + 1;
- if not HHTestCollisionYwithGear(Gear, 1) then
- begin
- Gear.Y:= Gear.Y + 1;
- if not HHTestCollisionYwithGear(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.
--- a/hedgewars/uCollisions.pas Fri Feb 24 16:06:12 2006 +0000
+++ b/hedgewars/uCollisions.pas Wed Jun 14 15:50:22 2006 +0000
@@ -1,6 +1,6 @@
(*
* Hedgewars, a worms-like game
- * Copyright (c) 2005 Andrey Korotaev <unC0Rr@gmail.com>
+ * Copyright (c) 2005, 2006 Andrey Korotaev <unC0Rr@gmail.com>
*
* Distributed under the terms of the BSD-modified licence:
*
@@ -151,12 +151,12 @@
begin
Result:= false;
x:= round(Gear.X);
-if Dir < 0 then x:= x - Gear.Radius
- else x:= x + Gear.Radius;
+if Dir < 0 then x:= x - Gear.Radius - 1
+ else x:= x + Gear.Radius + 1;
if (x and $FFFFF800) = 0 then
begin
- y:= round(Gear.Y) - Gear.Radius + 1; {*}
- i:= y + Gear.Radius * 2 - 2; {*}
+ y:= round(Gear.Y) - Gear.Radius + 1;
+ i:= y + Gear.Radius * 2 - 2;
repeat
if (y and $FFFFFC00) = 0 then Result:= Land[y, x]<>0;
inc(y)
@@ -182,8 +182,8 @@
else y:= y + Gear.Radius;
if (y and $FFFFFC00) = 0 then
begin
- x:= round(Gear.X) - Gear.Radius + 1; {*}
- i:= x + Gear.Radius * 2 - 2; {*}
+ x:= round(Gear.X) - Gear.Radius + 1;
+ i:= x + Gear.Radius * 2 - 2;
repeat
if (x and $FFFFF800) = 0 then Result:= Land[y, x]<>0;
inc(x)
--- a/hedgewars/uConsts.pas Fri Feb 24 16:06:12 2006 +0000
+++ b/hedgewars/uConsts.pas Wed Jun 14 15:50:22 2006 +0000
@@ -88,6 +88,8 @@
rndfillstr = 'hw';
+ COLOR_LAND = $00FFFFFF;
+
cifRandomize = $00000001;
cifTheme = $00000002;
cifMap = $00000002; // either theme or map (or map+theme)
--- a/hedgewars/uGears.pas Fri Feb 24 16:06:12 2006 +0000
+++ b/hedgewars/uGears.pas Wed Jun 14 15:50:22 2006 +0000
@@ -146,6 +146,7 @@
Result.Radius:= cHHRadius;
Result.Elasticity:= 0.002;
Result.Friction:= 0.999;
+ Result.Angle:= cMaxAngle div 2;
end;
gtAmmo_Grenade: begin
Result.Radius:= 4;
@@ -571,6 +572,7 @@
procedure AmmoShove(Ammo: PGear; Power: integer);
var t: PGearArray;
i: integer;
+ Gear: PGear;
begin
t:= CheckGearsCollision(Ammo);
i:= t.Count;
@@ -589,7 +591,14 @@
FollowGear:= t.ar[i]
end;
end
- end
+ end;
+Gear:= GearsList;
+while Gear <> nil do
+ begin
+ if Round(sqrt(sqr(Gear.X - Ammo.X) + sqr(Gear.Y - Ammo.Y))) < 50 then // why 50?
+ Gear.Active:= true;
+ Gear:= Gear.NextGear
+ end
end;
procedure AssignHHCoords;
--- a/hedgewars/uLand.pas Fri Feb 24 16:06:12 2006 +0000
+++ b/hedgewars/uLand.pas Wed Jun 14 15:50:22 2006 +0000
@@ -473,7 +473,7 @@
begin
WriteLnToConsole('Generating land...');
for i:= 0 to sizeof(Land) div 4 do
- PLongword(Longword(@Land) + i * 4)^:= $FFFFFF;
+ PLongword(Longword(@Land) + i * 4)^:= COLOR_LAND;
GenBlank(EdgeTemplates[getrandom(Succ(High(EdgeTemplates)))]);
AddProgress;
@@ -539,7 +539,7 @@
2: for y:= 0 to 1023 do
begin
for x:= 0 to 2047 do
- if PWord(p + x * 2)^ <> 0 then PLongWord(i + x * 4)^:= $FFFFFF;
+ if PWord(p + x * 2)^ <> 0 then PLongWord(i + x * 4)^:= COLOR_LAND;
inc(i, 2048 * 4);
inc(p, LandSurface.pitch);
end;
@@ -548,14 +548,14 @@
for x:= 0 to 2047 do
if (PByte(p + x * 3 + 0)^ <> 0)
or (PByte(p + x * 3 + 1)^ <> 0)
- or (PByte(p + x * 3 + 2)^ <> 0) then PLongWord(i + x * 4)^:= $FFFFFF;
+ or (PByte(p + x * 3 + 2)^ <> 0) then PLongWord(i + x * 4)^:= COLOR_LAND;
inc(i, 2048 * 4);
inc(p, LandSurface.pitch);
end;
4: for y:= 0 to 1023 do
begin
for x:= 0 to 2047 do
- if PLongword(p + x * 4)^ <> 0 then PLongWord(i + x * 4)^:= $FFFFFF;
+ if PLongword(p + x * 4)^ <> 0 then PLongWord(i + x * 4)^:= COLOR_LAND;
inc(i, 2048 * 4);
inc(p, LandSurface.pitch);
end;
--- a/hedgewars/uLandGraphics.pas Fri Feb 24 16:06:12 2006 +0000
+++ b/hedgewars/uLandGraphics.pas Wed Jun 14 15:50:22 2006 +0000
@@ -12,7 +12,7 @@
procedure FillRoundInLand(X, Y, Radius: integer; Value: Longword);
implementation
-uses SDLh, uStore, uMisc, uLand;
+uses SDLh, uStore, uMisc, uLand, uConsts;
procedure FillCircleLines(x, y, dx, dy: integer; Value: Longword);
var i: integer;
@@ -97,16 +97,16 @@
begin
if ((y + dy) and $FFFFFC00) = 0 then
for i:= max(x - dx, 0) to min(x + dx, 2047) do
- if Land[y + dy, i] <> 0 then SetLandPixel(y + dy, i);
+ if Land[y + dy, i] = COLOR_LAND then SetLandPixel(y + dy, i);
if ((y - dy) and $FFFFFC00) = 0 then
for i:= max(x - dx, 0) to min(x + dx, 2047) do
- if Land[y - dy, i] <> 0 then SetLandPixel(y - dy, i);
+ if Land[y - dy, i] = COLOR_LAND then SetLandPixel(y - dy, i);
if ((y + dx) and $FFFFFC00) = 0 then
for i:= max(x - dy, 0) to min(x + dy, 2047) do
- if Land[y + dx, i] <> 0 then SetLandPixel(y + dx, i);
+ if Land[y + dx, i] = COLOR_LAND then SetLandPixel(y + dx, i);
if ((y - dx) and $FFFFFC00) = 0 then
for i:= max(x - dy, 0) to min(x + dy, 2047) do
- if Land[y - dx, i] <> 0 then SetLandPixel(y - dx, i);
+ if Land[y - dx, i] = COLOR_LAND then SetLandPixel(y - dx, i);
end;
procedure DrawExplosion(X, Y, Radius: integer);
--- a/hedgewars/uTeams.pas Fri Feb 24 16:06:12 2006 +0000
+++ b/hedgewars/uTeams.pas Wed Jun 14 15:50:22 2006 +0000
@@ -81,7 +81,7 @@
procedure RecountTeamHealth(team: PTeam);
implementation
-uses uMisc, uStore, uWorld, uIO, uAIActions;
+uses uMisc, uStore, uWorld, uIO, uAI;
const MaxTeamHealth: integer = 0;
procedure FreeTeamsList; forward;