# HG changeset patch # User unc0rr # Date 1150300222 0 # Node ID 9df467527ae5739951f2723da024ea24baf81891 # Parent 27e2b5bb6d4bd90cb7c7c07ef21221b659b7e5d6 - Start AI rewrite - Many small changes diff -r 27e2b5bb6d4b -r 9df467527ae5 hedgewars/Makefile --- 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 diff -r 27e2b5bb6d4b -r 9df467527ae5 hedgewars/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} diff -r 27e2b5bb6d4b -r 9df467527ae5 hedgewars/uAI.pas --- 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; diff -r 27e2b5bb6d4b -r 9df467527ae5 hedgewars/uAIActions.pas --- 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 - * - * 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. diff -r 27e2b5bb6d4b -r 9df467527ae5 hedgewars/uAIAmmoTests.pas --- 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 - * - * 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. diff -r 27e2b5bb6d4b -r 9df467527ae5 hedgewars/uAIMisc.pas --- 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 - * - * 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. diff -r 27e2b5bb6d4b -r 9df467527ae5 hedgewars/uCollisions.pas --- 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 + * Copyright (c) 2005, 2006 Andrey Korotaev * * 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) diff -r 27e2b5bb6d4b -r 9df467527ae5 hedgewars/uConsts.pas --- 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) diff -r 27e2b5bb6d4b -r 9df467527ae5 hedgewars/uGears.pas --- 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; diff -r 27e2b5bb6d4b -r 9df467527ae5 hedgewars/uLand.pas --- 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; diff -r 27e2b5bb6d4b -r 9df467527ae5 hedgewars/uLandGraphics.pas --- 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); diff -r 27e2b5bb6d4b -r 9df467527ae5 hedgewars/uTeams.pas --- 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;