- set svn:eol-style to native
- Fixes for compilation and run on *nix
- Read hedgehogs spawn points from fort's config
--- a/COPYING.txt Mon Aug 22 21:38:06 2005 +0000
+++ b/COPYING.txt Tue Aug 23 16:17:53 2005 +0000
@@ -1,27 +1,27 @@
-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
+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.
\ No newline at end of file
--- a/README.txt Mon Aug 22 21:38:06 2005 +0000
+++ b/README.txt Tue Aug 23 16:17:53 2005 +0000
@@ -1,16 +1,16 @@
-Hedgewars - a Worms-like game.
-Distributed under the terms of the BSD-modified licence.
-
-Source,
-images in Data/Graphics,
-sounds in Data/Sounds,
-themes "avematan", "bubbles", "tibet"
-fort "Barrelhouse"
-(c) 2004, 2005 Andrey Korotaev <unC0Rr@gmail.com>
-
-Fonts
-(c) 1995 Gavin Helf <ghelf@violet.berkeley.edu>, <gh22@cornell.edu>
-
-Images in Data/Front, Data/Graphics/Graves,
-themes "ethereal", "norsk", "wood", "xtheme"
+Hedgewars - a Worms-like game.
+Distributed under the terms of the BSD-modified licence.
+
+Source,
+images in Data/Graphics,
+sounds in Data/Sounds,
+themes "avematan", "bubbles", "tibet"
+fort "Barrelhouse"
+(c) 2004, 2005 Andrey Korotaev <unC0Rr@gmail.com>
+
+Fonts
+(c) 1995 Gavin Helf <ghelf@violet.berkeley.edu>, <gh22@cornell.edu>
+
+Images in Data/Front, Data/Graphics/Graves,
+themes "ethereal", "norsk", "wood", "xtheme"
(c) 2005 Alexey Andreev <grayfox@inbox.ru>
\ No newline at end of file
--- a/hedgewars/CCHandlers.inc Mon Aug 22 21:38:06 2005 +0000
+++ b/hedgewars/CCHandlers.inc Tue Aug 23 16:17:53 2005 +0000
@@ -1,376 +1,376 @@
-(*
- * Hedgewars, a worms-like game
- * Copyright (c) 2004, 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.
- *)
-
-function CheckNoTeamOrHH: boolean;
-begin
-Result:= (CurrentTeam=nil) or (CurrentTeam.Hedgehogs[CurrentTeam.CurrHedgehog].Gear = nil);
-{$IFDEF DEBUGFILE}
-if Result then
- if CurrentTeam = nil then AddFileLog('CONSOLE: CurTeam = nil')
- else AddFileLog('CONSOLE: CurTeam <> nil, Gear = nil')
-{$ENDIF}
-end;
-////////////////////////////////////////////////////////////////////////////////
-procedure chQuit(var s: shortstring);
-begin
-GameState:= gsExit
-end;
-
-procedure chAddTeam(var s: shortstring);
-begin
-if isDeveloperMode then AddTeam;
-if GameType = gmtDemo then CurrentTeam.ExtDriven:= true
-end;
-
-procedure chTeamLocal(var s: shortstring);
-begin
-if not isDeveloperMode then exit;
-if CurrentTeam = nil then OutError(errmsgIncorrectUse + ' "/rdriven"', true);
-CurrentTeam.ExtDriven:= true
-end;
-
-procedure chName(var id: shortstring);
-var s: shortstring;
-begin
-if CurrentTeam = nil then OutError(errmsgIncorrectUse + ' "/name"', true);
-SplitBySpace(id, s);
-if s[1]='"' then Delete(s, 1, 1);
-if s[byte(s[0])]='"' then Delete(s, byte(s[0]), 1);
-if id = 'team' then CurrentTeam.TeamName:= s
-else if (id[1]='h')and(id[2]='h')and(id[3]>='0')and(id[3]<='7') then
- CurrentTeam.Hedgehogs[byte(id[3])-48].Name:= s
-else OutError(errmsgUnknownVariable + ' "' + id + '"')
-end;
-
-procedure chGrave(var s: shortstring);
-begin
-if CurrentTeam = nil then OutError(errmsgIncorrectUse + ' "/grave"', true);
-if s[1]='"' then Delete(s, 1, 1);
-if s[byte(s[0])]='"' then Delete(s, byte(s[0]), 1);
-CurrentTeam.GraveName:= s
-end;
-
-procedure chFort(var s: shortstring);
-begin
-if CurrentTeam = nil then OutError(errmsgIncorrectUse + ' "/grave"', true);
-if s[1]='"' then Delete(s, 1, 1);
-if s[byte(s[0])]='"' then Delete(s, byte(s[0]), 1);
-CurrentTeam.FortName:= s
-end;
-
-procedure chColor(var id: shortstring);
-var c: integer;
-begin
-if CurrentTeam = nil then OutError(errmsgIncorrectUse + ' "/color"', true);
-val(id, CurrentTeam.Color, c);
-AdjustColor(CurrentTeam.Color)
-end;
-
-procedure chAdd(var id: shortstring);
-var s: shortstring;
- c: integer;
- Gear: PGear;
- b: byte;
-begin
-if (not isDeveloperMode)or(CurrentTeam=nil) then exit;
-SplitBySpace(id, s);
-if (id[1]='h')and(id[2]='h')and(id[3]>='0')and(id[3]<='7') then
- begin
- b:= byte(id[3])-48;
- val(s, CurrentTeam.Hedgehogs[b].BotLevel, c);
- Gear:= AddGear(0, 0, gtHedgehog, 0);
- Gear.Hedgehog:= @CurrentTeam.Hedgehogs[b];
- PHedgehog(Gear.Hedgehog).Team:= CurrentTeam;
- CurrentTeam.Hedgehogs[b].Gear:= Gear
- end
-else OutError(errmsgUnknownVariable + ' "' + id + '"', true)
-end;
-
-procedure chBind(var id: shortstring);
-var s: shortstring;
- b: integer;
-begin
-if CurrentTeam = nil then exit;
-SplitBySpace(id, s);
-if s[1]='"' then Delete(s, 1, 1);
-if s[byte(s[0])]='"' then Delete(s, byte(s[0]), 1);
-b:= KeyNameToCode(id);
-if b = 0 then OutError(errmsgUnknownVariable + ' "' + id + '"')
- else CurrentTeam.Aliases[b]:= s
-end;
-
-procedure chLeft_p(var s: shortstring);
-begin
-if CheckNoTeamOrHH then exit;
-if not CurrentTeam.ExtDriven then SendIPC('L');
-with CurrentTeam.Hedgehogs[CurrentTeam.CurrHedgehog].Gear^ do
- Message:= Message or gm_Left
-end;
-
-procedure chLeft_m(var s: shortstring);
-begin
-if CheckNoTeamOrHH then exit;
-if not CurrentTeam.ExtDriven then SendIPC('l');
-with CurrentTeam.Hedgehogs[CurrentTeam.CurrHedgehog].Gear^ do
- Message:= Message and not gm_Left
-end;
-
-procedure chRight_p(var s: shortstring);
-begin
-if CheckNoTeamOrHH then exit;
-if not CurrentTeam.ExtDriven then SendIPC('R');
-with CurrentTeam.Hedgehogs[CurrentTeam.CurrHedgehog].Gear^ do
- Message:= Message or gm_Right
-end;
-
-procedure chRight_m(var s: shortstring);
-begin
-if CheckNoTeamOrHH then exit;
-if not CurrentTeam.ExtDriven then SendIPC('r');
-with CurrentTeam.Hedgehogs[CurrentTeam.CurrHedgehog].Gear^ do
- Message:= Message and not gm_Right
-end;
-
-procedure chUp_p(var s: shortstring);
-begin
-if CheckNoTeamOrHH then exit;
-if not CurrentTeam.ExtDriven then SendIPC('U');
-with CurrentTeam.Hedgehogs[CurrentTeam.CurrHedgehog].Gear^ do
- Message:= Message or gm_Up
-end;
-
-procedure chUp_m(var s: shortstring);
-begin
-if CheckNoTeamOrHH then exit;
-if not CurrentTeam.ExtDriven then SendIPC('u');
-with CurrentTeam.Hedgehogs[CurrentTeam.CurrHedgehog].Gear^ do
- Message:= Message and not gm_Up
-end;
-
-procedure chDown_p(var s: shortstring);
-begin
-if CheckNoTeamOrHH then exit;
-if not CurrentTeam.ExtDriven then SendIPC('D');
-with CurrentTeam.Hedgehogs[CurrentTeam.CurrHedgehog].Gear^ do
- Message:= Message or gm_Down
-end;
-
-procedure chDown_m(var s: shortstring);
-begin
-if CheckNoTeamOrHH then exit;
-if not CurrentTeam.ExtDriven then SendIPC('d');
-with CurrentTeam.Hedgehogs[CurrentTeam.CurrHedgehog].Gear^ do
- Message:= Message and not gm_Down
-end;
-
-procedure chLJump(var s: shortstring);
-begin
-if CheckNoTeamOrHH then exit;
-if not CurrentTeam.ExtDriven then SendIPC('j');
-with CurrentTeam.Hedgehogs[CurrentTeam.CurrHedgehog].Gear^ do
- Message:= Message or gm_LJump
-end;
-
-procedure chHJump(var s: shortstring);
-begin
-if CheckNoTeamOrHH then exit;
-if not CurrentTeam.ExtDriven then SendIPC('J');
-with CurrentTeam.Hedgehogs[CurrentTeam.CurrHedgehog].Gear^ do
- Message:= Message or gm_HJump
-end;
-
-procedure chAttack_p(var s: shortstring);
-begin
-if CheckNoTeamOrHH then exit;
-with CurrentTeam.Hedgehogs[CurrentTeam.CurrHedgehog].Gear^ do
- begin
- {$IFDEF DEBUGFILE}AddFileLog('/+attack: Gear.State = '+inttostr(State));{$ENDIF}
- if ((State and gstHHDriven)<>0)and((State and (gstAttacked or gstHHChooseTarget or gstMoving)) = 0) then
- begin
- FollowGear:= CurrentTeam.Hedgehogs[CurrentTeam.CurrHedgehog].Gear;
- if not CurrentTeam.ExtDriven then SendIPC('A');
- Message:= Message or gm_Attack
- end
- end
-end;
-
-procedure chAttack_m(var s: shortstring);
-var xx, yy: real;
-begin
-if CheckNoTeamOrHH then exit;
-with CurrentTeam.Hedgehogs[CurrentTeam.CurrHedgehog].Gear^,
- CurrentTeam.Hedgehogs[CurrentTeam.CurrHedgehog] do
- begin
- {$IFDEF DEBUGFILE}AddFileLog('/-attack: Gear.State = '+inttostr(State)+' CurAmmoGear = '+inttostr(longword(CurAmmoGear)));{$ENDIF}
- if CurAmmoGear <> nil then
- begin
- Message:= Message and not gm_Attack;
- if not CurrentTeam.ExtDriven then SendIPC('a')
- end;
- if (((State and (gstHHDriven or gstAttacking)) = (gstHHDriven or gstAttacking))and
- ((State and (gstAttacked or gstMoving or gstHHChooseTarget)) = 0)and
- (((State and gstFalling ) = 0)or((Ammo[CurSlot, CurAmmo].Propz and ammoprop_AttackInFall) <> 0))and
- (((State and gstHHJumping) = 0)or((Ammo[CurSlot, CurAmmo].Propz and ammoprop_AttackInJump) <> 0)))and
- (CurAmmoGear = nil) then
- begin
- if (Ammo[CurSlot, CurAmmo].Propz and ammoprop_Power) <> 0 then
- begin
- StopSound(sndThrowPowerUp);
- PlaySound(sndThrowRelease);
- end;
- xx:= Sign(dX)*Sin(Angle*pi/cMaxAngle);
- yy:= -Cos(Angle*pi/cMaxAngle);
- case Ammo[CurSlot, CurAmmo].AmmoType of
- amBazooka: FollowGear:= AddGear(round(X), round(Y), gtAmmo_Grenade, 0, xx*Power/cPowerDivisor, yy*Power/cPowerDivisor);
- amGrenade: FollowGear:= AddGear(round(X), round(Y), gtAmmo_Bomb, 0, xx*Power/cPowerDivisor, yy*Power/cPowerDivisor, Ammo[CurSlot, CurAmmo].Timer);
- amUFO: FollowGear:= AddGear(round(X), round(Y), gtUFO, 0, xx*Power/cPowerDivisor, yy*Power/cPowerDivisor);
- amShotgun: begin
- PlaySound(sndShotgunReload);
- FollowGear:= AddGear(round(X + xx*20), round(Y + yy*20), gtShotgunShot, 0, xx * 0.5, 0.5 * yy);
- end;
- amSkip: TurnTimeLeft:= 0;
- amPickHammer: CurAmmoGear:= AddGear(round(Gear.X), round(Gear.Y) + cHHHalfHeight, gtPickHammer, 0);
- amRope: CurAmmoGear:= AddGear(round(Gear.X), round(Gear.Y), gtRope, 0, xx, yy);
- end;
- Power:= 0;
- if CurAmmoGear <> nil then
- begin
- CurAmmoGear.Message:= Gear.Message;
- exit
- end else
- begin
- Message:= Message and not gm_Attack;
- if not CurrentTeam.ExtDriven then SendIPC('a')
- end;
- AfterAttack
- end
- end
-end;
-
-procedure chSwitch(var s: shortstring);
-begin
-if CheckNoTeamOrHH then exit;
-if not CurrentTeam.ExtDriven then SendIPC('S');
-with CurrentTeam.Hedgehogs[CurrentTeam.CurrHedgehog].Gear^ do
- Message:= Message or gm_Switch
-end;
-
-procedure chNextTurn(var s: shortstring);
-begin
-if AllInactive then
- begin
- if not CurrentTeam.ExtDriven then SendIPC('N');
- {$IFDEF DEBUGFILE}AddFileLog('Doing SwitchHedgehog: time '+inttostr(GameTicks));{$ENDIF}
- SwitchHedgehog;
- end
-end;
-
-procedure chSay(var s: shortstring);
-begin
-WriteLnToConsole('> ' + s);
-SendIPC('s'+s)
-end;
-
-procedure chTimer(var s: shortstring);
-begin
-if (s[0] <> #1) or (s[1] < '1') or (s[1] > '5') or (CurrentTeam = nil) then exit;
-with CurrentTeam.Hedgehogs[CurrentTeam.CurrHedgehog] do
- if (Ammo[CurSlot, CurAmmo].Propz and ammoprop_Timerable) <> 0 then
- begin
- Ammo[CurSlot, CurAmmo].Timer:= 1000 * (byte(s[1]) - 48);
- with CurrentTeam^ do
- ApplyAmmoChanges(@Hedgehogs[CurrHedgehog]);
- if not CurrentTeam.ExtDriven then SendIPC(s);
- end
-end;
-
-procedure chSlot(var s: shortstring);
-var slot: LongWord;
- caSlot, caAmmo: PLongword;
-begin
-if (s[0] <> #1) or (CurrentTeam = nil) then exit;
-slot:= byte(s[1]) - 49;
-if slot > cMaxSlot then exit;
-if not CurrentTeam.ExtDriven then SendIPC(char(byte(s[1]) + 79));
-with CurrentTeam^ do
- begin
- with Hedgehogs[CurrHedgehog] do
- begin
- if ((Gear.State and (gstAttacking or gstAttacked)) <> 0) or (AttacksNum > 0)
- or ((Gear.State and gstHHDriven) = 0) then exit; // во время стрельбы исключает смену оружия
- if CurAmmoGear = nil then begin caSlot:= @CurSlot; caAmmo:= @CurAmmo end
- else begin caSlot:= @AltSlot; caAmmo:= @AltAmmo end;
- if caSlot^ = slot then
- begin
- inc(caAmmo^);
- if (caAmmo^ > cMaxSlotAmmo) or (Ammo[slot, caAmmo^].Count = 0) then caAmmo^:= 0
- end else
- if Ammo[slot, 0].Count > 0 then
- begin
- caSlot^:= slot;
- caAmmo^:= 0;
- end;
- TargetPoint.X:= NoPointX;
- end;
- ApplyAmmoChanges(@Hedgehogs[CurrHedgehog])
- end
-end;
-
-procedure chPut(var s: shortstring);
-begin
-if CheckNoTeamOrHH then exit;
-with CurrentTeam.Hedgehogs[CurrentTeam.CurrHedgehog].Gear^ do
- if (State and gstHHChooseTarget) <> 0 then
- begin
- isCursorVisible:= false;
- if not CurrentTeam.ExtDriven then
- begin
- SDL_GetMouseState(@TargetPoint.X, @TargetPoint.Y);
- dec(TargetPoint.X, WorldDx);
- dec(TargetPoint.Y, WorldDy);
- s[0]:= #9;
- s[1]:= 'p';
- PInteger(@s[2])^:= TargetPoint.X;
- PInteger(@s[6])^:= TargetPoint.Y;
- SendIPC(s)
- end;
- AdjustMPoint;
- State:= State and not gstHHChooseTarget;
- end else if CurrentTeam.ExtDriven then OutError('got /put while not being in choose target mode', true)
-end;
-
-procedure chCapture(var s: shortstring);
-begin
-flagMakeCapture:= true
-end;
-
+(*
+ * Hedgewars, a worms-like game
+ * Copyright (c) 2004, 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.
+ *)
+
+function CheckNoTeamOrHH: boolean;
+begin
+Result:= (CurrentTeam=nil) or (CurrentTeam.Hedgehogs[CurrentTeam.CurrHedgehog].Gear = nil);
+{$IFDEF DEBUGFILE}
+if Result then
+ if CurrentTeam = nil then AddFileLog('CONSOLE: CurTeam = nil')
+ else AddFileLog('CONSOLE: CurTeam <> nil, Gear = nil')
+{$ENDIF}
+end;
+////////////////////////////////////////////////////////////////////////////////
+procedure chQuit(var s: shortstring);
+begin
+GameState:= gsExit
+end;
+
+procedure chAddTeam(var s: shortstring);
+begin
+if isDeveloperMode then AddTeam;
+if GameType = gmtDemo then CurrentTeam.ExtDriven:= true
+end;
+
+procedure chTeamLocal(var s: shortstring);
+begin
+if not isDeveloperMode then exit;
+if CurrentTeam = nil then OutError(errmsgIncorrectUse + ' "/rdriven"', true);
+CurrentTeam.ExtDriven:= true
+end;
+
+procedure chName(var id: shortstring);
+var s: shortstring;
+begin
+if CurrentTeam = nil then OutError(errmsgIncorrectUse + ' "/name"', true);
+SplitBySpace(id, s);
+if s[1]='"' then Delete(s, 1, 1);
+if s[byte(s[0])]='"' then Delete(s, byte(s[0]), 1);
+if id = 'team' then CurrentTeam.TeamName:= s
+else if (id[1]='h')and(id[2]='h')and(id[3]>='0')and(id[3]<='7') then
+ CurrentTeam.Hedgehogs[byte(id[3])-48].Name:= s
+else OutError(errmsgUnknownVariable + ' "' + id + '"')
+end;
+
+procedure chGrave(var s: shortstring);
+begin
+if CurrentTeam = nil then OutError(errmsgIncorrectUse + ' "/grave"', true);
+if s[1]='"' then Delete(s, 1, 1);
+if s[byte(s[0])]='"' then Delete(s, byte(s[0]), 1);
+CurrentTeam.GraveName:= s
+end;
+
+procedure chFort(var s: shortstring);
+begin
+if CurrentTeam = nil then OutError(errmsgIncorrectUse + ' "/grave"', true);
+if s[1]='"' then Delete(s, 1, 1);
+if s[byte(s[0])]='"' then Delete(s, byte(s[0]), 1);
+CurrentTeam.FortName:= s
+end;
+
+procedure chColor(var id: shortstring);
+var c: integer;
+begin
+if CurrentTeam = nil then OutError(errmsgIncorrectUse + ' "/color"', true);
+val(id, CurrentTeam.Color, c);
+AdjustColor(CurrentTeam.Color)
+end;
+
+procedure chAdd(var id: shortstring);
+var s: shortstring;
+ c: integer;
+ Gear: PGear;
+ b: byte;
+begin
+if (not isDeveloperMode)or(CurrentTeam=nil) then exit;
+SplitBySpace(id, s);
+if (id[1]='h')and(id[2]='h')and(id[3]>='0')and(id[3]<='7') then
+ begin
+ b:= byte(id[3])-48;
+ val(s, CurrentTeam.Hedgehogs[b].BotLevel, c);
+ Gear:= AddGear(0, 0, gtHedgehog, 0);
+ Gear.Hedgehog:= @CurrentTeam.Hedgehogs[b];
+ PHedgehog(Gear.Hedgehog).Team:= CurrentTeam;
+ CurrentTeam.Hedgehogs[b].Gear:= Gear
+ end
+else OutError(errmsgUnknownVariable + ' "' + id + '"', true)
+end;
+
+procedure chBind(var id: shortstring);
+var s: shortstring;
+ b: integer;
+begin
+if CurrentTeam = nil then exit;
+SplitBySpace(id, s);
+if s[1]='"' then Delete(s, 1, 1);
+if s[byte(s[0])]='"' then Delete(s, byte(s[0]), 1);
+b:= KeyNameToCode(id);
+if b = 0 then OutError(errmsgUnknownVariable + ' "' + id + '"')
+ else CurrentTeam.Aliases[b]:= s
+end;
+
+procedure chLeft_p(var s: shortstring);
+begin
+if CheckNoTeamOrHH then exit;
+if not CurrentTeam.ExtDriven then SendIPC('L');
+with CurrentTeam.Hedgehogs[CurrentTeam.CurrHedgehog].Gear^ do
+ Message:= Message or gm_Left
+end;
+
+procedure chLeft_m(var s: shortstring);
+begin
+if CheckNoTeamOrHH then exit;
+if not CurrentTeam.ExtDriven then SendIPC('l');
+with CurrentTeam.Hedgehogs[CurrentTeam.CurrHedgehog].Gear^ do
+ Message:= Message and not gm_Left
+end;
+
+procedure chRight_p(var s: shortstring);
+begin
+if CheckNoTeamOrHH then exit;
+if not CurrentTeam.ExtDriven then SendIPC('R');
+with CurrentTeam.Hedgehogs[CurrentTeam.CurrHedgehog].Gear^ do
+ Message:= Message or gm_Right
+end;
+
+procedure chRight_m(var s: shortstring);
+begin
+if CheckNoTeamOrHH then exit;
+if not CurrentTeam.ExtDriven then SendIPC('r');
+with CurrentTeam.Hedgehogs[CurrentTeam.CurrHedgehog].Gear^ do
+ Message:= Message and not gm_Right
+end;
+
+procedure chUp_p(var s: shortstring);
+begin
+if CheckNoTeamOrHH then exit;
+if not CurrentTeam.ExtDriven then SendIPC('U');
+with CurrentTeam.Hedgehogs[CurrentTeam.CurrHedgehog].Gear^ do
+ Message:= Message or gm_Up
+end;
+
+procedure chUp_m(var s: shortstring);
+begin
+if CheckNoTeamOrHH then exit;
+if not CurrentTeam.ExtDriven then SendIPC('u');
+with CurrentTeam.Hedgehogs[CurrentTeam.CurrHedgehog].Gear^ do
+ Message:= Message and not gm_Up
+end;
+
+procedure chDown_p(var s: shortstring);
+begin
+if CheckNoTeamOrHH then exit;
+if not CurrentTeam.ExtDriven then SendIPC('D');
+with CurrentTeam.Hedgehogs[CurrentTeam.CurrHedgehog].Gear^ do
+ Message:= Message or gm_Down
+end;
+
+procedure chDown_m(var s: shortstring);
+begin
+if CheckNoTeamOrHH then exit;
+if not CurrentTeam.ExtDriven then SendIPC('d');
+with CurrentTeam.Hedgehogs[CurrentTeam.CurrHedgehog].Gear^ do
+ Message:= Message and not gm_Down
+end;
+
+procedure chLJump(var s: shortstring);
+begin
+if CheckNoTeamOrHH then exit;
+if not CurrentTeam.ExtDriven then SendIPC('j');
+with CurrentTeam.Hedgehogs[CurrentTeam.CurrHedgehog].Gear^ do
+ Message:= Message or gm_LJump
+end;
+
+procedure chHJump(var s: shortstring);
+begin
+if CheckNoTeamOrHH then exit;
+if not CurrentTeam.ExtDriven then SendIPC('J');
+with CurrentTeam.Hedgehogs[CurrentTeam.CurrHedgehog].Gear^ do
+ Message:= Message or gm_HJump
+end;
+
+procedure chAttack_p(var s: shortstring);
+begin
+if CheckNoTeamOrHH then exit;
+with CurrentTeam.Hedgehogs[CurrentTeam.CurrHedgehog].Gear^ do
+ begin
+ {$IFDEF DEBUGFILE}AddFileLog('/+attack: Gear.State = '+inttostr(State));{$ENDIF}
+ if ((State and gstHHDriven)<>0)and((State and (gstAttacked or gstHHChooseTarget or gstMoving)) = 0) then
+ begin
+ FollowGear:= CurrentTeam.Hedgehogs[CurrentTeam.CurrHedgehog].Gear;
+ if not CurrentTeam.ExtDriven then SendIPC('A');
+ Message:= Message or gm_Attack
+ end
+ end
+end;
+
+procedure chAttack_m(var s: shortstring);
+var xx, yy: real;
+begin
+if CheckNoTeamOrHH then exit;
+with CurrentTeam.Hedgehogs[CurrentTeam.CurrHedgehog].Gear^,
+ CurrentTeam.Hedgehogs[CurrentTeam.CurrHedgehog] do
+ begin
+ {$IFDEF DEBUGFILE}AddFileLog('/-attack: Gear.State = '+inttostr(State)+' CurAmmoGear = '+inttostr(longword(CurAmmoGear)));{$ENDIF}
+ if CurAmmoGear <> nil then
+ begin
+ Message:= Message and not gm_Attack;
+ if not CurrentTeam.ExtDriven then SendIPC('a')
+ end;
+ if (((State and (gstHHDriven or gstAttacking)) = (gstHHDriven or gstAttacking))and
+ ((State and (gstAttacked or gstMoving or gstHHChooseTarget)) = 0)and
+ (((State and gstFalling ) = 0)or((Ammo[CurSlot, CurAmmo].Propz and ammoprop_AttackInFall) <> 0))and
+ (((State and gstHHJumping) = 0)or((Ammo[CurSlot, CurAmmo].Propz and ammoprop_AttackInJump) <> 0)))and
+ (CurAmmoGear = nil) then
+ begin
+ if (Ammo[CurSlot, CurAmmo].Propz and ammoprop_Power) <> 0 then
+ begin
+ StopSound(sndThrowPowerUp);
+ PlaySound(sndThrowRelease);
+ end;
+ xx:= Sign(dX)*Sin(Angle*pi/cMaxAngle);
+ yy:= -Cos(Angle*pi/cMaxAngle);
+ case Ammo[CurSlot, CurAmmo].AmmoType of
+ amBazooka: FollowGear:= AddGear(round(X), round(Y), gtAmmo_Grenade, 0, xx*Power/cPowerDivisor, yy*Power/cPowerDivisor);
+ amGrenade: FollowGear:= AddGear(round(X), round(Y), gtAmmo_Bomb, 0, xx*Power/cPowerDivisor, yy*Power/cPowerDivisor, Ammo[CurSlot, CurAmmo].Timer);
+ amUFO: FollowGear:= AddGear(round(X), round(Y), gtUFO, 0, xx*Power/cPowerDivisor, yy*Power/cPowerDivisor);
+ amShotgun: begin
+ PlaySound(sndShotgunReload);
+ FollowGear:= AddGear(round(X + xx*20), round(Y + yy*20), gtShotgunShot, 0, xx * 0.5, 0.5 * yy);
+ end;
+ amSkip: TurnTimeLeft:= 0;
+ amPickHammer: CurAmmoGear:= AddGear(round(Gear.X), round(Gear.Y) + cHHHalfHeight, gtPickHammer, 0);
+ amRope: CurAmmoGear:= AddGear(round(Gear.X), round(Gear.Y), gtRope, 0, xx, yy);
+ end;
+ Power:= 0;
+ if CurAmmoGear <> nil then
+ begin
+ CurAmmoGear.Message:= Gear.Message;
+ exit
+ end else
+ begin
+ Message:= Message and not gm_Attack;
+ if not CurrentTeam.ExtDriven then SendIPC('a')
+ end;
+ AfterAttack
+ end
+ end
+end;
+
+procedure chSwitch(var s: shortstring);
+begin
+if CheckNoTeamOrHH then exit;
+if not CurrentTeam.ExtDriven then SendIPC('S');
+with CurrentTeam.Hedgehogs[CurrentTeam.CurrHedgehog].Gear^ do
+ Message:= Message or gm_Switch
+end;
+
+procedure chNextTurn(var s: shortstring);
+begin
+if AllInactive then
+ begin
+ if not CurrentTeam.ExtDriven then SendIPC('N');
+ {$IFDEF DEBUGFILE}AddFileLog('Doing SwitchHedgehog: time '+inttostr(GameTicks));{$ENDIF}
+ SwitchHedgehog;
+ end
+end;
+
+procedure chSay(var s: shortstring);
+begin
+WriteLnToConsole('> ' + s);
+SendIPC('s'+s)
+end;
+
+procedure chTimer(var s: shortstring);
+begin
+if (s[0] <> #1) or (s[1] < '1') or (s[1] > '5') or (CurrentTeam = nil) then exit;
+with CurrentTeam.Hedgehogs[CurrentTeam.CurrHedgehog] do
+ if (Ammo[CurSlot, CurAmmo].Propz and ammoprop_Timerable) <> 0 then
+ begin
+ Ammo[CurSlot, CurAmmo].Timer:= 1000 * (byte(s[1]) - 48);
+ with CurrentTeam^ do
+ ApplyAmmoChanges(@Hedgehogs[CurrHedgehog]);
+ if not CurrentTeam.ExtDriven then SendIPC(s);
+ end
+end;
+
+procedure chSlot(var s: shortstring);
+var slot: LongWord;
+ caSlot, caAmmo: PLongword;
+begin
+if (s[0] <> #1) or (CurrentTeam = nil) then exit;
+slot:= byte(s[1]) - 49;
+if slot > cMaxSlot then exit;
+if not CurrentTeam.ExtDriven then SendIPC(char(byte(s[1]) + 79));
+with CurrentTeam^ do
+ begin
+ with Hedgehogs[CurrHedgehog] do
+ begin
+ if ((Gear.State and (gstAttacking or gstAttacked)) <> 0) or (AttacksNum > 0)
+ or ((Gear.State and gstHHDriven) = 0) then exit; // во время стрельбы исключает смену оружия
+ if CurAmmoGear = nil then begin caSlot:= @CurSlot; caAmmo:= @CurAmmo end
+ else begin caSlot:= @AltSlot; caAmmo:= @AltAmmo end;
+ if caSlot^ = slot then
+ begin
+ inc(caAmmo^);
+ if (caAmmo^ > cMaxSlotAmmo) or (Ammo[slot, caAmmo^].Count = 0) then caAmmo^:= 0
+ end else
+ if Ammo[slot, 0].Count > 0 then
+ begin
+ caSlot^:= slot;
+ caAmmo^:= 0;
+ end;
+ TargetPoint.X:= NoPointX;
+ end;
+ ApplyAmmoChanges(@Hedgehogs[CurrHedgehog])
+ end
+end;
+
+procedure chPut(var s: shortstring);
+begin
+if CheckNoTeamOrHH then exit;
+with CurrentTeam.Hedgehogs[CurrentTeam.CurrHedgehog].Gear^ do
+ if (State and gstHHChooseTarget) <> 0 then
+ begin
+ isCursorVisible:= false;
+ if not CurrentTeam.ExtDriven then
+ begin
+ SDL_GetMouseState(@TargetPoint.X, @TargetPoint.Y);
+ dec(TargetPoint.X, WorldDx);
+ dec(TargetPoint.Y, WorldDy);
+ s[0]:= #9;
+ s[1]:= 'p';
+ PInteger(@s[2])^:= TargetPoint.X;
+ PInteger(@s[6])^:= TargetPoint.Y;
+ SendIPC(s)
+ end;
+ AdjustMPoint;
+ State:= State and not gstHHChooseTarget;
+ end else if CurrentTeam.ExtDriven then OutError('got /put while not being in choose target mode', true)
+end;
+
+procedure chCapture(var s: shortstring);
+begin
+flagMakeCapture:= true
+end;
+
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/hedgewars/Data/Forts/BarrelhouseL.txt Tue Aug 23 16:17:53 2005 +0000
@@ -0,0 +1,11 @@
+247 122
+19 229
+709 147
+478 294
+345 319
+218 277
+130 478
+212 936
+787 414
+797 609
+805 953
\ No newline at end of file
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/hedgewars/Data/Forts/BarrelhouseR.txt Tue Aug 23 16:17:53 2005 +0000
@@ -0,0 +1,11 @@
+776 122
+1004 229
+315 147
+545 294
+678 319
+805 277
+893 478
+811 936
+236 414
+226 609
+218 953
\ No newline at end of file
--- a/hedgewars/GSHandlers.inc Mon Aug 22 21:38:06 2005 +0000
+++ b/hedgewars/GSHandlers.inc Tue Aug 23 16:17:53 2005 +0000
@@ -1,550 +1,550 @@
-(*
- * Hedgewars, a worms-like game
- * Copyright (c) 2004, 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.
- *)
-
-procedure doStepDrowningGear(Gear: PGear); forward;
-
-function CheckGearDrowning(Gear: PGear): boolean;
-begin
-Result:= Gear.Y + Gear.HalfHeight >= cWaterLine;
-if Result then
- begin
- Gear.State:= gstDrowning;
- Gear.doStep:= doStepDrowningGear;
- PlaySound(sndSplash)
- end
-end;
-
-procedure CheckCollision(Gear: PGear);
-begin
-if TestCollisionXwithGear(Gear, Sign(Gear.X)) or TestCollisionYwithGear(Gear, Sign(Gear.Y))
- then Gear.State:= Gear.State or gstCollision
- else Gear.State:= Gear.State and not gstCollision
-end;
-
-procedure CheckHHDamage(Gear: PGear);
-begin
-if Gear.dY > 0.35 then Gear.Damage:= Gear.Damage + round(25 * (abs(Gear.dY) - 0.35));
-end;
-
-////////////////////////////////////////////////////////////////////////////////
-////////////////////////////////////////////////////////////////////////////////
-procedure CalcRotationDirAngle(Gear: PGear);
-var dAngle: real;
-begin
-dAngle:= (abs(Gear.dX) + abs(Gear.dY))*0.1;
-if Gear.dX >= 0 then Gear.DirAngle:= Gear.DirAngle + dAngle
- else Gear.DirAngle:= Gear.DirAngle - dAngle;
-if Gear.DirAngle < 0 then Gear.DirAngle:= Gear.DirAngle + 16
-else if Gear.DirAngle >= 16 then Gear.DirAngle:= Gear.DirAngle - 16
-end;
-
-////////////////////////////////////////////////////////////////////////////////
-procedure doStepDrowningGear(Gear: PGear);
-begin
-AllInactive:= false;
-Gear.Y:= Gear.Y + cDrownSpeed;
-if round(Gear.Y) > Gear.HalfHeight + cWaterLine + 48 + cVisibleWater then DeleteGear(Gear)
-end;
-
-////////////////////////////////////////////////////////////////////////////////
-procedure doStepFallingGear(Gear: PGear);
-var b: boolean;
-begin
-if TestCollisionYwithGear(Gear, Sign(Gear.dY)) then
- begin
- Gear.dX:= Gear.dX * Gear.Friction;
- Gear.dY:= - Gear.dY * Gear.Elasticity;
- b:= false
- end else b:= true;
-if TestCollisionXwithGear(Gear, Sign(Gear.dX)) then
- begin
- Gear.dX:= - Gear.dX * Gear.Elasticity;
-// Gear.dY:= Gear.dY;
- b:= false
- end;
-if b then
- begin
- Gear.dY:= Gear.dY + cGravity;
- Gear.State:= Gear.State and not gstCollision
- end else
- begin
- if sqr(Gear.dX) + sqr(Gear.dY) < 0.00001 then
- if (Gear.Timer = 0) then Gear.Active:= false
- else begin
- Gear.dX:= 0;
- Gear.dY:= 0
- end;
- Gear.State:= Gear.State or gstCollision
- end;
-Gear.X:= Gear.X + Gear.dX;
-Gear.Y:= Gear.Y + Gear.dY;
-CheckGearDrowning(Gear);
-if (sqr(Gear.dX) + sqr(Gear.dY) < 0.003) then Gear.State:= Gear.State and not gstMoving
- else Gear.State:= Gear.State or gstMoving
-end;
-
-////////////////////////////////////////////////////////////////////////////////
-procedure doStepCloud(Gear: PGear);
-begin
-Gear.X:= Gear.X + cWindSpeed * 200 + Gear.dX;
-if Gear.X < -cScreenWidth-256 then Gear.X:= cScreenWidth + 2048 else
-if Gear.X > cScreenWidth + 2048 then Gear.X:= -cScreenWidth - 256
-end;
-
-////////////////////////////////////////////////////////////////////////////////
-procedure doStepBomb(Gear: PGear);
-begin
-AllInactive:= false;
-doStepFallingGear(Gear);
-dec(Gear.Timer);
-if Gear.Timer = 0 then
- begin
- doMakeExplosion(round(Gear.X), round(Gear.Y), 50, EXPLAutoSound);
- DeleteGear(Gear);
- SetAllToActive;
- exit
- end;
-CalcRotationDirAngle(Gear);
-if (Gear.State and (gstCollision or gstMoving)) = (gstCollision or gstMoving) then PlaySound(sndGrenadeImpact)
-end;
-
-////////////////////////////////////////////////////////////////////////////////
-procedure doStepGrenade(Gear: PGear);
-begin
-AllInactive:= false;
-Gear.dX:= Gear.dX + cWindSpeed;
-doStepFallingGear(Gear);
-if (Gear.State and gstCollision) <> 0 then
- begin
- doMakeExplosion(round(Gear.X), round(Gear.Y), 50, EXPLAutoSound);
- DeleteGear(Gear);
- SetAllToActive;
- exit
- end;
-if (GameTicks and $3F) = 0 then
- AddGear(round(Gear.X), round(Gear.Y), gtSmokeTrace, 0)
-end;
-
-////////////////////////////////////////////////////////////////////////////////
-procedure doStepHealthTag(Gear: PGear);
-begin
-AllInactive:= false;
-dec(Gear.Timer);
-Gear.Y:= Gear.Y - 0.07;
-if Gear.Timer = 0 then
- begin
- PHedgehog(Gear.Hedgehog).Gear.Active:= true;
- DeleteGear(Gear)
- end
-end;
-
-////////////////////////////////////////////////////////////////////////////////
-procedure doStepGrave(Gear: PGear);
-begin
-AllInactive:= false;
-if Gear.dY < 0 then
- if TestCollisionY(Gear, -1) then Gear.dY:= 0;
-
-if Gear.dY >=0 then
- if TestCollisionY(Gear, 1) then
- begin
- Gear.dY:= - Gear.dY * Gear.Elasticity;
- if Gear.dY > - 0.001 then
- begin
- Gear.Active:= false;
- exit
- end else if Gear.dY < - 0.03 then PlaySound(sndGraveImpact)
- end;
-Gear.Y:= Gear.Y + Gear.dY;
-CheckGearDrowning(Gear);
-Gear.dY:= Gear.dY + cGravity
-end;
-
-////////////////////////////////////////////////////////////////////////////////
-procedure doStepUFOWork(Gear: PGear);
-var t: real;
-begin
-AllInactive:= false;
-t:= sqrt(sqr(Gear.dX) + sqr(Gear.dY));
-Gear.dX:= Gear.Elasticity * (Gear.dX + 0.000004 * (TargetPoint.X - trunc(Gear.X)));
-Gear.dY:= Gear.Elasticity * (Gear.dY + 0.000004 * (TargetPoint.Y - trunc(Gear.Y)));
-t:= t / (sqrt(sqr(Gear.dX) + sqr(Gear.dY)));
-Gear.dX:= Gear.dX * t;
-Gear.dY:= Gear.dY * t;
-Gear.X:= Gear.X + Gear.dX;
-Gear.Y:= Gear.Y + Gear.dY;
-CheckCollision(Gear);
-dec(Gear.Timer);
-if ((Gear.State and gstCollision) <> 0) or (Gear.Timer = 0) then
- begin
- doMakeExplosion(round(Gear.X), round(Gear.Y), 50, EXPLAutoSound);
- DeleteGear(Gear);
- SetAllToActive
- end;
-end;
-
-procedure doStepUFO(Gear: PGear);
-begin
-AllInactive:= false;
-Gear.X:= Gear.X + Gear.dX;
-Gear.Y:= Gear.Y + Gear.dY;
-Gear.dY:= Gear.dY + cGravity;
-CheckCollision(Gear);
-if (Gear.State and gstCollision) <> 0 then
- begin
- doMakeExplosion(round(Gear.X), round(Gear.Y), 50, EXPLAutoSound);
- DeleteGear(Gear);
- SetAllToActive;
- exit
- end;
-dec(Gear.Timer);
-if Gear.Timer = 0 then
- begin
- Gear.Timer:= 5000;
- Gear.doStep:= doStepUFOWork
- end;
-end;
-
-////////////////////////////////////////////////////////////////////////////////
-procedure doStepShotgunShot(Gear: PGear);
-var i: LongWord;
-begin
-AllInactive:= false;
-if Gear.Timer > 0 then
- begin
- dec(Gear.Timer);
- if Gear.Timer = 1 then PlaySound(sndShotgunFire);
- exit
- end;
-i:= 200;
-repeat
-Gear.X:= Gear.X + Gear.dX;
-Gear.Y:= Gear.Y + Gear.dY;
-CheckCollision(Gear);
-if (Gear.State and gstCollision) <> 0 then
- begin
- doMakeExplosion(round(Gear.X), round(Gear.Y), 25, EXPLAllDamageInRadius);
- DeleteGear(Gear);
- SetAllToActive;
- exit
- end;
-dec(i)
-until i = 0;
-if (Gear.X < 0) or (Gear.Y < 0) or (Gear.X > 2048) or (Gear.Y > 1024) then
- DeleteGear(Gear)
-end;
-
-////////////////////////////////////////////////////////////////////////////////
-procedure doStepActionTimer(Gear: PGear);
-begin
-dec(Gear.Timer);
-case Gear.State of
- gtsStartGame: begin
- AllInactive:= false;
- if Gear.Timer > 0 then exit;
- AddCaption('Let''s fight!', $FFFFFF, capgrpStartGame);
- DeleteGear(Gear)
- end;
- end;
-end;
-
-////////////////////////////////////////////////////////////////////////////////
-procedure doStepPickHammerWork(Gear: PGear);
-var i, ei: integer;
- HHGear: PGear;
-begin
-Allinactive:= false;
-dec(Gear.Timer);
-if (Gear.Timer = 0)or((Gear.Message and gm_Destroy) <> 0) then
- begin
- DeleteGear(Gear);
- AfterAttack;
- SetAllToActive;
- exit
- end;
-HHGear:= PHedgehog(Gear.Hedgehog).Gear;
-if (Gear.Timer and $3F) = 0 then
- begin
- i:= round(Gear.X) - Gear.HalfWidth - GetRandom(2);
- ei:= round(Gear.X) + Gear.HalfWidth + GetRandom(2);
- while i <= ei do
- begin
- doMakeExplosion(i, round(Gear.Y) + 3, 3, 0);
- inc(i, 1)
- end;
- SetAllToActive;
- Gear.X:= Gear.X + Gear.dX;
- Gear.Y:= Gear.Y + 1.9
- end;
-if TestCollisionYwithGear(Gear, 1) then
- begin
- Gear.dY:= 0;
- HHGear.dX:= 0.0000001 * Sign(PGear(Gear.Hedgehog).dX);
- HHGear.dY:= 0;
- end else
- begin
- Gear.dY:= Gear.dY + cGravity;
- Gear.Y:= Gear.Y + Gear.dY;
- if Gear.Y > 1024 then Gear.Timer:= 1
- end;
-
-Gear.X:= Gear.X + HHGear.dX;
-HHGear.X:= Gear.X;
-HHGear.Y:= Gear.Y - cHHHalfHeight;
-
-if (Gear.Message and gm_Attack) <> 0 then
- if (Gear.State and gsttmpFlag) <> 0 then Gear.Timer:= 1 else else
- if (Gear.State and gsttmpFlag) = 0 then Gear.State:= Gear.State or gsttmpFlag;
-if ((Gear.Message and gm_Left) <> 0) then Gear.dX:= -0.3 else
- if ((Gear.Message and gm_Right) <> 0) then Gear.dX:= 0.3
- else Gear.dX:= 0;
-end;
-
-procedure doStepPickHammer(Gear: PGear);
-var i, y: integer;
- ar: TRangeArray;
-begin
-i:= 0;
-y:= round(Gear.Y) - cHHHalfHeight*2;
-while y < round(Gear.Y) do
- begin
- ar[i].Left := round(Gear.X) - Gear.HalfWidth - GetRandom(2);
- ar[i].Right:= round(Gear.X) + Gear.HalfWidth + GetRandom(2);
- inc(y, 2);
- inc(i)
- end;
-DrawLineExplosions(@ar, 3, round(Gear.Y) - cHHHalfHeight*2, 2, Pred(i));
-Gear.dY:= PHedgehog(Gear.Hedgehog).Gear.dY;
-doStepPickHammerWork(Gear);
-Gear.doStep:= doStepPickHammerWork
-end;
-
-////////////////////////////////////////////////////////////////////////////////
-procedure doStepRopeWork(Gear: PGear);
-const pidiv2: real = pi/2;
- flCheck: boolean = false;
-var HHGear: PGear;
- len, cs, cc, tx, ty: real;
- lx, ly: integer;
-
- procedure DeleteMe;
- begin
- with HHGear^ do
- begin
- Message:= Message and not gm_Attack;
- State:= State or gstFalling;
- end;
- DeleteGear(Gear);
- OnUsedAmmo(PHedgehog(Gear.Hedgehog)^.Ammo);
- ApplyAmmoChanges(PHedgehog(Gear.Hedgehog))
- end;
-
-begin
-HHGear:= PHedgehog(Gear.Hedgehog).Gear;
-if (HHGear.State and gstHHDriven) = 0 then
- begin
- DeleteMe;
- exit
- end;
-Gear.dX:= HHGear.X - Gear.X;
-Gear.dY:= HHGear.Y - Gear.Y;
-
-if (Gear.Message and gm_Left <> 0) then HHGear.dX:= HHGear.dX - 0.0002 else
-if (Gear.Message and gm_Right <> 0) then HHGear.dX:= HHGear.dX + 0.0002;
-
-if not TestCollisionYwithGear(HHGear, 1) then HHGear.dY:= HHGear.dY + cGravity;
-
-HHGear.DirAngle:= arctan(Gear.dY + HHGear.dY, Gear.dX + HHGear.dX);
-cs:= sin(HHGear.DirAngle);
-cc:= cos(HHGear.DirAngle);
-
-flCheck:= not flCheck;
-if flCheck then // check whether rope needs dividing
- begin
- len:= Gear.Elasticity - 20;
- while len > 5 do
- begin
- tx:= cc*len;
- ty:= cs*len;
-// if TestCollisionXwithXYShift(Gear, round(tx), round(ty), Sign(HHGear.dX))
-/// or TestCollisionYwithXYShift(Gear, round(tx), round(ty), Sign(HHGear.dY)) then
- lx:= round(Gear.X + tx) + sign(HHGear.dX);
- ly:= round(Gear.Y + ty) + sign(HHGear.dY);
- if ((ly and $FFFFFC00) = 0) and ((lx and $FFFFF800) = 0)and (Land[ly, lx] <> 0) then
- begin
- with RopePoints.ar[RopePoints.Count] do
- begin
- X:= Gear.X;
- Y:= Gear.Y;
- if RopePoints.Count = 0 then RopePoints.HookAngle:= DxDy2Angle32(Gear.dY, Gear.dX);
- b:= (cc * HHGear.dY) > (cs * HHGear.dX);
- dLen:= len
- end;
- Gear.X:= Gear.X + tx;
- Gear.Y:= Gear.Y + ty;
- inc(RopePoints.Count);
- Gear.Elasticity:= Gear.Elasticity - len;
- Gear.Friction:= Gear.Friction - len;
- break
- end;
- len:= len - 3
- end;
- end else
- if RopePoints.Count > 0 then // check whether the last dividing point could be removed
- begin
- tx:= RopePoints.ar[Pred(RopePoints.Count)].X;
- ty:= RopePoints.ar[Pred(RopePoints.Count)].Y;
- if RopePoints.ar[Pred(RopePoints.Count)].b xor ((tx - Gear.X) * (ty - HHGear.Y) > (tx - HHGear.X) * (ty - Gear.Y)) then
- begin
- dec(RopePoints.Count);
- Gear.X:=RopePoints.ar[RopePoints.Count].X;
- Gear.Y:=RopePoints.ar[RopePoints.Count].Y;
- Gear.Elasticity:= Gear.Elasticity + RopePoints.ar[RopePoints.Count].dLen;
- Gear.Friction:= Gear.Friction + RopePoints.ar[RopePoints.Count].dLen
- end
- end;
-
-Gear.dX:= HHGear.X - Gear.X;
-Gear.dY:= HHGear.Y - Gear.Y;
-HHGear.DirAngle:= arctan(Gear.dY + HHGear.dY, Gear.dX + HHGear.dX);
-cs:= sin(HHGear.DirAngle);
-cc:= cos(HHGear.DirAngle);
-
-HHGear.dX:= HHGear.X;
-HHGear.dY:= HHGear.Y;
-
-if ((Gear.Message and gm_Down) <> 0) and (Gear.Elasticity < Gear.Friction) then
- if not (TestCollisionXwithGear(HHGear, Sign(Gear.dX))
- or TestCollisionYwithGear(HHGear, Sign(Gear.dY))) then Gear.Elasticity:= Gear.Elasticity + 0.3;
-
-if ((Gear.Message and gm_Up) <> 0) and (Gear.Elasticity > 30) then
- if not (TestCollisionXwithGear(HHGear, -Sign(Gear.dX))
- or TestCollisionYwithGear(HHGear, -Sign(Gear.dY))) then Gear.Elasticity:= Gear.Elasticity - 0.3;
-
-HHGear.X:= Gear.X + cc*Gear.Elasticity;
-HHGear.Y:= Gear.Y + cs*Gear.Elasticity;
-
-HHGear.dX:= HHGear.X - HHGear.dX;
-HHGear.dY:= HHGear.Y - HHGear.dY;
-
-if TestCollisionXwithGear(HHGear, Sign(HHGear.dX)) then
- HHGear.dX:= -0.9 * HHGear.dX;
-if TestCollisionYwithGear(HHGear, Sign(HHGear.dY)) then
- HHGear.dY:= -0.9 * HHGear.dY;
-
-if (Gear.Message and gm_Attack) <> 0 then
- if (Gear.State and gsttmpFlag) <> 0 then DeleteMe else
-else if (Gear.State and gsttmpFlag) = 0 then Gear.State:= Gear.State or gsttmpFlag;
-end;
-
-
-procedure doStepRopeAttach(Gear: PGear);
-var HHGear: PGear;
- tx, ty, tt: real;
-begin
-Gear.X:= Gear.X + Gear.dX;
-Gear.Y:= Gear.Y + Gear.dY;
-Gear.Elasticity:= Gear.Elasticity + 1.0;
-HHGear:= PHedgehog(Gear.Hedgehog)^.Gear;
-if (HHGear.State and gstFalling) <> 0 then
- if HHTestCollisionYwithGear(HHGear, 1) then
- begin
- HHGear.dY:= 0;
- CheckHHDamage(HHGear);
- HHGear.State:= HHGear.State and not (gstFalling or gstHHJumping);
- end else
- begin
- if TestCollisionXwithGear(HHGear, Sign(HHGear.dX)) then HHGear.dX:= 0.0000001 * Sign(HHGear.dX);
- HHGear.X:= HHGear.X + HHGear.dX;
- HHGear.Y:= HHGear.Y + HHGear.dY;
- Gear.X:= Gear.X + HHGear.dX;
- Gear.Y:= Gear.Y + HHGear.dY;
- HHGear.dY:= HHGear.dY + cGravity;
- tt:= Gear.Elasticity;
- tx:= 0;
- ty:= 0;
- while tt > 20 do
- begin
- if TestCollisionXwithXYShift(Gear, round(tx), round(ty), Sign(Gear.dX))
- or TestCollisionYwithXYShift(Gear, round(tx), round(ty), Sign(Gear.dY)) then
- begin
- Gear.X:= Gear.X + tx;
- Gear.Y:= Gear.Y + ty;
- Gear.Elasticity:= tt;
- Gear.doStep:= doStepRopeWork;
- with HHGear^ do State:= State and not gstAttacking;
- tt:= 0
- end;
- tx:= tx - Gear.dX - Gear.dX;
- ty:= ty - Gear.dY - Gear.dY;
- tt:= tt - 2.0;
- end;
- end;
-CheckCollision(Gear);
-if (Gear.State and gstCollision) <> 0 then
- begin
- Gear.doStep:= doStepRopeWork;
- with HHGear^ do State:= State and not gstAttacking;
- if Gear.Elasticity < 10 then
- Gear.Elasticity:= 10000;
- end;
-
-if (Gear.Elasticity >= Gear.Friction) or ((Gear.Message and gm_Attack) = 0) then
- begin
- with PHedgehog(Gear.Hedgehog).Gear^ do
- begin
- State:= State and not gstAttacking;
- Message:= Message and not gm_Attack
- end;
- DeleteGear(Gear)
- end
-end;
-
-procedure doStepRope(Gear: PGear);
-begin
-Gear.doStep:= doStepRopeAttach
-end;
-
-////////////////////////////////////////////////////////////////////////////////
-procedure doStepSmokeTrace(Gear: PGear);
-begin
-inc(Gear.Timer);
-if Gear.Timer > 64 then
- begin
- Gear.Timer:= 0;
- dec(Gear.Tag)
- end;
-Gear.dX:= Gear.dX + cWindSpeed;
-Gear.X:= Gear.X + Gear.dX;
-if Gear.Tag = 0 then DeleteGear(Gear)
-end;
+(*
+ * Hedgewars, a worms-like game
+ * Copyright (c) 2004, 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.
+ *)
+
+procedure doStepDrowningGear(Gear: PGear); forward;
+
+function CheckGearDrowning(Gear: PGear): boolean;
+begin
+Result:= Gear.Y + Gear.HalfHeight >= cWaterLine;
+if Result then
+ begin
+ Gear.State:= gstDrowning;
+ Gear.doStep:= doStepDrowningGear;
+ PlaySound(sndSplash)
+ end
+end;
+
+procedure CheckCollision(Gear: PGear);
+begin
+if TestCollisionXwithGear(Gear, Sign(Gear.X)) or TestCollisionYwithGear(Gear, Sign(Gear.Y))
+ then Gear.State:= Gear.State or gstCollision
+ else Gear.State:= Gear.State and not gstCollision
+end;
+
+procedure CheckHHDamage(Gear: PGear);
+begin
+if Gear.dY > 0.35 then Gear.Damage:= Gear.Damage + round(25 * (abs(Gear.dY) - 0.35));
+end;
+
+////////////////////////////////////////////////////////////////////////////////
+////////////////////////////////////////////////////////////////////////////////
+procedure CalcRotationDirAngle(Gear: PGear);
+var dAngle: real;
+begin
+dAngle:= (abs(Gear.dX) + abs(Gear.dY))*0.1;
+if Gear.dX >= 0 then Gear.DirAngle:= Gear.DirAngle + dAngle
+ else Gear.DirAngle:= Gear.DirAngle - dAngle;
+if Gear.DirAngle < 0 then Gear.DirAngle:= Gear.DirAngle + 16
+else if Gear.DirAngle >= 16 then Gear.DirAngle:= Gear.DirAngle - 16
+end;
+
+////////////////////////////////////////////////////////////////////////////////
+procedure doStepDrowningGear(Gear: PGear);
+begin
+AllInactive:= false;
+Gear.Y:= Gear.Y + cDrownSpeed;
+if round(Gear.Y) > Gear.HalfHeight + cWaterLine + 48 + cVisibleWater then DeleteGear(Gear)
+end;
+
+////////////////////////////////////////////////////////////////////////////////
+procedure doStepFallingGear(Gear: PGear);
+var b: boolean;
+begin
+if TestCollisionYwithGear(Gear, Sign(Gear.dY)) then
+ begin
+ Gear.dX:= Gear.dX * Gear.Friction;
+ Gear.dY:= - Gear.dY * Gear.Elasticity;
+ b:= false
+ end else b:= true;
+if TestCollisionXwithGear(Gear, Sign(Gear.dX)) then
+ begin
+ Gear.dX:= - Gear.dX * Gear.Elasticity;
+// Gear.dY:= Gear.dY;
+ b:= false
+ end;
+if b then
+ begin
+ Gear.dY:= Gear.dY + cGravity;
+ Gear.State:= Gear.State and not gstCollision
+ end else
+ begin
+ if sqr(Gear.dX) + sqr(Gear.dY) < 0.00001 then
+ if (Gear.Timer = 0) then Gear.Active:= false
+ else begin
+ Gear.dX:= 0;
+ Gear.dY:= 0
+ end;
+ Gear.State:= Gear.State or gstCollision
+ end;
+Gear.X:= Gear.X + Gear.dX;
+Gear.Y:= Gear.Y + Gear.dY;
+CheckGearDrowning(Gear);
+if (sqr(Gear.dX) + sqr(Gear.dY) < 0.003) then Gear.State:= Gear.State and not gstMoving
+ else Gear.State:= Gear.State or gstMoving
+end;
+
+////////////////////////////////////////////////////////////////////////////////
+procedure doStepCloud(Gear: PGear);
+begin
+Gear.X:= Gear.X + cWindSpeed * 200 + Gear.dX;
+if Gear.X < -cScreenWidth-256 then Gear.X:= cScreenWidth + 2048 else
+if Gear.X > cScreenWidth + 2048 then Gear.X:= -cScreenWidth - 256
+end;
+
+////////////////////////////////////////////////////////////////////////////////
+procedure doStepBomb(Gear: PGear);
+begin
+AllInactive:= false;
+doStepFallingGear(Gear);
+dec(Gear.Timer);
+if Gear.Timer = 0 then
+ begin
+ doMakeExplosion(round(Gear.X), round(Gear.Y), 50, EXPLAutoSound);
+ DeleteGear(Gear);
+ SetAllToActive;
+ exit
+ end;
+CalcRotationDirAngle(Gear);
+if (Gear.State and (gstCollision or gstMoving)) = (gstCollision or gstMoving) then PlaySound(sndGrenadeImpact)
+end;
+
+////////////////////////////////////////////////////////////////////////////////
+procedure doStepGrenade(Gear: PGear);
+begin
+AllInactive:= false;
+Gear.dX:= Gear.dX + cWindSpeed;
+doStepFallingGear(Gear);
+if (Gear.State and gstCollision) <> 0 then
+ begin
+ doMakeExplosion(round(Gear.X), round(Gear.Y), 50, EXPLAutoSound);
+ DeleteGear(Gear);
+ SetAllToActive;
+ exit
+ end;
+if (GameTicks and $3F) = 0 then
+ AddGear(round(Gear.X), round(Gear.Y), gtSmokeTrace, 0)
+end;
+
+////////////////////////////////////////////////////////////////////////////////
+procedure doStepHealthTag(Gear: PGear);
+begin
+AllInactive:= false;
+dec(Gear.Timer);
+Gear.Y:= Gear.Y - 0.07;
+if Gear.Timer = 0 then
+ begin
+ PHedgehog(Gear.Hedgehog).Gear.Active:= true;
+ DeleteGear(Gear)
+ end
+end;
+
+////////////////////////////////////////////////////////////////////////////////
+procedure doStepGrave(Gear: PGear);
+begin
+AllInactive:= false;
+if Gear.dY < 0 then
+ if TestCollisionY(Gear, -1) then Gear.dY:= 0;
+
+if Gear.dY >=0 then
+ if TestCollisionY(Gear, 1) then
+ begin
+ Gear.dY:= - Gear.dY * Gear.Elasticity;
+ if Gear.dY > - 0.001 then
+ begin
+ Gear.Active:= false;
+ exit
+ end else if Gear.dY < - 0.03 then PlaySound(sndGraveImpact)
+ end;
+Gear.Y:= Gear.Y + Gear.dY;
+CheckGearDrowning(Gear);
+Gear.dY:= Gear.dY + cGravity
+end;
+
+////////////////////////////////////////////////////////////////////////////////
+procedure doStepUFOWork(Gear: PGear);
+var t: real;
+begin
+AllInactive:= false;
+t:= sqrt(sqr(Gear.dX) + sqr(Gear.dY));
+Gear.dX:= Gear.Elasticity * (Gear.dX + 0.000004 * (TargetPoint.X - trunc(Gear.X)));
+Gear.dY:= Gear.Elasticity * (Gear.dY + 0.000004 * (TargetPoint.Y - trunc(Gear.Y)));
+t:= t / (sqrt(sqr(Gear.dX) + sqr(Gear.dY)));
+Gear.dX:= Gear.dX * t;
+Gear.dY:= Gear.dY * t;
+Gear.X:= Gear.X + Gear.dX;
+Gear.Y:= Gear.Y + Gear.dY;
+CheckCollision(Gear);
+dec(Gear.Timer);
+if ((Gear.State and gstCollision) <> 0) or (Gear.Timer = 0) then
+ begin
+ doMakeExplosion(round(Gear.X), round(Gear.Y), 50, EXPLAutoSound);
+ DeleteGear(Gear);
+ SetAllToActive
+ end;
+end;
+
+procedure doStepUFO(Gear: PGear);
+begin
+AllInactive:= false;
+Gear.X:= Gear.X + Gear.dX;
+Gear.Y:= Gear.Y + Gear.dY;
+Gear.dY:= Gear.dY + cGravity;
+CheckCollision(Gear);
+if (Gear.State and gstCollision) <> 0 then
+ begin
+ doMakeExplosion(round(Gear.X), round(Gear.Y), 50, EXPLAutoSound);
+ DeleteGear(Gear);
+ SetAllToActive;
+ exit
+ end;
+dec(Gear.Timer);
+if Gear.Timer = 0 then
+ begin
+ Gear.Timer:= 5000;
+ Gear.doStep:= doStepUFOWork
+ end;
+end;
+
+////////////////////////////////////////////////////////////////////////////////
+procedure doStepShotgunShot(Gear: PGear);
+var i: LongWord;
+begin
+AllInactive:= false;
+if Gear.Timer > 0 then
+ begin
+ dec(Gear.Timer);
+ if Gear.Timer = 1 then PlaySound(sndShotgunFire);
+ exit
+ end;
+i:= 200;
+repeat
+Gear.X:= Gear.X + Gear.dX;
+Gear.Y:= Gear.Y + Gear.dY;
+CheckCollision(Gear);
+if (Gear.State and gstCollision) <> 0 then
+ begin
+ doMakeExplosion(round(Gear.X), round(Gear.Y), 25, EXPLAllDamageInRadius);
+ DeleteGear(Gear);
+ SetAllToActive;
+ exit
+ end;
+dec(i)
+until i = 0;
+if (Gear.X < 0) or (Gear.Y < 0) or (Gear.X > 2048) or (Gear.Y > 1024) then
+ DeleteGear(Gear)
+end;
+
+////////////////////////////////////////////////////////////////////////////////
+procedure doStepActionTimer(Gear: PGear);
+begin
+dec(Gear.Timer);
+case Gear.State of
+ gtsStartGame: begin
+ AllInactive:= false;
+ if Gear.Timer > 0 then exit;
+ AddCaption('Let''s fight!', $FFFFFF, capgrpStartGame);
+ DeleteGear(Gear)
+ end;
+ end;
+end;
+
+////////////////////////////////////////////////////////////////////////////////
+procedure doStepPickHammerWork(Gear: PGear);
+var i, ei: integer;
+ HHGear: PGear;
+begin
+Allinactive:= false;
+dec(Gear.Timer);
+if (Gear.Timer = 0)or((Gear.Message and gm_Destroy) <> 0) then
+ begin
+ DeleteGear(Gear);
+ AfterAttack;
+ SetAllToActive;
+ exit
+ end;
+HHGear:= PHedgehog(Gear.Hedgehog).Gear;
+if (Gear.Timer and $3F) = 0 then
+ begin
+ i:= round(Gear.X) - Gear.HalfWidth - GetRandom(2);
+ ei:= round(Gear.X) + Gear.HalfWidth + GetRandom(2);
+ while i <= ei do
+ begin
+ doMakeExplosion(i, round(Gear.Y) + 3, 3, 0);
+ inc(i, 1)
+ end;
+ SetAllToActive;
+ Gear.X:= Gear.X + Gear.dX;
+ Gear.Y:= Gear.Y + 1.9
+ end;
+if TestCollisionYwithGear(Gear, 1) then
+ begin
+ Gear.dY:= 0;
+ HHGear.dX:= 0.0000001 * Sign(PGear(Gear.Hedgehog).dX);
+ HHGear.dY:= 0;
+ end else
+ begin
+ Gear.dY:= Gear.dY + cGravity;
+ Gear.Y:= Gear.Y + Gear.dY;
+ if Gear.Y > 1024 then Gear.Timer:= 1
+ end;
+
+Gear.X:= Gear.X + HHGear.dX;
+HHGear.X:= Gear.X;
+HHGear.Y:= Gear.Y - cHHHalfHeight;
+
+if (Gear.Message and gm_Attack) <> 0 then
+ if (Gear.State and gsttmpFlag) <> 0 then Gear.Timer:= 1 else else
+ if (Gear.State and gsttmpFlag) = 0 then Gear.State:= Gear.State or gsttmpFlag;
+if ((Gear.Message and gm_Left) <> 0) then Gear.dX:= -0.3 else
+ if ((Gear.Message and gm_Right) <> 0) then Gear.dX:= 0.3
+ else Gear.dX:= 0;
+end;
+
+procedure doStepPickHammer(Gear: PGear);
+var i, y: integer;
+ ar: TRangeArray;
+begin
+i:= 0;
+y:= round(Gear.Y) - cHHHalfHeight*2;
+while y < round(Gear.Y) do
+ begin
+ ar[i].Left := round(Gear.X) - Gear.HalfWidth - GetRandom(2);
+ ar[i].Right:= round(Gear.X) + Gear.HalfWidth + GetRandom(2);
+ inc(y, 2);
+ inc(i)
+ end;
+DrawLineExplosions(@ar, 3, round(Gear.Y) - cHHHalfHeight*2, 2, Pred(i));
+Gear.dY:= PHedgehog(Gear.Hedgehog).Gear.dY;
+doStepPickHammerWork(Gear);
+Gear.doStep:= doStepPickHammerWork
+end;
+
+////////////////////////////////////////////////////////////////////////////////
+procedure doStepRopeWork(Gear: PGear);
+const pidiv2: real = pi/2;
+ flCheck: boolean = false;
+var HHGear: PGear;
+ len, cs, cc, tx, ty: real;
+ lx, ly: integer;
+
+ procedure DeleteMe;
+ begin
+ with HHGear^ do
+ begin
+ Message:= Message and not gm_Attack;
+ State:= State or gstFalling;
+ end;
+ DeleteGear(Gear);
+ OnUsedAmmo(PHedgehog(Gear.Hedgehog)^.Ammo);
+ ApplyAmmoChanges(PHedgehog(Gear.Hedgehog))
+ end;
+
+begin
+HHGear:= PHedgehog(Gear.Hedgehog).Gear;
+if (HHGear.State and gstHHDriven) = 0 then
+ begin
+ DeleteMe;
+ exit
+ end;
+Gear.dX:= HHGear.X - Gear.X;
+Gear.dY:= HHGear.Y - Gear.Y;
+
+if (Gear.Message and gm_Left <> 0) then HHGear.dX:= HHGear.dX - 0.0002 else
+if (Gear.Message and gm_Right <> 0) then HHGear.dX:= HHGear.dX + 0.0002;
+
+if not TestCollisionYwithGear(HHGear, 1) then HHGear.dY:= HHGear.dY + cGravity;
+
+HHGear.DirAngle:= arctan(Gear.dY + HHGear.dY, Gear.dX + HHGear.dX);
+cs:= sin(HHGear.DirAngle);
+cc:= cos(HHGear.DirAngle);
+
+flCheck:= not flCheck;
+if flCheck then // check whether rope needs dividing
+ begin
+ len:= Gear.Elasticity - 20;
+ while len > 5 do
+ begin
+ tx:= cc*len;
+ ty:= cs*len;
+// if TestCollisionXwithXYShift(Gear, round(tx), round(ty), Sign(HHGear.dX))
+/// or TestCollisionYwithXYShift(Gear, round(tx), round(ty), Sign(HHGear.dY)) then
+ lx:= round(Gear.X + tx) + sign(HHGear.dX);
+ ly:= round(Gear.Y + ty) + sign(HHGear.dY);
+ if ((ly and $FFFFFC00) = 0) and ((lx and $FFFFF800) = 0)and (Land[ly, lx] <> 0) then
+ begin
+ with RopePoints.ar[RopePoints.Count] do
+ begin
+ X:= Gear.X;
+ Y:= Gear.Y;
+ if RopePoints.Count = 0 then RopePoints.HookAngle:= DxDy2Angle32(Gear.dY, Gear.dX);
+ b:= (cc * HHGear.dY) > (cs * HHGear.dX);
+ dLen:= len
+ end;
+ Gear.X:= Gear.X + tx;
+ Gear.Y:= Gear.Y + ty;
+ inc(RopePoints.Count);
+ Gear.Elasticity:= Gear.Elasticity - len;
+ Gear.Friction:= Gear.Friction - len;
+ break
+ end;
+ len:= len - 3
+ end;
+ end else
+ if RopePoints.Count > 0 then // check whether the last dividing point could be removed
+ begin
+ tx:= RopePoints.ar[Pred(RopePoints.Count)].X;
+ ty:= RopePoints.ar[Pred(RopePoints.Count)].Y;
+ if RopePoints.ar[Pred(RopePoints.Count)].b xor ((tx - Gear.X) * (ty - HHGear.Y) > (tx - HHGear.X) * (ty - Gear.Y)) then
+ begin
+ dec(RopePoints.Count);
+ Gear.X:=RopePoints.ar[RopePoints.Count].X;
+ Gear.Y:=RopePoints.ar[RopePoints.Count].Y;
+ Gear.Elasticity:= Gear.Elasticity + RopePoints.ar[RopePoints.Count].dLen;
+ Gear.Friction:= Gear.Friction + RopePoints.ar[RopePoints.Count].dLen
+ end
+ end;
+
+Gear.dX:= HHGear.X - Gear.X;
+Gear.dY:= HHGear.Y - Gear.Y;
+HHGear.DirAngle:= arctan(Gear.dY + HHGear.dY, Gear.dX + HHGear.dX);
+cs:= sin(HHGear.DirAngle);
+cc:= cos(HHGear.DirAngle);
+
+HHGear.dX:= HHGear.X;
+HHGear.dY:= HHGear.Y;
+
+if ((Gear.Message and gm_Down) <> 0) and (Gear.Elasticity < Gear.Friction) then
+ if not (TestCollisionXwithGear(HHGear, Sign(Gear.dX))
+ or TestCollisionYwithGear(HHGear, Sign(Gear.dY))) then Gear.Elasticity:= Gear.Elasticity + 0.3;
+
+if ((Gear.Message and gm_Up) <> 0) and (Gear.Elasticity > 30) then
+ if not (TestCollisionXwithGear(HHGear, -Sign(Gear.dX))
+ or TestCollisionYwithGear(HHGear, -Sign(Gear.dY))) then Gear.Elasticity:= Gear.Elasticity - 0.3;
+
+HHGear.X:= Gear.X + cc*Gear.Elasticity;
+HHGear.Y:= Gear.Y + cs*Gear.Elasticity;
+
+HHGear.dX:= HHGear.X - HHGear.dX;
+HHGear.dY:= HHGear.Y - HHGear.dY;
+
+if TestCollisionXwithGear(HHGear, Sign(HHGear.dX)) then
+ HHGear.dX:= -0.9 * HHGear.dX;
+if TestCollisionYwithGear(HHGear, Sign(HHGear.dY)) then
+ HHGear.dY:= -0.9 * HHGear.dY;
+
+if (Gear.Message and gm_Attack) <> 0 then
+ if (Gear.State and gsttmpFlag) <> 0 then DeleteMe else
+else if (Gear.State and gsttmpFlag) = 0 then Gear.State:= Gear.State or gsttmpFlag;
+end;
+
+
+procedure doStepRopeAttach(Gear: PGear);
+var HHGear: PGear;
+ tx, ty, tt: real;
+begin
+Gear.X:= Gear.X + Gear.dX;
+Gear.Y:= Gear.Y + Gear.dY;
+Gear.Elasticity:= Gear.Elasticity + 1.0;
+HHGear:= PHedgehog(Gear.Hedgehog)^.Gear;
+if (HHGear.State and gstFalling) <> 0 then
+ if HHTestCollisionYwithGear(HHGear, 1) then
+ begin
+ HHGear.dY:= 0;
+ CheckHHDamage(HHGear);
+ HHGear.State:= HHGear.State and not (gstFalling or gstHHJumping);
+ end else
+ begin
+ if TestCollisionXwithGear(HHGear, Sign(HHGear.dX)) then HHGear.dX:= 0.0000001 * Sign(HHGear.dX);
+ HHGear.X:= HHGear.X + HHGear.dX;
+ HHGear.Y:= HHGear.Y + HHGear.dY;
+ Gear.X:= Gear.X + HHGear.dX;
+ Gear.Y:= Gear.Y + HHGear.dY;
+ HHGear.dY:= HHGear.dY + cGravity;
+ tt:= Gear.Elasticity;
+ tx:= 0;
+ ty:= 0;
+ while tt > 20 do
+ begin
+ if TestCollisionXwithXYShift(Gear, round(tx), round(ty), Sign(Gear.dX))
+ or TestCollisionYwithXYShift(Gear, round(tx), round(ty), Sign(Gear.dY)) then
+ begin
+ Gear.X:= Gear.X + tx;
+ Gear.Y:= Gear.Y + ty;
+ Gear.Elasticity:= tt;
+ Gear.doStep:= doStepRopeWork;
+ with HHGear^ do State:= State and not gstAttacking;
+ tt:= 0
+ end;
+ tx:= tx - Gear.dX - Gear.dX;
+ ty:= ty - Gear.dY - Gear.dY;
+ tt:= tt - 2.0;
+ end;
+ end;
+CheckCollision(Gear);
+if (Gear.State and gstCollision) <> 0 then
+ begin
+ Gear.doStep:= doStepRopeWork;
+ with HHGear^ do State:= State and not gstAttacking;
+ if Gear.Elasticity < 10 then
+ Gear.Elasticity:= 10000;
+ end;
+
+if (Gear.Elasticity >= Gear.Friction) or ((Gear.Message and gm_Attack) = 0) then
+ begin
+ with PHedgehog(Gear.Hedgehog).Gear^ do
+ begin
+ State:= State and not gstAttacking;
+ Message:= Message and not gm_Attack
+ end;
+ DeleteGear(Gear)
+ end
+end;
+
+procedure doStepRope(Gear: PGear);
+begin
+Gear.doStep:= doStepRopeAttach
+end;
+
+////////////////////////////////////////////////////////////////////////////////
+procedure doStepSmokeTrace(Gear: PGear);
+begin
+inc(Gear.Timer);
+if Gear.Timer > 64 then
+ begin
+ Gear.Timer:= 0;
+ dec(Gear.Tag)
+ end;
+Gear.dX:= Gear.dX + cWindSpeed;
+Gear.X:= Gear.X + Gear.dX;
+if Gear.Tag = 0 then DeleteGear(Gear)
+end;
--- a/hedgewars/HHHandlers.inc Mon Aug 22 21:38:06 2005 +0000
+++ b/hedgewars/HHHandlers.inc Tue Aug 23 16:17:53 2005 +0000
@@ -1,281 +1,281 @@
-(*
- * Hedgewars, a worms-like game
- * Copyright (c) 2004, 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.
- *)
-
-procedure doStepHedgehog(Gear: PGear); forward;
-////////////////////////////////////////////////////////////////////////////////
-procedure doStepHedgehogDriven(Gear: PGear);
-const StepTicks: LongWord = 0;
-begin
-if isinMultiShoot and (Gear.Damage = 0) then exit;
-AllInactive:= false;
-if (TurnTimeLeft = 0) or (Gear.Damage > 0) then
- begin
- if ((Gear.State and (gstMoving or gstFalling)) = 0)
- and (CurAmmoGear = nil) then Gear.dX:= 0.0000001 * Sign(Gear.dX);
- {$WARNINGS OFF}Gear.State:= Gear.State and not gstHHDriven;{$WARNINGS ON}
- exit
- end;
-
-if CurAmmoGear <> nil then
- begin
- CurAmmoGear.Message:= Gear.Message;
- exit
- end;
-
-if (Gear.Message and gm_Attack)<>0 then
- if (Gear.State and (gstAttacked or gstHHChooseTarget) = 0)and(CurAmmoGear = nil) then
- with PHedgehog(Gear.Hedgehog)^ do
-// if ((Gear.State and gstFalling ) = 0)or((Ammo[CurSlot, CurAmmo].Propz and ammoprop_AttackInFall) <> 0)
-// and((Gear.State and gstHHJumping) = 0)or((Ammo[CurSlot, CurAmmo].Propz and ammoprop_AttackInJump) <> 0) then
- begin
- Gear.State:= Gear.State or gstAttacking;
- if Gear.Power = cMaxPower then ParseCommand('-attack')
- else begin
- if (Ammo[CurSlot, CurAmmo].Propz and ammoprop_Power) = 0 then Gear.Power:= cMaxPower
- else begin
- if Gear.Power = 0 then
- begin
- AttackBar:= CurrentTeam.AttackBar;
- PlaySound(sndThrowPowerUp)
- end;
- inc(Gear.Power)
- end
- end;
- end else Gear.Message:= Gear.Message and not gm_Attack;
-
-
-if (Gear.State and gstFalling) <> 0 then
- begin
- if ((Gear.Message and gm_HJump) <> 0) and ((Gear.State and gstHHJumping) <> 0) then
- if (abs(Gear.dX) < 0.0000002) and (Gear.dY < -0.02) then
- begin
- Gear.dY:= -0.25;
- Gear.dX:= Sign(Gear.dX) * 0.02
- end;
- Gear.Message:= Gear.Message and not (gm_LJump or gm_HJump);
- if TestCollisionXwithGear(Gear, Sign(Gear.dX)) then Gear.dX:= 0.0000001 * Sign(Gear.dX);
- Gear.X:= Gear.X + Gear.dX;
- Gear.dY:= Gear.dY + cGravity;
- if (Gear.dY < 0)and TestCollisionYwithGear(Gear, -1) then Gear.dY:= 0;
- Gear.Y:= Gear.Y + Gear.dY;
- if (Gear.dY >= 0)and HHTestCollisionYwithGear(Gear, 1) then
- begin
- CheckHHDamage(Gear);
- if ((abs(Gear.dX) + abs(Gear.dY)) < 0.55)
- and ((Gear.State and gstHHJumping) <> 0) then Gear.dX:= 0.0000001 * Sign(Gear.dX);
- Gear.State:= Gear.State and not (gstFalling or gstHHJumping);
- StepTicks:= 200;
- Gear.dY:= 0
- end;
- CheckGearDrowning(Gear);
- exit
- end;
-
-if StepTicks > 0 then dec(StepTicks);
-
-if ((Gear.State and (gstMoving or gstFalling)) = 0) then
- if (Gear.Message and gm_Up )<>0 then if Gear.Angle > 0 then dec(Gear.Angle)
- else else
- if (Gear.Message and gm_Down )<>0 then if Gear.Angle < cMaxAngle then inc(Gear.Angle);
-
-if ((Gear.State and (gstAttacking or gstMoving or gstFalling)) = 0)and(StepTicks = 0) then
- begin
- 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_HJump )<>0) then
- begin
- Gear.Message:= 0;
- if not HHTestCollisionYwithGear(Gear, -1) then
- begin
- Gear.dY:= -0.20;
- Gear.dX:= 0.0000001 * Sign(Gear.dX);
- Gear.X:= Gear.X - Sign(Gear.dX)*0.00008; // компенсация сдвига %)
- 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;
- PHedgehog(Gear.Hedgehog).visStepPos:= (PHedgehog(Gear.Hedgehog).visStepPos + 1) and 7;
- StepTicks:= 40;
- 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;
- SetAllHHToActive
- end
- end
- end
- end
- end
- end
- end
-end;
-
-////////////////////////////////////////////////////////////////////////////////
-procedure doStepHedgehogFree(Gear: PGear);
-begin
-if not HHTestCollisionYwithGear(Gear, 1) then
- begin
- if (Gear.dY < 0) and HHTestCollisionYwithGear(Gear, -1) then Gear.dY:= 0;
- Gear.State:= Gear.State or gstFalling or gstMoving;
- Gear.dY:= Gear.dY + cGravity
- end else begin
- CheckHHDamage(Gear);
- if Gear.dY > 0 then Gear.dY:= 0;
- Gear.State:= Gear.State and not gstFalling;
- if ((Gear.State and gstMoving) <> 0) then Gear.dX:= Gear.dX * Gear.Friction
- end;
-
-
-if (Gear.State and gstMoving) <> 0 then
- if TestCollisionXwithGear(Gear, Sign(Gear.dX)) then
- if ((Gear.State and gstFalling) = 0) then
- if abs(Gear.dX) > 0.01 then
- if not TestCollisionXwithXYShift(Gear, 0, -1, Sign(Gear.dX)) then begin Gear.dX:= Gear.dX * 0.9; Gear.Y:= Gear.Y - 1 end else
- if not TestCollisionXwithXYShift(Gear, 0, -2, Sign(Gear.dX)) then begin Gear.dX:= Gear.dX * 0.9; Gear.Y:= Gear.Y - 2 end else
- if not TestCollisionXwithXYShift(Gear, 0, -3, Sign(Gear.dX)) then begin Gear.dX:= Gear.dX * 0.9; Gear.Y:= Gear.Y - 3 end else
- if not TestCollisionXwithXYShift(Gear, 0, -4, Sign(Gear.dX)) then begin Gear.dX:= Gear.dX * 0.9; Gear.Y:= Gear.Y - 4 end else
- if not TestCollisionXwithXYShift(Gear, 0, -5, Sign(Gear.dX)) then begin Gear.dX:= Gear.dX * 0.3; Gear.Y:= Gear.Y - 5 end else
- if abs(Gear.dX) > 0.02 then Gear.dX:= -0.5 * Gear.dX
- else begin
- Gear.State:= Gear.State and not gstMoving;
- Gear.dX:= 0.0000001 * Sign(Gear.dX)
- end
- else begin
- Gear.State:= Gear.State and not gstMoving;
- Gear.dX:= 0.0000001 * Sign(Gear.dX)
- end
- else Gear.dX:= -0.8 * Gear.dX;
-
-if ((Gear.State and gstFalling) = 0)and
- (sqr(Gear.dX) + sqr(Gear.dY) < 0.0008) then
- begin
- Gear.State:= Gear.State and not gstMoving;
- Gear.dX:= 0.0000001 * Sign(Gear.dX);
- Gear.dY:= 0
- end else Gear.State:= Gear.State or gstMoving;
-
-if (Gear.State and gstMoving) <> 0 then
- begin
- Gear.X:= Gear.X + Gear.dX;
- Gear.Y:= Gear.Y + Gear.dY
- end else
- if Gear.Health = 0 then
- begin
- if AllInactive then
- begin
- doMakeExplosion(round(Gear.X), round(Gear.Y), 30, EXPLAutoSound);
- AddGear(round(Gear.X), round(Gear.Y), gtGrave, 0).Hedgehog:= Gear.Hedgehog;
- DeleteGear(Gear);
- SetAllToActive
- end;
- AllInactive:= false; (* почему этого тут не было? *)
- exit
- end;
-
-AllInactive:= false;
-
-if (not CheckGearDrowning(Gear)) and
- ((Gear.State and gstMoving) = 0) then
- begin
- Gear.State:= 0;
- Gear.Active:= false;
- AddGearCR(Gear);
- exit
- end
-end;
-
-////////////////////////////////////////////////////////////////////////////////
-procedure doStepHedgehog(Gear: PGear);
-begin
-if (Gear.Message and gm_Destroy) <> 0 then
- begin
- DeleteGear(Gear);
- exit
- end;
-if Gear.CollIndex < High(Longword) then DeleteCR(Gear);
-if (Gear.State and gstHHDriven) = 0 then doStepHedgehogFree(Gear)
- else doStepHedgehogDriven(Gear)
-end;
+(*
+ * Hedgewars, a worms-like game
+ * Copyright (c) 2004, 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.
+ *)
+
+procedure doStepHedgehog(Gear: PGear); forward;
+////////////////////////////////////////////////////////////////////////////////
+procedure doStepHedgehogDriven(Gear: PGear);
+const StepTicks: LongWord = 0;
+begin
+if isinMultiShoot and (Gear.Damage = 0) then exit;
+AllInactive:= false;
+if (TurnTimeLeft = 0) or (Gear.Damage > 0) then
+ begin
+ if ((Gear.State and (gstMoving or gstFalling)) = 0)
+ and (CurAmmoGear = nil) then Gear.dX:= 0.0000001 * Sign(Gear.dX);
+ {$WARNINGS OFF}Gear.State:= Gear.State and not gstHHDriven;{$WARNINGS ON}
+ exit
+ end;
+
+if CurAmmoGear <> nil then
+ begin
+ CurAmmoGear.Message:= Gear.Message;
+ exit
+ end;
+
+if (Gear.Message and gm_Attack)<>0 then
+ if (Gear.State and (gstAttacked or gstHHChooseTarget) = 0)and(CurAmmoGear = nil) then
+ with PHedgehog(Gear.Hedgehog)^ do
+// if ((Gear.State and gstFalling ) = 0)or((Ammo[CurSlot, CurAmmo].Propz and ammoprop_AttackInFall) <> 0)
+// and((Gear.State and gstHHJumping) = 0)or((Ammo[CurSlot, CurAmmo].Propz and ammoprop_AttackInJump) <> 0) then
+ begin
+ Gear.State:= Gear.State or gstAttacking;
+ if Gear.Power = cMaxPower then ParseCommand('-attack')
+ else begin
+ if (Ammo[CurSlot, CurAmmo].Propz and ammoprop_Power) = 0 then Gear.Power:= cMaxPower
+ else begin
+ if Gear.Power = 0 then
+ begin
+ AttackBar:= CurrentTeam.AttackBar;
+ PlaySound(sndThrowPowerUp)
+ end;
+ inc(Gear.Power)
+ end
+ end;
+ end else Gear.Message:= Gear.Message and not gm_Attack;
+
+
+if (Gear.State and gstFalling) <> 0 then
+ begin
+ if ((Gear.Message and gm_HJump) <> 0) and ((Gear.State and gstHHJumping) <> 0) then
+ if (abs(Gear.dX) < 0.0000002) and (Gear.dY < -0.02) then
+ begin
+ Gear.dY:= -0.25;
+ Gear.dX:= Sign(Gear.dX) * 0.02
+ end;
+ Gear.Message:= Gear.Message and not (gm_LJump or gm_HJump);
+ if TestCollisionXwithGear(Gear, Sign(Gear.dX)) then Gear.dX:= 0.0000001 * Sign(Gear.dX);
+ Gear.X:= Gear.X + Gear.dX;
+ Gear.dY:= Gear.dY + cGravity;
+ if (Gear.dY < 0)and TestCollisionYwithGear(Gear, -1) then Gear.dY:= 0;
+ Gear.Y:= Gear.Y + Gear.dY;
+ if (Gear.dY >= 0)and HHTestCollisionYwithGear(Gear, 1) then
+ begin
+ CheckHHDamage(Gear);
+ if ((abs(Gear.dX) + abs(Gear.dY)) < 0.55)
+ and ((Gear.State and gstHHJumping) <> 0) then Gear.dX:= 0.0000001 * Sign(Gear.dX);
+ Gear.State:= Gear.State and not (gstFalling or gstHHJumping);
+ StepTicks:= 200;
+ Gear.dY:= 0
+ end;
+ CheckGearDrowning(Gear);
+ exit
+ end;
+
+if StepTicks > 0 then dec(StepTicks);
+
+if ((Gear.State and (gstMoving or gstFalling)) = 0) then
+ if (Gear.Message and gm_Up )<>0 then if Gear.Angle > 0 then dec(Gear.Angle)
+ else else
+ if (Gear.Message and gm_Down )<>0 then if Gear.Angle < cMaxAngle then inc(Gear.Angle);
+
+if ((Gear.State and (gstAttacking or gstMoving or gstFalling)) = 0)and(StepTicks = 0) then
+ begin
+ 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_HJump )<>0) then
+ begin
+ Gear.Message:= 0;
+ if not HHTestCollisionYwithGear(Gear, -1) then
+ begin
+ Gear.dY:= -0.20;
+ Gear.dX:= 0.0000001 * Sign(Gear.dX);
+ Gear.X:= Gear.X - Sign(Gear.dX)*0.00008; // компенсация сдвига %)
+ 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;
+ PHedgehog(Gear.Hedgehog).visStepPos:= (PHedgehog(Gear.Hedgehog).visStepPos + 1) and 7;
+ StepTicks:= 40;
+ 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;
+ SetAllHHToActive
+ end
+ end
+ end
+ end
+ end
+ end
+ end
+end;
+
+////////////////////////////////////////////////////////////////////////////////
+procedure doStepHedgehogFree(Gear: PGear);
+begin
+if not HHTestCollisionYwithGear(Gear, 1) then
+ begin
+ if (Gear.dY < 0) and HHTestCollisionYwithGear(Gear, -1) then Gear.dY:= 0;
+ Gear.State:= Gear.State or gstFalling or gstMoving;
+ Gear.dY:= Gear.dY + cGravity
+ end else begin
+ CheckHHDamage(Gear);
+ if Gear.dY > 0 then Gear.dY:= 0;
+ Gear.State:= Gear.State and not gstFalling;
+ if ((Gear.State and gstMoving) <> 0) then Gear.dX:= Gear.dX * Gear.Friction
+ end;
+
+
+if (Gear.State and gstMoving) <> 0 then
+ if TestCollisionXwithGear(Gear, Sign(Gear.dX)) then
+ if ((Gear.State and gstFalling) = 0) then
+ if abs(Gear.dX) > 0.01 then
+ if not TestCollisionXwithXYShift(Gear, 0, -1, Sign(Gear.dX)) then begin Gear.dX:= Gear.dX * 0.9; Gear.Y:= Gear.Y - 1 end else
+ if not TestCollisionXwithXYShift(Gear, 0, -2, Sign(Gear.dX)) then begin Gear.dX:= Gear.dX * 0.9; Gear.Y:= Gear.Y - 2 end else
+ if not TestCollisionXwithXYShift(Gear, 0, -3, Sign(Gear.dX)) then begin Gear.dX:= Gear.dX * 0.9; Gear.Y:= Gear.Y - 3 end else
+ if not TestCollisionXwithXYShift(Gear, 0, -4, Sign(Gear.dX)) then begin Gear.dX:= Gear.dX * 0.9; Gear.Y:= Gear.Y - 4 end else
+ if not TestCollisionXwithXYShift(Gear, 0, -5, Sign(Gear.dX)) then begin Gear.dX:= Gear.dX * 0.3; Gear.Y:= Gear.Y - 5 end else
+ if abs(Gear.dX) > 0.02 then Gear.dX:= -0.5 * Gear.dX
+ else begin
+ Gear.State:= Gear.State and not gstMoving;
+ Gear.dX:= 0.0000001 * Sign(Gear.dX)
+ end
+ else begin
+ Gear.State:= Gear.State and not gstMoving;
+ Gear.dX:= 0.0000001 * Sign(Gear.dX)
+ end
+ else Gear.dX:= -0.8 * Gear.dX;
+
+if ((Gear.State and gstFalling) = 0)and
+ (sqr(Gear.dX) + sqr(Gear.dY) < 0.0008) then
+ begin
+ Gear.State:= Gear.State and not gstMoving;
+ Gear.dX:= 0.0000001 * Sign(Gear.dX);
+ Gear.dY:= 0
+ end else Gear.State:= Gear.State or gstMoving;
+
+if (Gear.State and gstMoving) <> 0 then
+ begin
+ Gear.X:= Gear.X + Gear.dX;
+ Gear.Y:= Gear.Y + Gear.dY
+ end else
+ if Gear.Health = 0 then
+ begin
+ if AllInactive then
+ begin
+ doMakeExplosion(round(Gear.X), round(Gear.Y), 30, EXPLAutoSound);
+ AddGear(round(Gear.X), round(Gear.Y), gtGrave, 0).Hedgehog:= Gear.Hedgehog;
+ DeleteGear(Gear);
+ SetAllToActive
+ end;
+ AllInactive:= false; (* почему этого тут не было? *)
+ exit
+ end;
+
+AllInactive:= false;
+
+if (not CheckGearDrowning(Gear)) and
+ ((Gear.State and gstMoving) = 0) then
+ begin
+ Gear.State:= 0;
+ Gear.Active:= false;
+ AddGearCR(Gear);
+ exit
+ end
+end;
+
+////////////////////////////////////////////////////////////////////////////////
+procedure doStepHedgehog(Gear: PGear);
+begin
+if (Gear.Message and gm_Destroy) <> 0 then
+ begin
+ DeleteGear(Gear);
+ exit
+ end;
+if Gear.CollIndex < High(Longword) then DeleteCR(Gear);
+if (Gear.State and gstHHDriven) = 0 then doStepHedgehogFree(Gear)
+ else doStepHedgehogDriven(Gear)
+end;
--- a/hedgewars/Hedge.dpr Mon Aug 22 21:38:06 2005 +0000
+++ b/hedgewars/Hedge.dpr Tue Aug 23 16:17:53 2005 +0000
@@ -1,65 +1,65 @@
-(*
- * Hedgewars, a worms-like game
- * Copyright (c) 2004, 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.
- *)
-
-program Hedge;
-
-uses
- windows,
- messages,
- WinSock,
- IniFiles,
- SysUtils,
- uRandom,
- fNet in 'fNet.pas',
- fGUI in 'fGUI.pas',
- fConsts in 'fConsts.pas',
- fIPC in 'fIPC.pas',
- fMisc in 'fMisc.pas',
- fGame in 'fGame.pas',
- fOptionsGUI in 'fOptionsGUI.pas';
-
-{$R Hedge.res}
-
-begin
-DoCreateMainWindow;
-DoCreateOptionsWindow;
-InitWSA;
-LoadGraphics;
-DoCreateControls;
-DoCreateOptionsControls;
-DoInit;
-repeat
-ProcessMessages;
-until isTerminated
-end.
-
+(*
+ * Hedgewars, a worms-like game
+ * Copyright (c) 2004, 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.
+ *)
+
+program Hedge;
+
+uses
+ windows,
+ messages,
+ WinSock,
+ IniFiles,
+ SysUtils,
+ uRandom,
+ fNet in 'fNet.pas',
+ fGUI in 'fGUI.pas',
+ fConsts in 'fConsts.pas',
+ fIPC in 'fIPC.pas',
+ fMisc in 'fMisc.pas',
+ fGame in 'fGame.pas',
+ fOptionsGUI in 'fOptionsGUI.pas';
+
+{$R Hedge.res}
+
+begin
+DoCreateMainWindow;
+DoCreateOptionsWindow;
+InitWSA;
+LoadGraphics;
+DoCreateControls;
+DoCreateOptionsControls;
+DoInit;
+repeat
+ProcessMessages;
+until isTerminated
+end.
+
--- a/hedgewars/Makefile Mon Aug 22 21:38:06 2005 +0000
+++ b/hedgewars/Makefile Tue Aug 23 16:17:53 2005 +0000
@@ -1,3 +1,5 @@
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 hw.dpr
ppc386 -B -Sd -Xs -OG -Or -O2 -Fl/usr/local/lib runhelper.dpr
\ No newline at end of file
--- a/hedgewars/SDLh.pas Mon Aug 22 21:38:06 2005 +0000
+++ b/hedgewars/SDLh.pas Tue Aug 23 16:17:53 2005 +0000
@@ -1,384 +1,384 @@
-(*
- * Hedgewars, a worms-like game
- * Copyright (c) 2004, 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 SDLh;
-interface
-{$IFDEF LINUX}
-{$DEFINE UNIX}
-{$ENDIF}
-{$IFDEF FREEBSD}
-{$DEFINE UNIX}
-{$ENDIF}
-
-{$IFDEF UNIX}
-{$linklib c}
-{$linklib pthread} // кажется, это только для FreeBSD, не уверен
-{$ENDIF}
-
-{$IFDEF FPC}
- {$MODE Delphi}
- {$PACKRECORDS 4}
-{$ENDIF}
-
-(* SDL *)
-const {$IFDEF WIN32}
- SDLLibName = 'SDL.dll';
- {$ENDIF}
- {$IFDEF UNIX}
- SDLLibName = 'libSDL.so';
- {$ENDIF}
- SDL_SWSURFACE = $00000000;
- SDL_HWSURFACE = $00000001;
- SDL_ASYNCBLIT = $00000004;
- SDL_ANYFORMAT = $10000000;
- SDL_HWPALETTE = $20000000;
- SDL_DOUBLEBUF = $40000000;
- SDL_FULLSCREEN = $80000000;
- SDL_NOFRAME = $00000020;
- SDL_HWACCEL = $00000100;
- SDL_SRCCOLORKEY = $00001000;
- SDL_RLEACCEL = $00004000;
-
- SDL_NOEVENT = 0;
- SDL_KEYDOWN = 2;
- SDL_KEYUP = 3;
- SDL_QUITEV = 12;
-
- SDL_INIT_VIDEO = $00000020;
-type PSDL_Rect = ^TSDL_Rect;
- TSDL_Rect = record
- x, y: SmallInt;
- w, h: Word;
- end;
-
- TPoint = record
- x: Integer;
- y: Integer;
- end;
-
- PSDL_PixelFormat = ^TSDL_PixelFormat;
- TSDL_PixelFormat = record
- palette: Pointer;
- BitsPerPixel : Byte;
- BytesPerPixel: Byte;
- Rloss : Byte;
- Gloss : Byte;
- Bloss : Byte;
- Aloss : Byte;
- Rshift: Byte;
- Gshift: Byte;
- Bshift: Byte;
- Ashift: Byte;
- RMask : Longword;
- GMask : Longword;
- BMask : Longword;
- AMask : Longword;
- colorkey: Longword;
- alpha : Byte;
- end;
-
-
- PSDL_Surface = ^TSDL_Surface;
- TSDL_Surface = record
- flags : Longword;
- format: PSDL_PixelFormat;
- w, h : Integer;
- pitch : Word;
- pixels: Pointer;
- offset: Integer;
- hwdata: Pointer;
- clip_rect: TSDL_Rect;
- unused1,
- locked : Longword;
- Blitmap : Pointer;
- format_version: Longword;
- refcount : Integer;
- end;
-
- PSDL_Color = ^TSDL_Color;
- TSDL_Color = record
- r: Byte;
- g: Byte;
- b: Byte;
- a: Byte;
- end;
-
- PSDL_RWops = ^TSDL_RWops;
- TSeek = function( context: PSDL_RWops; offset: Integer; whence: Integer ): Integer; cdecl;
- TRead = function( context: PSDL_RWops; Ptr: Pointer; size: Integer; maxnum : Integer ): Integer; cdecl;
- TWrite = function( context: PSDL_RWops; Ptr: Pointer; size: Integer; num: Integer ): Integer; cdecl;
- TClose = function( context: PSDL_RWops ): Integer; cdecl;
-
- TStdio = record
- autoclose: Integer;
- fp: pointer;
- end;
-
- TMem = record
- base: PByte;
- here: PByte;
- stop: PByte;
- end;
-
- TUnknown = record
- data1: Pointer;
- end;
-
- TSDL_RWops = record
- seek: TSeek;
- read: TRead;
- write: TWrite;
- close: TClose;
- type_: Longword;
- case Byte of
- 0: (stdio: TStdio);
- 1: (mem: TMem);
- 2: (unknown: TUnknown);
- end;
-
- TSDL_KeySym = record
- scancode: Byte;
- sym,
- modifier: Longword;
- unicode: Word;
- end;
-
- TSDL_KeyboardEvent = record
- type_: Byte;
- which: Byte;
- state: Byte;
- keysym: TSDL_KeySym;
- end;
-
- TSDL_QuitEvent = record
- type_: Byte;
- end;
- PSDL_Event = ^TSDL_Event;
- TSDL_Event = record
- case Byte of
- SDL_NOEVENT: (type_: byte);
- SDL_KEYDOWN, SDL_KEYUP: (key: TSDL_KeyboardEvent);
- SDL_QUITEV: (quit: TSDL_QuitEvent);
- end;
-
- PByteArray = ^TByteArray;
- TByteArray = array[0..32767] of Byte;
-
-function SDL_Init(flags: Longword): Integer; cdecl; external SDLLibName;
-procedure SDL_Quit; cdecl; external SDLLibName;
-
-procedure SDL_Delay(msec: Longword); cdecl; external SDLLibName;
-function SDL_GetTicks: Longword; cdecl; external SDLLibName;
-
-function SDL_MustLock(Surface: PSDL_Surface): Boolean;
-function SDL_LockSurface(Surface: PSDL_Surface): Integer; cdecl; external SDLLibName;
-procedure SDL_UnlockSurface(Surface: PSDL_Surface); cdecl; external SDLLibName;
-
-function SDL_GetError: PChar; cdecl; external SDLLibName;
-
-function SDL_SetVideoMode(width, height, bpp: Integer; flags: Longword): PSDL_Surface; cdecl; external SDLLibName;
-function SDL_CreateRGBSurface(flags: Longword; Width, Height, Depth: Integer; RMask, GMask, BMask, AMask: Longword): PSDL_Surface; cdecl; external SDLLibName;
-function SDL_CreateRGBSurfaceFrom(pixels: Pointer; width, height, depth, pitch: Integer; RMask, GMask, BMask, AMask: Longword): PSDL_Surface; cdecl; external SDLLibName;
-procedure SDL_FreeSurface(Surface: PSDL_Surface); cdecl; external SDLLibName;
-function SDL_SetColorKey(surface: PSDL_Surface; flag, key: Longword): Integer; cdecl; external SDLLibName;
-
-function SDL_UpperBlit(src: PSDL_Surface; srcrect: PSDL_Rect; dst: PSDL_Surface; dstrect: PSDL_Rect): Integer; cdecl; external SDLLibName;
-function SDL_FillRect(dst: PSDL_Surface; dstrect: PSDL_Rect; color: Longword): Integer; cdecl; external SDLLibName;
-procedure SDL_UpdateRect(Screen: PSDL_Surface; x, y: Integer; w, h: Longword); cdecl; external SDLLibName;
-function SDL_Flip(Screen: PSDL_Surface): Integer; cdecl; external SDLLibName;
-
-procedure SDL_GetRGB(pixel: Longword; fmt: PSDL_PixelFormat; r, g, b: PByte); cdecl; external SDLLibName;
-function SDL_MapRGB(format: PSDL_PixelFormat; r, g, b: Byte): Integer; cdecl; external SDLLibName;
-
-function SDL_DisplayFormat(Surface: PSDL_Surface): PSDL_Surface; cdecl; external SDLLibName;
-
-function SDL_RWFromFile(filename, mode: PChar): PSDL_RWops; cdecl; external SDLLibName;
-function SDL_SaveBMP_RW(surface: PSDL_Surface; dst: PSDL_RWops; freedst: Integer): Integer; cdecl; external SDLLibName;
-
-function SDL_GetKeyState(numkeys: PInteger): PByteArray; cdecl; external SDLLibName;
-function SDL_GetMouseState(x, y: PInteger): Byte; cdecl; external SDLLibName;
-function SDL_GetKeyName(key: Longword): PChar; cdecl; external SDLLibName;
-procedure SDL_WarpMouse(x, y: Word); cdecl; external SDLLibName;
-
-function SDL_PollEvent(event: PSDL_Event): Integer; cdecl; external SDLLibName;
-
-function SDL_ShowCursor(toggle: Integer): Integer; cdecl; external SDLLibName;
-
-procedure SDL_WM_SetCaption(title: PChar; icon: PChar); cdecl; external SDLLibName;
-
-(* TTF *)
-
-const {$IFDEF WIN32}
- SDL_TTFLibName = 'SDL_ttf.dll';
- {$ENDIF}
- {$IFDEF UNIX}
- SDL_TTFLibName = 'libSDL_ttf.so';
- {$ENDIF}
-
-
-type PTTF_Font = ^TTTF_font;
- TTTF_Font = record
- end;
-
-function TTF_Init: integer; cdecl; external SDL_TTFLibName;
-procedure TTF_Quit; cdecl; external SDL_TTFLibName;
-
-
-function TTF_SizeText(font : PTTF_Font; const text: PChar; var w, h: integer): Integer; cdecl; external SDL_TTFLibName;
-function TTF_RenderText_Solid(font : PTTF_Font; const text: PChar; fg: TSDL_Color): PSDL_Surface; cdecl; external SDL_TTFLibName;
-function TTF_RenderText_Blended(font : PTTF_Font; const text: PChar; fg: TSDL_Color): PSDL_Surface; cdecl; external SDL_TTFLibName;
-function TTF_OpenFont(const filename: Pchar; size: integer): PTTF_Font; cdecl; external SDL_TTFLibName;
-
-(* SDL_mixer *)
-
-const {$IFDEF WIN32}
- SDL_MixerLibName = 'SDL_mixer.dll';
- {$ENDIF}
- {$IFDEF UNIX}
- SDL_MixerLibName = 'libSDL_mixer.so';
- {$ENDIF}
-
-type PMixChunk = ^TMixChunk;
- TMixChunk = record
- allocated: Longword;
- abuf : PByte;
- alen : Longword;
- volume : PByte;
- end;
- TMusic = (MUS_CMD, MUS_WAV, MUS_MOD, MUS_MID, MUS_OGG, MUS_MP3);
- TMix_Fading = (MIX_NO_FADING, MIX_FADING_OUT, MIX_FADING_IN);
-
- TMidiSong = record
- samples : Integer;
- events : pointer;
- end;
-
- TMusicUnion = record
- case Byte of
- 0: ( midi : TMidiSong );
- 1: ( ogg : pointer);
- end;
-
- PMixMusic = ^TMixMusic;
- TMixMusic = record
- type_ : TMusic;
- data : TMusicUnion;
- fading : TMix_Fading;
- fade_volume,
- fade_step,
- fade_steps,
- error : integer;
- end;
-
-function Mix_OpenAudio(frequency: integer; format: Word; channels: integer; chunksize: integer): integer; cdecl; external SDL_MixerLibName;
-procedure Mix_CloseAudio; cdecl; external SDL_MixerLibName;
-
-function Mix_VolumeMusic(volume: integer): integer; cdecl; external SDL_MixerLibName;
-
-procedure Mix_FreeChunk(chunk: PMixChunk); cdecl; external SDL_MixerLibName;
-procedure Mix_FreeMusic(music: PMixMusic); cdecl; external SDL_MixerLibName;
-
-function Mix_LoadWAV_RW(src: PSDL_RWops; freesrc: integer): PMixChunk; cdecl; external SDL_MixerLibName;
-function Mix_LoadMUS(const filename: PChar): PMixMusic; cdecl; external SDL_MixerLibName;
-
-function Mix_Playing(channel: integer): integer; cdecl; external SDL_MixerLibName;
-function Mix_PlayingMusic: integer; cdecl; external SDL_MixerLibName;
-
-function Mix_PlayChannelTimed(channel: integer; chunk: PMixChunk; loops: integer; ticks: integer): integer; cdecl; external SDL_MixerLibName;
-function Mix_PlayMusic(music: PMixMusic; loops: integer): integer; cdecl; external SDL_MixerLibName;
-function Mix_HaltChannel(channel: integer): integer; cdecl; external SDL_MixerLibName;
-
-(* SDL_image *)
-
-const {$IFDEF WIN32}
- SDL_ImageLibName = 'SDL_image.dll';
- {$ENDIF}
- {$IFDEF UNIX}
- SDL_ImageLibName = 'libSDL_image.so';
- {$ENDIF}
-
-function IMG_Load(const _file: PChar): PSDL_Surface; cdecl; external SDL_ImageLibName;
-
-(* SDL_net *)
-
-const {$IFDEF WIN32}
- SDL_NetLibName = 'SDL_net.dll';
- {$ENDIF}
- {$IFDEF UNIX}
- SDL_NetLibName = 'libSDL_net.so';
- {$ENDIF}
-
-type TIPAddress = record
- host: Longword;
- port: Word;
- end;
-
- PTCPSocket = ^TTCPSocket;
- TTCPSocket = record
- ready,
- channel: integer;
- remoteAddress,
- localAddress: TIPaddress;
- sflag: integer;
- end;
- PSDLNet_SocketSet = ^TSDLNet_SocketSet;
- TSDLNet_SocketSet = record
- numsockets,
- maxsockets: integer;
- sockets: PTCPSocket;
- end;
-
-function SDLNet_Init: integer; cdecl; external SDL_NetLibName;
-procedure SDLNet_Quit; cdecl; external SDL_NetLibName;
-
-function SDLNet_AllocSocketSet(maxsockets: integer): PSDLNet_SocketSet; cdecl; external SDL_NetLibName;
-function SDLNet_ResolveHost(var address: TIPaddress; host: PCHar; port: Word): integer; cdecl; external SDL_NetLibName;
-function SDLNet_TCP_Accept(server: PTCPsocket): PTCPSocket; cdecl; external SDL_NetLibName;
-function SDLNet_TCP_Open(var ip: TIPaddress): PTCPSocket; cdecl; external SDL_NetLibName;
-function SDLNet_TCP_Send(sock: PTCPsocket; data: Pointer; len: integer): integer; cdecl; external SDL_NetLibName;
-function SDLNet_TCP_Recv(sock: PTCPsocket; data: Pointer; len: integer): integer; cdecl; external SDL_NetLibName;
-procedure SDLNet_TCP_Close(sock: PTCPsocket); cdecl; external SDL_NetLibName;
-procedure SDLNet_FreeSocketSet(_set: PSDLNet_SocketSet); cdecl; external SDL_NetLibName;
-function SDLNet_AddSocket(_set: PSDLNet_SocketSet; sock: PTCPSocket): integer; cdecl; external SDL_NetLibName;
-function SDLNet_CheckSockets(_set: PSDLNet_SocketSet; timeout: integer): integer; cdecl; external SDL_NetLibName;
-
-
-implementation
-
-function SDL_MustLock(Surface: PSDL_Surface): Boolean;
-begin
-Result:= ( surface^.offset <> 0 )
- or(( surface^.flags and (SDL_HWSURFACE or SDL_ASYNCBLIT or SDL_RLEACCEL)) <> 0)
-end;
-
-end.
+(*
+ * Hedgewars, a worms-like game
+ * Copyright (c) 2004, 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 SDLh;
+interface
+{$IFDEF LINUX}
+{$DEFINE UNIX}
+{$ENDIF}
+{$IFDEF FREEBSD}
+{$DEFINE UNIX}
+{$ENDIF}
+
+{$IFDEF UNIX}
+{$linklib c}
+{$linklib pthread} // кажется, это только для FreeBSD, не уверен
+{$ENDIF}
+
+{$IFDEF FPC}
+ {$MODE Delphi}
+ {$PACKRECORDS 4}
+{$ENDIF}
+
+(* SDL *)
+const {$IFDEF WIN32}
+ SDLLibName = 'SDL.dll';
+ {$ENDIF}
+ {$IFDEF UNIX}
+ SDLLibName = 'libSDL.so';
+ {$ENDIF}
+ SDL_SWSURFACE = $00000000;
+ SDL_HWSURFACE = $00000001;
+ SDL_ASYNCBLIT = $00000004;
+ SDL_ANYFORMAT = $10000000;
+ SDL_HWPALETTE = $20000000;
+ SDL_DOUBLEBUF = $40000000;
+ SDL_FULLSCREEN = $80000000;
+ SDL_NOFRAME = $00000020;
+ SDL_HWACCEL = $00000100;
+ SDL_SRCCOLORKEY = $00001000;
+ SDL_RLEACCEL = $00004000;
+
+ SDL_NOEVENT = 0;
+ SDL_KEYDOWN = 2;
+ SDL_KEYUP = 3;
+ SDL_QUITEV = 12;
+
+ SDL_INIT_VIDEO = $00000020;
+type PSDL_Rect = ^TSDL_Rect;
+ TSDL_Rect = record
+ x, y: SmallInt;
+ w, h: Word;
+ end;
+
+ TPoint = record
+ x: Integer;
+ y: Integer;
+ end;
+
+ PSDL_PixelFormat = ^TSDL_PixelFormat;
+ TSDL_PixelFormat = record
+ palette: Pointer;
+ BitsPerPixel : Byte;
+ BytesPerPixel: Byte;
+ Rloss : Byte;
+ Gloss : Byte;
+ Bloss : Byte;
+ Aloss : Byte;
+ Rshift: Byte;
+ Gshift: Byte;
+ Bshift: Byte;
+ Ashift: Byte;
+ RMask : Longword;
+ GMask : Longword;
+ BMask : Longword;
+ AMask : Longword;
+ colorkey: Longword;
+ alpha : Byte;
+ end;
+
+
+ PSDL_Surface = ^TSDL_Surface;
+ TSDL_Surface = record
+ flags : Longword;
+ format: PSDL_PixelFormat;
+ w, h : Integer;
+ pitch : Word;
+ pixels: Pointer;
+ offset: Integer;
+ hwdata: Pointer;
+ clip_rect: TSDL_Rect;
+ unused1,
+ locked : Longword;
+ Blitmap : Pointer;
+ format_version: Longword;
+ refcount : Integer;
+ end;
+
+ PSDL_Color = ^TSDL_Color;
+ TSDL_Color = record
+ r: Byte;
+ g: Byte;
+ b: Byte;
+ a: Byte;
+ end;
+
+ PSDL_RWops = ^TSDL_RWops;
+ TSeek = function( context: PSDL_RWops; offset: Integer; whence: Integer ): Integer; cdecl;
+ TRead = function( context: PSDL_RWops; Ptr: Pointer; size: Integer; maxnum : Integer ): Integer; cdecl;
+ TWrite = function( context: PSDL_RWops; Ptr: Pointer; size: Integer; num: Integer ): Integer; cdecl;
+ TClose = function( context: PSDL_RWops ): Integer; cdecl;
+
+ TStdio = record
+ autoclose: Integer;
+ fp: pointer;
+ end;
+
+ TMem = record
+ base: PByte;
+ here: PByte;
+ stop: PByte;
+ end;
+
+ TUnknown = record
+ data1: Pointer;
+ end;
+
+ TSDL_RWops = record
+ seek: TSeek;
+ read: TRead;
+ write: TWrite;
+ close: TClose;
+ type_: Longword;
+ case Byte of
+ 0: (stdio: TStdio);
+ 1: (mem: TMem);
+ 2: (unknown: TUnknown);
+ end;
+
+ TSDL_KeySym = record
+ scancode: Byte;
+ sym,
+ modifier: Longword;
+ unicode: Word;
+ end;
+
+ TSDL_KeyboardEvent = record
+ type_: Byte;
+ which: Byte;
+ state: Byte;
+ keysym: TSDL_KeySym;
+ end;
+
+ TSDL_QuitEvent = record
+ type_: Byte;
+ end;
+ PSDL_Event = ^TSDL_Event;
+ TSDL_Event = record
+ case Byte of
+ SDL_NOEVENT: (type_: byte);
+ SDL_KEYDOWN, SDL_KEYUP: (key: TSDL_KeyboardEvent);
+ SDL_QUITEV: (quit: TSDL_QuitEvent);
+ end;
+
+ PByteArray = ^TByteArray;
+ TByteArray = array[0..32767] of Byte;
+
+function SDL_Init(flags: Longword): Integer; cdecl; external SDLLibName;
+procedure SDL_Quit; cdecl; external SDLLibName;
+
+procedure SDL_Delay(msec: Longword); cdecl; external SDLLibName;
+function SDL_GetTicks: Longword; cdecl; external SDLLibName;
+
+function SDL_MustLock(Surface: PSDL_Surface): Boolean;
+function SDL_LockSurface(Surface: PSDL_Surface): Integer; cdecl; external SDLLibName;
+procedure SDL_UnlockSurface(Surface: PSDL_Surface); cdecl; external SDLLibName;
+
+function SDL_GetError: PChar; cdecl; external SDLLibName;
+
+function SDL_SetVideoMode(width, height, bpp: Integer; flags: Longword): PSDL_Surface; cdecl; external SDLLibName;
+function SDL_CreateRGBSurface(flags: Longword; Width, Height, Depth: Integer; RMask, GMask, BMask, AMask: Longword): PSDL_Surface; cdecl; external SDLLibName;
+function SDL_CreateRGBSurfaceFrom(pixels: Pointer; width, height, depth, pitch: Integer; RMask, GMask, BMask, AMask: Longword): PSDL_Surface; cdecl; external SDLLibName;
+procedure SDL_FreeSurface(Surface: PSDL_Surface); cdecl; external SDLLibName;
+function SDL_SetColorKey(surface: PSDL_Surface; flag, key: Longword): Integer; cdecl; external SDLLibName;
+
+function SDL_UpperBlit(src: PSDL_Surface; srcrect: PSDL_Rect; dst: PSDL_Surface; dstrect: PSDL_Rect): Integer; cdecl; external SDLLibName;
+function SDL_FillRect(dst: PSDL_Surface; dstrect: PSDL_Rect; color: Longword): Integer; cdecl; external SDLLibName;
+procedure SDL_UpdateRect(Screen: PSDL_Surface; x, y: Integer; w, h: Longword); cdecl; external SDLLibName;
+function SDL_Flip(Screen: PSDL_Surface): Integer; cdecl; external SDLLibName;
+
+procedure SDL_GetRGB(pixel: Longword; fmt: PSDL_PixelFormat; r, g, b: PByte); cdecl; external SDLLibName;
+function SDL_MapRGB(format: PSDL_PixelFormat; r, g, b: Byte): Integer; cdecl; external SDLLibName;
+
+function SDL_DisplayFormat(Surface: PSDL_Surface): PSDL_Surface; cdecl; external SDLLibName;
+
+function SDL_RWFromFile(filename, mode: PChar): PSDL_RWops; cdecl; external SDLLibName;
+function SDL_SaveBMP_RW(surface: PSDL_Surface; dst: PSDL_RWops; freedst: Integer): Integer; cdecl; external SDLLibName;
+
+function SDL_GetKeyState(numkeys: PInteger): PByteArray; cdecl; external SDLLibName;
+function SDL_GetMouseState(x, y: PInteger): Byte; cdecl; external SDLLibName;
+function SDL_GetKeyName(key: Longword): PChar; cdecl; external SDLLibName;
+procedure SDL_WarpMouse(x, y: Word); cdecl; external SDLLibName;
+
+function SDL_PollEvent(event: PSDL_Event): Integer; cdecl; external SDLLibName;
+
+function SDL_ShowCursor(toggle: Integer): Integer; cdecl; external SDLLibName;
+
+procedure SDL_WM_SetCaption(title: PChar; icon: PChar); cdecl; external SDLLibName;
+
+(* TTF *)
+
+const {$IFDEF WIN32}
+ SDL_TTFLibName = 'SDL_ttf.dll';
+ {$ENDIF}
+ {$IFDEF UNIX}
+ SDL_TTFLibName = 'libSDL_ttf.so';
+ {$ENDIF}
+
+
+type PTTF_Font = ^TTTF_font;
+ TTTF_Font = record
+ end;
+
+function TTF_Init: integer; cdecl; external SDL_TTFLibName;
+procedure TTF_Quit; cdecl; external SDL_TTFLibName;
+
+
+function TTF_SizeText(font : PTTF_Font; const text: PChar; var w, h: integer): Integer; cdecl; external SDL_TTFLibName;
+function TTF_RenderText_Solid(font : PTTF_Font; const text: PChar; fg: TSDL_Color): PSDL_Surface; cdecl; external SDL_TTFLibName;
+function TTF_RenderText_Blended(font : PTTF_Font; const text: PChar; fg: TSDL_Color): PSDL_Surface; cdecl; external SDL_TTFLibName;
+function TTF_OpenFont(const filename: Pchar; size: integer): PTTF_Font; cdecl; external SDL_TTFLibName;
+
+(* SDL_mixer *)
+
+const {$IFDEF WIN32}
+ SDL_MixerLibName = 'SDL_mixer.dll';
+ {$ENDIF}
+ {$IFDEF UNIX}
+ SDL_MixerLibName = 'libSDL_mixer.so';
+ {$ENDIF}
+
+type PMixChunk = ^TMixChunk;
+ TMixChunk = record
+ allocated: Longword;
+ abuf : PByte;
+ alen : Longword;
+ volume : PByte;
+ end;
+ TMusic = (MUS_CMD, MUS_WAV, MUS_MOD, MUS_MID, MUS_OGG, MUS_MP3);
+ TMix_Fading = (MIX_NO_FADING, MIX_FADING_OUT, MIX_FADING_IN);
+
+ TMidiSong = record
+ samples : Integer;
+ events : pointer;
+ end;
+
+ TMusicUnion = record
+ case Byte of
+ 0: ( midi : TMidiSong );
+ 1: ( ogg : pointer);
+ end;
+
+ PMixMusic = ^TMixMusic;
+ TMixMusic = record
+ type_ : TMusic;
+ data : TMusicUnion;
+ fading : TMix_Fading;
+ fade_volume,
+ fade_step,
+ fade_steps,
+ error : integer;
+ end;
+
+function Mix_OpenAudio(frequency: integer; format: Word; channels: integer; chunksize: integer): integer; cdecl; external SDL_MixerLibName;
+procedure Mix_CloseAudio; cdecl; external SDL_MixerLibName;
+
+function Mix_VolumeMusic(volume: integer): integer; cdecl; external SDL_MixerLibName;
+
+procedure Mix_FreeChunk(chunk: PMixChunk); cdecl; external SDL_MixerLibName;
+procedure Mix_FreeMusic(music: PMixMusic); cdecl; external SDL_MixerLibName;
+
+function Mix_LoadWAV_RW(src: PSDL_RWops; freesrc: integer): PMixChunk; cdecl; external SDL_MixerLibName;
+function Mix_LoadMUS(const filename: PChar): PMixMusic; cdecl; external SDL_MixerLibName;
+
+function Mix_Playing(channel: integer): integer; cdecl; external SDL_MixerLibName;
+function Mix_PlayingMusic: integer; cdecl; external SDL_MixerLibName;
+
+function Mix_PlayChannelTimed(channel: integer; chunk: PMixChunk; loops: integer; ticks: integer): integer; cdecl; external SDL_MixerLibName;
+function Mix_PlayMusic(music: PMixMusic; loops: integer): integer; cdecl; external SDL_MixerLibName;
+function Mix_HaltChannel(channel: integer): integer; cdecl; external SDL_MixerLibName;
+
+(* SDL_image *)
+
+const {$IFDEF WIN32}
+ SDL_ImageLibName = 'SDL_image.dll';
+ {$ENDIF}
+ {$IFDEF UNIX}
+ SDL_ImageLibName = 'libSDL_image.so';
+ {$ENDIF}
+
+function IMG_Load(const _file: PChar): PSDL_Surface; cdecl; external SDL_ImageLibName;
+
+(* SDL_net *)
+
+const {$IFDEF WIN32}
+ SDL_NetLibName = 'SDL_net.dll';
+ {$ENDIF}
+ {$IFDEF UNIX}
+ SDL_NetLibName = 'libSDL_net.so';
+ {$ENDIF}
+
+type TIPAddress = record
+ host: Longword;
+ port: Word;
+ end;
+
+ PTCPSocket = ^TTCPSocket;
+ TTCPSocket = record
+ ready,
+ channel: integer;
+ remoteAddress,
+ localAddress: TIPaddress;
+ sflag: integer;
+ end;
+ PSDLNet_SocketSet = ^TSDLNet_SocketSet;
+ TSDLNet_SocketSet = record
+ numsockets,
+ maxsockets: integer;
+ sockets: PTCPSocket;
+ end;
+
+function SDLNet_Init: integer; cdecl; external SDL_NetLibName;
+procedure SDLNet_Quit; cdecl; external SDL_NetLibName;
+
+function SDLNet_AllocSocketSet(maxsockets: integer): PSDLNet_SocketSet; cdecl; external SDL_NetLibName;
+function SDLNet_ResolveHost(var address: TIPaddress; host: PCHar; port: Word): integer; cdecl; external SDL_NetLibName;
+function SDLNet_TCP_Accept(server: PTCPsocket): PTCPSocket; cdecl; external SDL_NetLibName;
+function SDLNet_TCP_Open(var ip: TIPaddress): PTCPSocket; cdecl; external SDL_NetLibName;
+function SDLNet_TCP_Send(sock: PTCPsocket; data: Pointer; len: integer): integer; cdecl; external SDL_NetLibName;
+function SDLNet_TCP_Recv(sock: PTCPsocket; data: Pointer; len: integer): integer; cdecl; external SDL_NetLibName;
+procedure SDLNet_TCP_Close(sock: PTCPsocket); cdecl; external SDL_NetLibName;
+procedure SDLNet_FreeSocketSet(_set: PSDLNet_SocketSet); cdecl; external SDL_NetLibName;
+function SDLNet_AddSocket(_set: PSDLNet_SocketSet; sock: PTCPSocket): integer; cdecl; external SDL_NetLibName;
+function SDLNet_CheckSockets(_set: PSDLNet_SocketSet; timeout: integer): integer; cdecl; external SDL_NetLibName;
+
+
+implementation
+
+function SDL_MustLock(Surface: PSDL_Surface): Boolean;
+begin
+Result:= ( surface^.offset <> 0 )
+ or(( surface^.flags and (SDL_HWSURFACE or SDL_ASYNCBLIT or SDL_RLEACCEL)) <> 0)
+end;
+
+end.
--- a/hedgewars/fConsts.pas Mon Aug 22 21:38:06 2005 +0000
+++ b/hedgewars/fConsts.pas Tue Aug 23 16:17:53 2005 +0000
@@ -1,82 +1,82 @@
-(*
- * Hedgewars, a worms-like game
- * Copyright (c) 2004, 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 fConsts;
-interface
-
-const cAppName = '†Hedge Wars Logon†';
- cAppTitle = 'HEDGEWARS';
- cOptionsName = 'Team Options';
- cOptionsTitle = 'Team Options';
- cGFXPath = 'Data\front\';
-
- cLocalGameBtn = 1001;
- cNetGameBtn = 1002;
- cDemoBtn = 1003;
- cSettingsBtn = 1004;
- cExitGameBtn = 1005;
-
- cNetIpEdit = 1021;
- cNetIpStatic = 1022;
- cNetNameEdit = 1023;
- cNetNameStatic= 1024;
- cNetConnStatic= 1024;
- cNetJoinBtn = 1025;
- cNetBeginBtn = 1026;
- cNetBackBtn = 1027;
-
- cDemoList = 1031;
- cDemoBeginBtn = 1032;
- cDemoBackBtn = 1033;
- cDemoAllBtn = 1034;
-
- cSetResEdit = 1041;
- cSetFScrCheck = 1042;
- cSetDemoCheck = 1043;
- cSetSndCheck = 1044;
- cSetSaveBtn = 1045;
- cSetBackBtn = 1046;
- cSetShowTeamOptions = 1047;
-
- cBGStatic = 1199;
- cOptBGStatic = 1198;
-
- cOptTeamName = 1201;
- cOptHedgeName : array[0..7] of integer = (1202,1203,1204,1205,1206,1207,1208,1209);
-
- cDemoSeedSeparator = #10;
-
-
-implementation
-
-end.
+(*
+ * Hedgewars, a worms-like game
+ * Copyright (c) 2004, 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 fConsts;
+interface
+
+const cAppName = '†Hedge Wars Logon†';
+ cAppTitle = 'HEDGEWARS';
+ cOptionsName = 'Team Options';
+ cOptionsTitle = 'Team Options';
+ cGFXPath = 'Data\front\';
+
+ cLocalGameBtn = 1001;
+ cNetGameBtn = 1002;
+ cDemoBtn = 1003;
+ cSettingsBtn = 1004;
+ cExitGameBtn = 1005;
+
+ cNetIpEdit = 1021;
+ cNetIpStatic = 1022;
+ cNetNameEdit = 1023;
+ cNetNameStatic= 1024;
+ cNetConnStatic= 1024;
+ cNetJoinBtn = 1025;
+ cNetBeginBtn = 1026;
+ cNetBackBtn = 1027;
+
+ cDemoList = 1031;
+ cDemoBeginBtn = 1032;
+ cDemoBackBtn = 1033;
+ cDemoAllBtn = 1034;
+
+ cSetResEdit = 1041;
+ cSetFScrCheck = 1042;
+ cSetDemoCheck = 1043;
+ cSetSndCheck = 1044;
+ cSetSaveBtn = 1045;
+ cSetBackBtn = 1046;
+ cSetShowTeamOptions = 1047;
+
+ cBGStatic = 1199;
+ cOptBGStatic = 1198;
+
+ cOptTeamName = 1201;
+ cOptHedgeName : array[0..7] of integer = (1202,1203,1204,1205,1206,1207,1208,1209);
+
+ cDemoSeedSeparator = #10;
+
+
+implementation
+
+end.
--- a/hedgewars/fGUI.pas Mon Aug 22 21:38:06 2005 +0000
+++ b/hedgewars/fGUI.pas Tue Aug 23 16:17:53 2005 +0000
@@ -1,318 +1,318 @@
-(*
- * Hedgewars, a worms-like game
- * Copyright (c) 2004, 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 fGUI;
-interface
-uses Windows;
-
-procedure ProcessMessages;
-function GetWindowTextStr(hwnd: HWND): string;
-procedure DoControlPress(wParam: WPARAM; lParam: LPARAM);
-procedure DoDrawButton(idCtl: UINT; lpmis: PDrawItemStruct);
-procedure LoadGraphics;
-procedure DoDestroy;
-procedure DoCreateControls;
-procedure DoCreateMainWindow;
-
-
-var hwndMain,hwndOptions: HWND;
-var isTerminated: boolean = false;
-var //main menu
- bitmap ,optbmp ,localbmp ,netbmp ,demobmp ,exitbmp ,setsbmp : HBITMAP;
- BackGroundDC ,OptBGroundDC ,DCLocalGame ,DCNetGame ,DCDemoPlay ,DCExitGame ,DCSettings : HDC;
- HLocalGameBtn ,HNetGameBtm ,HDemoBtn ,HExitGameBtn ,HSettingsBtn, HBGStatic : HWND;
- //other
- HNetIPEdit,HNetIPStatic: HWND;
- HNetNameEdit,HNetNameStatic,HNetConnectionStatic: HWND;
- HNetJoinBtn,HNetBeginBtn,HNetBackBtn:HWND;
- HDemoList,HDemoBeginBtn,HDemoBackBtn,HDemoAllBtn:HWND;
- HSetResEdit,HFullScrCheck,HSetDemoCheck,HSetSndCheck,HSetSaveBtn,HSetBackBtn,HSetShowTeamOptionsBtn:HWND;
- scrx, scry: real;
-
-
-implementation
-uses fConsts, Messages, SysUtils, uConsts, fGame, fNet, fMisc, fOptionsGUI;
-
-function GetWindowTextStr(hwnd: HWND): string;
-var i: integer;
-begin
-i:= GetWindowTextLength(hwnd);
-SetLength(Result, i);
-GetWindowText(hwnd, PChar(Result), Succ(i))
-end;
-
-
-procedure ProcessMessages;
-var Message: Windows.MSG;
-begin
-if PeekMessage(Message,0,0,0,PM_REMOVE) then
- if Message.message <> WM_QUIT then
- begin
- TranslateMessage(Message);
- DispatchMessage(Message)
- end else isTerminated:= true
-end;
-
-procedure HideMain;
-begin
-ShowWindow(HLocalGameBtn,SW_HIDE);
-ShowWindow(HNetGameBtm,SW_HIDE);
-ShowWindow(HDemoBtn,SW_HIDE);
-ShowWindow(HSettingsBtn,SW_HIDE);
-ShowWindow(HExitGameBtn,SW_HIDE)
-end;
-
-procedure ShowMain;
-begin
-ShowWindow(HLocalGameBtn,SW_SHOW);
-ShowWindow(HNetGameBtm,SW_SHOW);
-ShowWindow(HDemoBtn,SW_SHOW);
-ShowWindow(HSettingsBtn,SW_SHOW);
-ShowWindow(HExitGameBtn,SW_SHOW);
-SetFocus(HLocalGameBtn)
-end;
-
-
-
-procedure ShowNetGameMenu;
-begin
-HideMain;
-ShowWindow(HNetIPStatic,SW_SHOW);
-ShowWindow(HNetIPEdit,SW_SHOW);
-ShowWindow(HNetNameStatic,SW_SHOW);
-ShowWindow(HNetNameEdit,SW_SHOW);
-ShowWindow(HNetConnectionStatic,SW_SHOW);
-ShowWindow(HNetJoinBtn,SW_SHOW);
-ShowWindow(HNetBeginBtn,SW_SHOW);
-ShowWindow(HNetBackBtn,SW_SHOW);
-SetFocus(HNetJoinBtn)
-end;
-
-
-procedure ShowMainFromNetMenu;
-begin
-ShowWindow(HNetIPEdit,SW_HIDE);
-ShowWindow(HNetIPStatic,SW_HIDE);
-ShowWindow(HNetNameEdit,SW_HIDE);
-ShowWindow(HNetNameStatic,SW_HIDE);
-ShowWindow(HNetConnectionStatic,SW_HIDE);
-ShowWindow(HNetJoinBtn,SW_HIDE);
-ShowWindow(HNetBeginBtn,SW_HIDE);
-ShowWindow(HNetBackBtn,SW_HIDE);
-ShowMain
-end;
-
-
-procedure ShowDemoMenu;
-var i: integer;
- sr: TSearchRec;
-begin
-SendMessage(HDemoList, LB_RESETCONTENT, 0, 0);
-i:= FindFirst(format('%s*.hwd_%d',[Pathz[ptDemos], cNetProtoVersion]), faAnyFile and not faDirectory, sr);
-while i = 0 do
- begin
- SendMessage(HDemoList, LB_ADDSTRING, 0, LPARAM(PChar(sr.Name)));
- i:= FindNext(sr)
- end;
-FindClose(sr);
-
-HideMain;
-
-ShowWindow(HDemoList,SW_SHOW);
-ShowWindow(HDemoBeginBtn,SW_SHOW);
-ShowWindow(HDemoAllBtn,SW_SHOW);
-ShowWindow(HDemoBackBtn,SW_SHOW);
-SetFocus(HDemoList)
-end;
-
-procedure ShowMainFromDemoMenu;
-begin
-ShowWindow(HDemoList,SW_HIDE);
-ShowWindow(HDemoBeginBtn,SW_HIDE);
-ShowWindow(HDemoAllBtn,SW_HIDE);
-ShowWindow(HDemoBackBtn,SW_HIDE);
-ShowMain
-end;
-
-procedure ShowSettingsMenu;
-begin
-HideMain;
-ShowWindow(HSetResEdit,SW_SHOW);
-ShowWindow(HFullScrCheck,SW_SHOW);
-ShowWindow(HSetDemoCheck,SW_SHOW);
-ShowWindow(HSetSndCheck,SW_SHOW);
-ShowWindow(HSetSaveBtn,SW_SHOW);
-ShowWindow(HSetBackBtn,SW_SHOW);
-ShowWindow(HSetShowTeamOptionsBtn,SW_SHOW);
-SetFocus(HSetResEdit)
-end;
-
-procedure ShowMainFromSettings;
-begin
-ShowWindow(HSetResEdit,SW_HIDE);
-ShowWindow(HFullScrCheck,SW_HIDE);
-ShowWindow(HSetDemoCheck,SW_HIDE);
-ShowWindow(HSetSndCheck,SW_HIDE);
-ShowWindow(HSetSaveBtn,SW_HIDE);
-ShowWindow(HSetBackBtn,SW_HIDE);
-ShowWindow(HSetShowTeamOptionsBtn,SW_HIDE);
-ShowMain
-end;
-
-procedure DoControlPress(wParam: WPARAM; lParam: LPARAM);
-begin
-case LOWORD(wParam) of
- cLocalGameBtn : StartLocalGame;
- cNetGameBtn : ShowNetGameMenu;
- cDemoBtn : ShowDemoMenu;
- cSettingsBtn : ShowSettingsMenu;
- cExitGameBtn : Halt;
- cNetBackBtn : ShowMainFromNetMenu;
- cNetJoinBtn : NetConnect;
- cNetBeginBtn : StartNetGame;
- cDemoBackBtn : ShowMainFromDemoMenu;
- cDemoAllBtn : MessageBeep(0);//PlayAllDemos;
- cDemoBeginBtn : StartDemoView;
- cSetSaveBtn : SaveSettings;
- cSetBackBtn : ShowMainFromSettings;
- cSetShowTeamOptions : ShowOptionsWindow;
- end
-end;
-
-procedure DoDrawButton(idCtl: UINT; lpmis: PDrawItemStruct);
-begin
-case lpmis.CtlID of
- cLocalGameBtn: StretchBlt(lpmis.hDC,0,0,trunc(309*scrx),trunc(22*scry),DCLocalGame,0,0,309,22,SRCCOPY);
- cNetGameBtn: StretchBlt(lpmis.hDC,0,0,trunc(272*scrx),trunc(22*scry),DCNetGame ,0,0,272,22,SRCCOPY);
- cDemoBtn: StretchBlt(lpmis.hDC,0,0,trunc(181*scrx),trunc(22*scry),DCDemoPlay ,0,0,181,22,SRCCOPY);
- cSettingsBtn: StretchBlt(lpmis.hDC,0,0,trunc(147*scrx),trunc(22*scry),DCSettings ,0,0,147,22,SRCCOPY);
- cExitGameBtn: StretchBlt(lpmis.hDC,0,0,trunc(272*scrx),trunc(22*scry),DCExitGame ,0,0,272,22,SRCCOPY);
- cBGStatic: StretchBlt(lpmis.hDC,0,0,trunc(1024*scrx),trunc(768*scry),BackGroundDC,0,0,1024,768,SRCCOPY);
- cOptBGStatic: StretchBlt(lpmis.hDC,0,0,trunc(1024*scrx),trunc(768*scry),OptBGroundDC,0,0,1024,768,SRCCOPY);
- end
-end;
-
-procedure LoadGraphics;
-begin
-scrx := GetSystemMetrics(SM_CXSCREEN)/1024;
-scry := GetSystemMetrics(SM_CYSCREEN)/768;
-LoadOwnerBitmap(bitmap, cGFXPath + 'front.bmp', BackGroundDC,hwndMain);
-LoadOwnerBitmap(optbmp, cGFXPath + 'TeamSettings.bmp',OptBGroundDC,hwndOptions);
-LoadOwnerBitmap(localbmp,cGFXPath + 'startlocal.bmp', DCLocalGame,cLocalGameBtn);
-LoadOwnerBitmap(netbmp, cGFXPath + 'startnet.bmp', DCNetGame, cNetGameBtn);
-LoadOwnerBitmap(demobmp, cGFXPath + 'playdemo.bmp', DCDemoPlay, cDemoBtn);
-LoadOwnerBitmap(setsbmp, cGFXPath + 'settings.bmp', DCSettings, cSettingsBtn);
-LoadOwnerBitmap(exitbmp, cGFXPath + 'exit.bmp', DCExitGame, cExitGameBtn);
-end;
-
-procedure DoDestroy;
-begin
-DeleteObject(localbmp);
-DeleteObject(optbmp);
-DeleteObject(bitmap);
-DeleteObject(netbmp);
-DeleteObject(demobmp);
-DeleteObject(setsbmp);
-DeleteObject(bitmap);
-DeleteDC(DCLocalGame);
-DeleteDC(DCNetGame);
-DeleteDC(DCDemoPlay);
-DeleteDC(DCSettings);
-DeleteDC(BackGroundDC);
-DeleteDC(OptBGroundDC)
-end;
-
-procedure DoCreateControls;
-begin
-HBGStatic := CreateWindow('STATIC','bg image static' ,WS_CHILD or WS_VISIBLE or SS_OWNERDRAW, 0, 0, GetSystemMetrics(SM_CXSCREEN), GetSystemMetrics(SM_CYSCREEN), hwndMain, cBGStatic, HInstance, nil);
-/// main menu ///
-HLocalGameBtn := CreateWindow('button','local game button',WS_CHILD or WS_VISIBLE or BS_OWNERDRAW, trunc(510 * scrx), trunc(400 *scry), trunc(309* scrx) , trunc(22*scry) , hwndMain , cLocalGameBtn, HInstance, nil );
-HNetGameBtm := CreateWindow('button', 'net game button',WS_CHILD or WS_VISIBLE or BS_OWNERDRAW, trunc(530 * scrx), trunc(450 *scry), trunc(272* scrx) , trunc(22*scry) , hwndMain , cNetGameBtn, HInstance, nil );
-HDemoBtn := CreateWindow('button', 'play demo button',WS_CHILD or WS_VISIBLE or BS_OWNERDRAW, trunc(570 * scrx), trunc(500 *scry), trunc(181* scrx) , trunc(22*scry) , hwndMain , cDemoBtn, HInstance, nil );
-HSettingsBtn := CreateWindow('button', 'settings button',WS_CHILD or WS_VISIBLE or BS_OWNERDRAW, trunc(590 * scrx), trunc(550 *scry), trunc(147* scrx) , trunc(22*scry) , hwndMain , cSettingsBtn, HInstance, nil );
-HExitGameBtn := CreateWindow('button', 'exit game button',WS_CHILD or WS_VISIBLE or BS_OWNERDRAW, trunc(530 * scrx), trunc(600 *scry), trunc(272* scrx) , trunc(22*scry) , hwndMain , cExitGameBtn, HInstance, nil );
-/// local menu ///
-/// net menu ///
-HNetIPEdit := CreateWindow('EDIT', '255.255.255.255' ,WS_CHILD or WS_TABSTOP, trunc(570* scrx), trunc(400*scry) , 150 , 16 , hwndMain , cNetIpEdit, HInstance, nil );
-HNetIPStatic := CreateWindow('STATIC','IP :' ,WS_CHILD or SS_SIMPLE, trunc(520* scrx), trunc(400*scry) , 50 , 16 , hwndMain , cNetIpStatic, HInstance, nil );
-HNetNameEdit := CreateWindow('EDIT', 'Hedgewarrior' ,WS_CHILD or WS_TABSTOP, trunc(570* scrx), trunc(420*scry) , 150 , 16 , hwndMain , cNetNameEdit, HInstance, nil );
-HNetNameStatic := CreateWindow('STATIC','Name : ' ,WS_CHILD or SS_SIMPLE, trunc(520* scrx), trunc(420*scry) , 50 , 16 , hwndMain , cNetNameStatic, HInstance, nil );
-HNetConnectionStatic
- := CreateWindow('STATIC','not connected' ,WS_CHILD, trunc(520* scrx), trunc(450*scry) , 90 , 16 , hwndMain , cNetConnStatic, HInstance, nil );
-HNetJoinBtn := CreateWindow('BUTTON','Join Game' ,WS_CHILD or BS_FLAT or WS_TABSTOP, trunc(520* scrx), trunc(550*scry) , 90 , 20 , hwndMain , cNetJoinBtn, HInstance, nil );
-HNetBeginBtn := CreateWindow('BUTTON','Begin Game' ,WS_CHILD or BS_FLAT or WS_TABSTOP, trunc(520* scrx), trunc(575*scry) , 90 , 20 , hwndMain , cNetBeginBtn, HInstance, nil );
-HNetBackBtn := CreateWindow('BUTTON','Back' ,WS_CHILD or BS_FLAT or WS_TABSTOP, trunc(520* scrx), trunc(600*scry) , 90 , 20 , hwndMain , cNetBackBtn, HInstance, nil );
-/// demo menu ///
-HDemoList := CreateWindow('LISTBOX','' ,WS_CHILD or WS_TABSTOP, trunc(530* scrx), trunc(400*scry) , trunc(200* scrx), trunc(200*scry), hwndMain, cDemoList, HInstance, nil );
-HDemoBeginBtn := CreateWindow('BUTTON','Play demo' ,WS_CHILD or BS_FLAT or WS_TABSTOP, trunc(750* scrx), trunc(400*scry) , 100 , 20 , hwndMain , cDemoBeginBtn, HInstance, nil );
-HDemoAllBtn := CreateWindow('BUTTON','Play all demos' ,WS_CHILD or BS_FLAT or WS_TABSTOP, trunc(750* scrx), trunc(425*scry) , 100 , 20 , hwndMain , cDemoAllBtn, HInstance, nil );
-HDemoBackBtn := CreateWindow('BUTTON','Back' ,WS_CHILD or BS_FLAT or WS_TABSTOP, trunc(750* scrx), trunc(450*scry) , 100 , 20 , hwndMain , cDemoBackBtn, HInstance, nil );
-
-/// settings menu ///
-HSetResEdit := CreateWindow('COMBOBOX', '' ,WS_CHILD or CBS_DROPDOWNLIST or WS_TABSTOP, trunc(530* scrx), trunc(420*scry) , 150 , 100 , hwndMain , cSetResEdit, HInstance, nil );
-
-SendMessage(HSetResEdit, CB_ADDSTRING, 0, LPARAM(PChar('640x480')));
-SendMessage(HSetResEdit, CB_ADDSTRING, 0, LPARAM(PChar('800x600')));
-SendMessage(HSetResEdit, CB_ADDSTRING, 0, LPARAM(PChar('1024x768')));
-SendMessage(HSetResEdit, CB_ADDSTRING, 0, LPARAM(PChar('1280x1024')));
-
-HFullScrCheck := CreateWindow('BUTTON','Fullscreen' ,WS_CHILD or BS_AUTOCHECKBOX or WS_TABSTOP, trunc(530* scrx), trunc(450*scry) , 110 , 20 , hwndMain , cSetFScrCheck, HInstance, nil );
-HSetDemoCheck := CreateWindow('BUTTON','Record Demo' ,WS_CHILD or BS_AUTOCHECKBOX or WS_TABSTOP, trunc(530* scrx), trunc(475*scry) , 110 , 20 , hwndMain , cSetDemoCheck, HInstance, nil );
-HSetSndCheck := CreateWindow('BUTTON','Enable Sound' ,WS_CHILD or BS_AUTOCHECKBOX or WS_TABSTOP, trunc(530* scrx), trunc(500*scry) , 110 , 20 , hwndMain , cSetSndCheck, HInstance, nil );
-HSetSaveBtn := CreateWindow('BUTTON','Save Settings' ,WS_CHILD or BS_FLAT or WS_TABSTOP, trunc(530* scrx), trunc(580*scry) , 100 , 20 , hwndMain , cSetSaveBtn, HInstance, nil );
-HSetBackBtn := CreateWindow('BUTTON','Back' ,WS_CHILD or BS_FLAT or WS_TABSTOP, trunc(730* scrx), trunc(580*scry) , 90 , 20 , hwndMain , cSetBackBtn, HInstance, nil );
-HSetShowTeamOptionsBtn := CreateWindow('BUTTON','Show Team Options' ,WS_CHILD or BS_FLAT or WS_TABSTOP, trunc(700* scrx), trunc(420*scry) , 140 , 20 , hwndMain , cSetShowTeamOptions, HInstance, nil );
-end;
-
-procedure DoCreateMainWindow;
-var wc: WNDCLASS;
-begin
-FillChar(wc, sizeof(wc), 0);
-wc.style := CS_VREDRAW or CS_HREDRAW;
-wc.hbrBackground := COLOR_BACKGROUND;
-wc.lpfnWndProc := @MainWndProc;
-wc.hInstance := hInstance;
-wc.lpszClassName := cAppName;
-wc.hCursor := LoadCursor(hwndMain,IDC_ARROW);
-if RegisterClass(wc) = 0 then begin MessageBox(0,'RegisterClass failed for main wnd','Failed',MB_OK); halt; end;
-hwndMain := CreateWindowEx( 0, cAppName, cAppTitle, WS_POPUP,
- 0, 0,
- GetSystemMetrics(SM_CXSCREEN), GetSystemMetrics(SM_CYSCREEN),
- 0, 0, hInstance, nil);
-
-ShowWindow(hwndMain,SW_SHOW);
-UpdateWindow(hwndMain)
-end;
-
-
-end.
+(*
+ * Hedgewars, a worms-like game
+ * Copyright (c) 2004, 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 fGUI;
+interface
+uses Windows;
+
+procedure ProcessMessages;
+function GetWindowTextStr(hwnd: HWND): string;
+procedure DoControlPress(wParam: WPARAM; lParam: LPARAM);
+procedure DoDrawButton(idCtl: UINT; lpmis: PDrawItemStruct);
+procedure LoadGraphics;
+procedure DoDestroy;
+procedure DoCreateControls;
+procedure DoCreateMainWindow;
+
+
+var hwndMain,hwndOptions: HWND;
+var isTerminated: boolean = false;
+var //main menu
+ bitmap ,optbmp ,localbmp ,netbmp ,demobmp ,exitbmp ,setsbmp : HBITMAP;
+ BackGroundDC ,OptBGroundDC ,DCLocalGame ,DCNetGame ,DCDemoPlay ,DCExitGame ,DCSettings : HDC;
+ HLocalGameBtn ,HNetGameBtm ,HDemoBtn ,HExitGameBtn ,HSettingsBtn, HBGStatic : HWND;
+ //other
+ HNetIPEdit,HNetIPStatic: HWND;
+ HNetNameEdit,HNetNameStatic,HNetConnectionStatic: HWND;
+ HNetJoinBtn,HNetBeginBtn,HNetBackBtn:HWND;
+ HDemoList,HDemoBeginBtn,HDemoBackBtn,HDemoAllBtn:HWND;
+ HSetResEdit,HFullScrCheck,HSetDemoCheck,HSetSndCheck,HSetSaveBtn,HSetBackBtn,HSetShowTeamOptionsBtn:HWND;
+ scrx, scry: real;
+
+
+implementation
+uses fConsts, Messages, SysUtils, uConsts, fGame, fNet, fMisc, fOptionsGUI;
+
+function GetWindowTextStr(hwnd: HWND): string;
+var i: integer;
+begin
+i:= GetWindowTextLength(hwnd);
+SetLength(Result, i);
+GetWindowText(hwnd, PChar(Result), Succ(i))
+end;
+
+
+procedure ProcessMessages;
+var Message: Windows.MSG;
+begin
+if PeekMessage(Message,0,0,0,PM_REMOVE) then
+ if Message.message <> WM_QUIT then
+ begin
+ TranslateMessage(Message);
+ DispatchMessage(Message)
+ end else isTerminated:= true
+end;
+
+procedure HideMain;
+begin
+ShowWindow(HLocalGameBtn,SW_HIDE);
+ShowWindow(HNetGameBtm,SW_HIDE);
+ShowWindow(HDemoBtn,SW_HIDE);
+ShowWindow(HSettingsBtn,SW_HIDE);
+ShowWindow(HExitGameBtn,SW_HIDE)
+end;
+
+procedure ShowMain;
+begin
+ShowWindow(HLocalGameBtn,SW_SHOW);
+ShowWindow(HNetGameBtm,SW_SHOW);
+ShowWindow(HDemoBtn,SW_SHOW);
+ShowWindow(HSettingsBtn,SW_SHOW);
+ShowWindow(HExitGameBtn,SW_SHOW);
+SetFocus(HLocalGameBtn)
+end;
+
+
+
+procedure ShowNetGameMenu;
+begin
+HideMain;
+ShowWindow(HNetIPStatic,SW_SHOW);
+ShowWindow(HNetIPEdit,SW_SHOW);
+ShowWindow(HNetNameStatic,SW_SHOW);
+ShowWindow(HNetNameEdit,SW_SHOW);
+ShowWindow(HNetConnectionStatic,SW_SHOW);
+ShowWindow(HNetJoinBtn,SW_SHOW);
+ShowWindow(HNetBeginBtn,SW_SHOW);
+ShowWindow(HNetBackBtn,SW_SHOW);
+SetFocus(HNetJoinBtn)
+end;
+
+
+procedure ShowMainFromNetMenu;
+begin
+ShowWindow(HNetIPEdit,SW_HIDE);
+ShowWindow(HNetIPStatic,SW_HIDE);
+ShowWindow(HNetNameEdit,SW_HIDE);
+ShowWindow(HNetNameStatic,SW_HIDE);
+ShowWindow(HNetConnectionStatic,SW_HIDE);
+ShowWindow(HNetJoinBtn,SW_HIDE);
+ShowWindow(HNetBeginBtn,SW_HIDE);
+ShowWindow(HNetBackBtn,SW_HIDE);
+ShowMain
+end;
+
+
+procedure ShowDemoMenu;
+var i: integer;
+ sr: TSearchRec;
+begin
+SendMessage(HDemoList, LB_RESETCONTENT, 0, 0);
+i:= FindFirst(format('%s*.hwd_%d',[Pathz[ptDemos], cNetProtoVersion]), faAnyFile and not faDirectory, sr);
+while i = 0 do
+ begin
+ SendMessage(HDemoList, LB_ADDSTRING, 0, LPARAM(PChar(sr.Name)));
+ i:= FindNext(sr)
+ end;
+FindClose(sr);
+
+HideMain;
+
+ShowWindow(HDemoList,SW_SHOW);
+ShowWindow(HDemoBeginBtn,SW_SHOW);
+ShowWindow(HDemoAllBtn,SW_SHOW);
+ShowWindow(HDemoBackBtn,SW_SHOW);
+SetFocus(HDemoList)
+end;
+
+procedure ShowMainFromDemoMenu;
+begin
+ShowWindow(HDemoList,SW_HIDE);
+ShowWindow(HDemoBeginBtn,SW_HIDE);
+ShowWindow(HDemoAllBtn,SW_HIDE);
+ShowWindow(HDemoBackBtn,SW_HIDE);
+ShowMain
+end;
+
+procedure ShowSettingsMenu;
+begin
+HideMain;
+ShowWindow(HSetResEdit,SW_SHOW);
+ShowWindow(HFullScrCheck,SW_SHOW);
+ShowWindow(HSetDemoCheck,SW_SHOW);
+ShowWindow(HSetSndCheck,SW_SHOW);
+ShowWindow(HSetSaveBtn,SW_SHOW);
+ShowWindow(HSetBackBtn,SW_SHOW);
+ShowWindow(HSetShowTeamOptionsBtn,SW_SHOW);
+SetFocus(HSetResEdit)
+end;
+
+procedure ShowMainFromSettings;
+begin
+ShowWindow(HSetResEdit,SW_HIDE);
+ShowWindow(HFullScrCheck,SW_HIDE);
+ShowWindow(HSetDemoCheck,SW_HIDE);
+ShowWindow(HSetSndCheck,SW_HIDE);
+ShowWindow(HSetSaveBtn,SW_HIDE);
+ShowWindow(HSetBackBtn,SW_HIDE);
+ShowWindow(HSetShowTeamOptionsBtn,SW_HIDE);
+ShowMain
+end;
+
+procedure DoControlPress(wParam: WPARAM; lParam: LPARAM);
+begin
+case LOWORD(wParam) of
+ cLocalGameBtn : StartLocalGame;
+ cNetGameBtn : ShowNetGameMenu;
+ cDemoBtn : ShowDemoMenu;
+ cSettingsBtn : ShowSettingsMenu;
+ cExitGameBtn : Halt;
+ cNetBackBtn : ShowMainFromNetMenu;
+ cNetJoinBtn : NetConnect;
+ cNetBeginBtn : StartNetGame;
+ cDemoBackBtn : ShowMainFromDemoMenu;
+ cDemoAllBtn : MessageBeep(0);//PlayAllDemos;
+ cDemoBeginBtn : StartDemoView;
+ cSetSaveBtn : SaveSettings;
+ cSetBackBtn : ShowMainFromSettings;
+ cSetShowTeamOptions : ShowOptionsWindow;
+ end
+end;
+
+procedure DoDrawButton(idCtl: UINT; lpmis: PDrawItemStruct);
+begin
+case lpmis.CtlID of
+ cLocalGameBtn: StretchBlt(lpmis.hDC,0,0,trunc(309*scrx),trunc(22*scry),DCLocalGame,0,0,309,22,SRCCOPY);
+ cNetGameBtn: StretchBlt(lpmis.hDC,0,0,trunc(272*scrx),trunc(22*scry),DCNetGame ,0,0,272,22,SRCCOPY);
+ cDemoBtn: StretchBlt(lpmis.hDC,0,0,trunc(181*scrx),trunc(22*scry),DCDemoPlay ,0,0,181,22,SRCCOPY);
+ cSettingsBtn: StretchBlt(lpmis.hDC,0,0,trunc(147*scrx),trunc(22*scry),DCSettings ,0,0,147,22,SRCCOPY);
+ cExitGameBtn: StretchBlt(lpmis.hDC,0,0,trunc(272*scrx),trunc(22*scry),DCExitGame ,0,0,272,22,SRCCOPY);
+ cBGStatic: StretchBlt(lpmis.hDC,0,0,trunc(1024*scrx),trunc(768*scry),BackGroundDC,0,0,1024,768,SRCCOPY);
+ cOptBGStatic: StretchBlt(lpmis.hDC,0,0,trunc(1024*scrx),trunc(768*scry),OptBGroundDC,0,0,1024,768,SRCCOPY);
+ end
+end;
+
+procedure LoadGraphics;
+begin
+scrx := GetSystemMetrics(SM_CXSCREEN)/1024;
+scry := GetSystemMetrics(SM_CYSCREEN)/768;
+LoadOwnerBitmap(bitmap, cGFXPath + 'front.bmp', BackGroundDC,hwndMain);
+LoadOwnerBitmap(optbmp, cGFXPath + 'TeamSettings.bmp',OptBGroundDC,hwndOptions);
+LoadOwnerBitmap(localbmp,cGFXPath + 'startlocal.bmp', DCLocalGame,cLocalGameBtn);
+LoadOwnerBitmap(netbmp, cGFXPath + 'startnet.bmp', DCNetGame, cNetGameBtn);
+LoadOwnerBitmap(demobmp, cGFXPath + 'playdemo.bmp', DCDemoPlay, cDemoBtn);
+LoadOwnerBitmap(setsbmp, cGFXPath + 'settings.bmp', DCSettings, cSettingsBtn);
+LoadOwnerBitmap(exitbmp, cGFXPath + 'exit.bmp', DCExitGame, cExitGameBtn);
+end;
+
+procedure DoDestroy;
+begin
+DeleteObject(localbmp);
+DeleteObject(optbmp);
+DeleteObject(bitmap);
+DeleteObject(netbmp);
+DeleteObject(demobmp);
+DeleteObject(setsbmp);
+DeleteObject(bitmap);
+DeleteDC(DCLocalGame);
+DeleteDC(DCNetGame);
+DeleteDC(DCDemoPlay);
+DeleteDC(DCSettings);
+DeleteDC(BackGroundDC);
+DeleteDC(OptBGroundDC)
+end;
+
+procedure DoCreateControls;
+begin
+HBGStatic := CreateWindow('STATIC','bg image static' ,WS_CHILD or WS_VISIBLE or SS_OWNERDRAW, 0, 0, GetSystemMetrics(SM_CXSCREEN), GetSystemMetrics(SM_CYSCREEN), hwndMain, cBGStatic, HInstance, nil);
+/// main menu ///
+HLocalGameBtn := CreateWindow('button','local game button',WS_CHILD or WS_VISIBLE or BS_OWNERDRAW, trunc(510 * scrx), trunc(400 *scry), trunc(309* scrx) , trunc(22*scry) , hwndMain , cLocalGameBtn, HInstance, nil );
+HNetGameBtm := CreateWindow('button', 'net game button',WS_CHILD or WS_VISIBLE or BS_OWNERDRAW, trunc(530 * scrx), trunc(450 *scry), trunc(272* scrx) , trunc(22*scry) , hwndMain , cNetGameBtn, HInstance, nil );
+HDemoBtn := CreateWindow('button', 'play demo button',WS_CHILD or WS_VISIBLE or BS_OWNERDRAW, trunc(570 * scrx), trunc(500 *scry), trunc(181* scrx) , trunc(22*scry) , hwndMain , cDemoBtn, HInstance, nil );
+HSettingsBtn := CreateWindow('button', 'settings button',WS_CHILD or WS_VISIBLE or BS_OWNERDRAW, trunc(590 * scrx), trunc(550 *scry), trunc(147* scrx) , trunc(22*scry) , hwndMain , cSettingsBtn, HInstance, nil );
+HExitGameBtn := CreateWindow('button', 'exit game button',WS_CHILD or WS_VISIBLE or BS_OWNERDRAW, trunc(530 * scrx), trunc(600 *scry), trunc(272* scrx) , trunc(22*scry) , hwndMain , cExitGameBtn, HInstance, nil );
+/// local menu ///
+/// net menu ///
+HNetIPEdit := CreateWindow('EDIT', '255.255.255.255' ,WS_CHILD or WS_TABSTOP, trunc(570* scrx), trunc(400*scry) , 150 , 16 , hwndMain , cNetIpEdit, HInstance, nil );
+HNetIPStatic := CreateWindow('STATIC','IP :' ,WS_CHILD or SS_SIMPLE, trunc(520* scrx), trunc(400*scry) , 50 , 16 , hwndMain , cNetIpStatic, HInstance, nil );
+HNetNameEdit := CreateWindow('EDIT', 'Hedgewarrior' ,WS_CHILD or WS_TABSTOP, trunc(570* scrx), trunc(420*scry) , 150 , 16 , hwndMain , cNetNameEdit, HInstance, nil );
+HNetNameStatic := CreateWindow('STATIC','Name : ' ,WS_CHILD or SS_SIMPLE, trunc(520* scrx), trunc(420*scry) , 50 , 16 , hwndMain , cNetNameStatic, HInstance, nil );
+HNetConnectionStatic
+ := CreateWindow('STATIC','not connected' ,WS_CHILD, trunc(520* scrx), trunc(450*scry) , 90 , 16 , hwndMain , cNetConnStatic, HInstance, nil );
+HNetJoinBtn := CreateWindow('BUTTON','Join Game' ,WS_CHILD or BS_FLAT or WS_TABSTOP, trunc(520* scrx), trunc(550*scry) , 90 , 20 , hwndMain , cNetJoinBtn, HInstance, nil );
+HNetBeginBtn := CreateWindow('BUTTON','Begin Game' ,WS_CHILD or BS_FLAT or WS_TABSTOP, trunc(520* scrx), trunc(575*scry) , 90 , 20 , hwndMain , cNetBeginBtn, HInstance, nil );
+HNetBackBtn := CreateWindow('BUTTON','Back' ,WS_CHILD or BS_FLAT or WS_TABSTOP, trunc(520* scrx), trunc(600*scry) , 90 , 20 , hwndMain , cNetBackBtn, HInstance, nil );
+/// demo menu ///
+HDemoList := CreateWindow('LISTBOX','' ,WS_CHILD or WS_TABSTOP, trunc(530* scrx), trunc(400*scry) , trunc(200* scrx), trunc(200*scry), hwndMain, cDemoList, HInstance, nil );
+HDemoBeginBtn := CreateWindow('BUTTON','Play demo' ,WS_CHILD or BS_FLAT or WS_TABSTOP, trunc(750* scrx), trunc(400*scry) , 100 , 20 , hwndMain , cDemoBeginBtn, HInstance, nil );
+HDemoAllBtn := CreateWindow('BUTTON','Play all demos' ,WS_CHILD or BS_FLAT or WS_TABSTOP, trunc(750* scrx), trunc(425*scry) , 100 , 20 , hwndMain , cDemoAllBtn, HInstance, nil );
+HDemoBackBtn := CreateWindow('BUTTON','Back' ,WS_CHILD or BS_FLAT or WS_TABSTOP, trunc(750* scrx), trunc(450*scry) , 100 , 20 , hwndMain , cDemoBackBtn, HInstance, nil );
+
+/// settings menu ///
+HSetResEdit := CreateWindow('COMBOBOX', '' ,WS_CHILD or CBS_DROPDOWNLIST or WS_TABSTOP, trunc(530* scrx), trunc(420*scry) , 150 , 100 , hwndMain , cSetResEdit, HInstance, nil );
+
+SendMessage(HSetResEdit, CB_ADDSTRING, 0, LPARAM(PChar('640x480')));
+SendMessage(HSetResEdit, CB_ADDSTRING, 0, LPARAM(PChar('800x600')));
+SendMessage(HSetResEdit, CB_ADDSTRING, 0, LPARAM(PChar('1024x768')));
+SendMessage(HSetResEdit, CB_ADDSTRING, 0, LPARAM(PChar('1280x1024')));
+
+HFullScrCheck := CreateWindow('BUTTON','Fullscreen' ,WS_CHILD or BS_AUTOCHECKBOX or WS_TABSTOP, trunc(530* scrx), trunc(450*scry) , 110 , 20 , hwndMain , cSetFScrCheck, HInstance, nil );
+HSetDemoCheck := CreateWindow('BUTTON','Record Demo' ,WS_CHILD or BS_AUTOCHECKBOX or WS_TABSTOP, trunc(530* scrx), trunc(475*scry) , 110 , 20 , hwndMain , cSetDemoCheck, HInstance, nil );
+HSetSndCheck := CreateWindow('BUTTON','Enable Sound' ,WS_CHILD or BS_AUTOCHECKBOX or WS_TABSTOP, trunc(530* scrx), trunc(500*scry) , 110 , 20 , hwndMain , cSetSndCheck, HInstance, nil );
+HSetSaveBtn := CreateWindow('BUTTON','Save Settings' ,WS_CHILD or BS_FLAT or WS_TABSTOP, trunc(530* scrx), trunc(580*scry) , 100 , 20 , hwndMain , cSetSaveBtn, HInstance, nil );
+HSetBackBtn := CreateWindow('BUTTON','Back' ,WS_CHILD or BS_FLAT or WS_TABSTOP, trunc(730* scrx), trunc(580*scry) , 90 , 20 , hwndMain , cSetBackBtn, HInstance, nil );
+HSetShowTeamOptionsBtn := CreateWindow('BUTTON','Show Team Options' ,WS_CHILD or BS_FLAT or WS_TABSTOP, trunc(700* scrx), trunc(420*scry) , 140 , 20 , hwndMain , cSetShowTeamOptions, HInstance, nil );
+end;
+
+procedure DoCreateMainWindow;
+var wc: WNDCLASS;
+begin
+FillChar(wc, sizeof(wc), 0);
+wc.style := CS_VREDRAW or CS_HREDRAW;
+wc.hbrBackground := COLOR_BACKGROUND;
+wc.lpfnWndProc := @MainWndProc;
+wc.hInstance := hInstance;
+wc.lpszClassName := cAppName;
+wc.hCursor := LoadCursor(hwndMain,IDC_ARROW);
+if RegisterClass(wc) = 0 then begin MessageBox(0,'RegisterClass failed for main wnd','Failed',MB_OK); halt; end;
+hwndMain := CreateWindowEx( 0, cAppName, cAppTitle, WS_POPUP,
+ 0, 0,
+ GetSystemMetrics(SM_CXSCREEN), GetSystemMetrics(SM_CYSCREEN),
+ 0, 0, hInstance, nil);
+
+ShowWindow(hwndMain,SW_SHOW);
+UpdateWindow(hwndMain)
+end;
+
+
+end.
--- a/hedgewars/fGame.pas Mon Aug 22 21:38:06 2005 +0000
+++ b/hedgewars/fGame.pas Tue Aug 23 16:17:53 2005 +0000
@@ -1,232 +1,232 @@
-(*
- * Hedgewars, a worms-like game
- * Copyright (c) 2004, 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 fGame;
-interface
-uses Windows;
-
-procedure GameStart;
-procedure StartNetGame;
-procedure StartDemoView;
-procedure StartLocalGame;
-
-implementation
-uses fMisc, fGUI, uConsts, uRandom, Messages, fConsts, SysUtils, fIPC, fNet;
-const
- fmCreate = $FFFF;
- fmOpenRead = $0000;
- fmOpenWrite = $0001;
- fmOpenReadWrite = $0002;
-
-var
- MapPoints: array[0..19] of TPoint;
-
-function GetNextLine(var f: textfile): string;
-begin
-repeat
- Readln(f, Result)
-until (Length(Result)>0)and(Result[1] <> '#')
-end;
-
-function GetThemeBySeed: string;
-var f: text;
- i, n, t: integer;
-begin
-Result:= '';
-n:= 37;
-for i:= 1 to Length(seed) do
- n:= (n shl 1) xor byte(seed[i]) xor n;
-FileMode:= fmOpenRead;
-AssignFile(f, Pathz[ptThemes] + 'themes.cfg');
-{$I-}
-Reset(f);
-val(GetNextLine(f), i, t);
-if i > 0 then
- begin
- n:= n mod i;
- for i:= 0 to n do Result:= GetNextLine(f)
- end;
-CloseFile(f);
-{$I+}
-FileMode:= fmOpenReadWrite;
-if IOResult <> 0 then
- begin
- MessageBox(hwndMain,PChar(String('Missing, corrupted or cannot access critical file'#13#10+Pathz[ptThemes] + 'themes.cfg')),'Ahctung!!!',MB_OK);
- exit
- end
-end;
-
-function ExecAndWait(FileName:String; Visibility : integer): Cardinal;
-var WorkDir: String;
- StartupInfo:TStartupInfo;
- ProcessInfo:TProcessInformation;
-begin
-GetDir(0, WorkDir);
-FillChar(StartupInfo, Sizeof(StartupInfo), 0);
-with StartupInfo do
- begin
- cb:= Sizeof(StartupInfo);
- dwFlags:= STARTF_USESHOWWINDOW;
- wShowWindow:= Visibility
- end;
-if not CreateProcess(nil, PChar(FileName), nil, nil,
- false, CREATE_DEFAULT_ERROR_MODE or CREATE_NEW_CONSOLE or NORMAL_PRIORITY_CLASS,
- nil, nil, StartupInfo, ProcessInfo)
- then Result:= High(Cardinal)
- else begin
- while WaitforSingleObject(ProcessInfo.hProcess, 0) = WAIT_TIMEOUT do
- begin
- Sleep(10);
- ProcessMessages;
- end;
- GetExitCodeProcess(ProcessInfo.hProcess, Result);
- CloseHandle(ProcessInfo.hProcess);
- CloseHandle(ProcessInfo.hThread)
- end
-end;
-
-procedure GameStart;
-var sTheme:string;
-begin
-if seed = '' then
- begin
- MessageBox(hwndMain,'seed is unknown, but game started','Ahctung!!!',MB_OK);
- exit
- end;
-sTheme:= GetThemeBySeed;
-//if ExecAndWait('landgen.exe ' + sTheme + ' ' + seed, SW_HIDE) = 0 then
- begin
- ShowWindow(hwndMain, SW_MINIMIZE);
- fWriteDemo:= SendMessage(HSetDemoCheck, BM_GETCHECK, 0, 0) = BST_CHECKED;
- if fWriteDemo then
- begin
- AssignDemoFile('demo.hwd_1');
- inc(seed[0]);
- seed[Length(seed)]:= cDemoSeedSeparator;
- WriteStrToDemo(seed)
- end;
- case ExecAndWait(format('hw.exe %s %s %d %s %d',[Resolutions[SendMessage(HSetResEdit,CB_GETCURSEL,0,0)], sTheme, IN_IPC_PORT, seed, SendMessage(HFullScrCheck,BM_GETCHECK,0,0)]), SW_NORMAL) of
- High(Cardinal): MessageBox(hwndMain,'error executing game','fuck!',MB_OK);
- end;
- if fWriteDemo then
- CloseDemoFile;
- seed:= '';
- ShowWindow(hwndMain, SW_RESTORE)
- end {else begin
- MessageBox(hwndMain,'error executing landgen','fuck!',MB_OK);
- exit
- end; }
-end;
-
-procedure StartNetGame;
-var i, ii: LongWord;
- s: shortstring;
- p: TPoint;
- sbuf: string;
-begin // totally broken
-GenRandomSeed;
-SendNet('z'+seed);
-sbuf:= GetThemeBySeed;
-if ExecAndWait(format('landgen.exe %s %s',[sbuf, seed]), SW_HIDE) <> 0 then
- begin
- MessageBox(hwndMain,'error executing landgen','error',MB_OK);
- exit;
- end;
-SendNetAndWait('T');
-SendNet('K'); {
-for i:= 1 to TeamCount do
- begin
- s[0]:= #9;
- s[1]:= 'h';
- for ii:= 0 to 1 do
- begin
- p:= GetRandomMapPoint;
- PLongWord(@s[2])^:= p.X;
- PLongWord(@s[6])^:= p.Y;
- SendNet(s);
- end;
- if i < TeamCount then SendNet('k');
- end; }
-SendNet('G')
-end;
-
-procedure StartDemoView;
-const cBufSize = 32;
-var f: file;
- buf: array[0..pred(cBufSize)] of byte;
- i, t: integer;
-begin
-if SendMessage(HDemoList,LB_GETCURSEL,0,0) = LB_ERR then//LBDemos.ItemIndex<0 then
- begin
- MessageBox(hwndMain,'Выбери демку слева','hint',MB_OK);
- exit
- end;
-GameType:= gtDemo;
-i:= SendMessage(HDemoList,LB_GETCURSEL,0,0);
-t:= SendMessage(HDemoList, LB_GETTEXTLEN, i, 0);
-SetLength(DemoFileName, t);
-SendMessage(HDemoList,LB_GETTEXT, i, LPARAM(@DemoFileName[1]));
-DemoFileName:= Pathz[ptDemos] + DemoFileName;
-AssignFile(f, DemoFileName);
-{$I-}
-FileMode:= fmOpenRead;
-Reset(f, 1);
-FileMode:= fmOpenReadWrite;
-if IOResult <> 0 then
- begin
- MessageBox(hwndMain,'file not found','error',MB_OK);
- exit;
- end;
-BlockRead(f, buf, cBufSize, t); // вырезаем seed
-seed:= '';
-i:= 0;
-while (char(buf[i]) <> cDemoSeedSeparator)and (i < t) do
- begin
- seed:= seed + chr(buf[i]);
- inc(i);
- end;
-CloseFile(f);
-{$I+}
-GameStart
-end;
-
-procedure StartLocalGame;
-begin
-GenRandomSeed;
-GameType:= gtLocal;
-GameStart
-end;
-
-
-
-end.
+(*
+ * Hedgewars, a worms-like game
+ * Copyright (c) 2004, 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 fGame;
+interface
+uses Windows;
+
+procedure GameStart;
+procedure StartNetGame;
+procedure StartDemoView;
+procedure StartLocalGame;
+
+implementation
+uses fMisc, fGUI, uConsts, uRandom, Messages, fConsts, SysUtils, fIPC, fNet;
+const
+ fmCreate = $FFFF;
+ fmOpenRead = $0000;
+ fmOpenWrite = $0001;
+ fmOpenReadWrite = $0002;
+
+var
+ MapPoints: array[0..19] of TPoint;
+
+function GetNextLine(var f: textfile): string;
+begin
+repeat
+ Readln(f, Result)
+until (Length(Result)>0)and(Result[1] <> '#')
+end;
+
+function GetThemeBySeed: string;
+var f: text;
+ i, n, t: integer;
+begin
+Result:= '';
+n:= 37;
+for i:= 1 to Length(seed) do
+ n:= (n shl 1) xor byte(seed[i]) xor n;
+FileMode:= fmOpenRead;
+AssignFile(f, Pathz[ptThemes] + 'themes.cfg');
+{$I-}
+Reset(f);
+val(GetNextLine(f), i, t);
+if i > 0 then
+ begin
+ n:= n mod i;
+ for i:= 0 to n do Result:= GetNextLine(f)
+ end;
+CloseFile(f);
+{$I+}
+FileMode:= fmOpenReadWrite;
+if IOResult <> 0 then
+ begin
+ MessageBox(hwndMain,PChar(String('Missing, corrupted or cannot access critical file'#13#10+Pathz[ptThemes] + 'themes.cfg')),'Ahctung!!!',MB_OK);
+ exit
+ end
+end;
+
+function ExecAndWait(FileName:String; Visibility : integer): Cardinal;
+var WorkDir: String;
+ StartupInfo:TStartupInfo;
+ ProcessInfo:TProcessInformation;
+begin
+GetDir(0, WorkDir);
+FillChar(StartupInfo, Sizeof(StartupInfo), 0);
+with StartupInfo do
+ begin
+ cb:= Sizeof(StartupInfo);
+ dwFlags:= STARTF_USESHOWWINDOW;
+ wShowWindow:= Visibility
+ end;
+if not CreateProcess(nil, PChar(FileName), nil, nil,
+ false, CREATE_DEFAULT_ERROR_MODE or CREATE_NEW_CONSOLE or NORMAL_PRIORITY_CLASS,
+ nil, nil, StartupInfo, ProcessInfo)
+ then Result:= High(Cardinal)
+ else begin
+ while WaitforSingleObject(ProcessInfo.hProcess, 0) = WAIT_TIMEOUT do
+ begin
+ Sleep(10);
+ ProcessMessages;
+ end;
+ GetExitCodeProcess(ProcessInfo.hProcess, Result);
+ CloseHandle(ProcessInfo.hProcess);
+ CloseHandle(ProcessInfo.hThread)
+ end
+end;
+
+procedure GameStart;
+var sTheme:string;
+begin
+if seed = '' then
+ begin
+ MessageBox(hwndMain,'seed is unknown, but game started','Ahctung!!!',MB_OK);
+ exit
+ end;
+sTheme:= GetThemeBySeed;
+//if ExecAndWait('landgen.exe ' + sTheme + ' ' + seed, SW_HIDE) = 0 then
+ begin
+ ShowWindow(hwndMain, SW_MINIMIZE);
+ fWriteDemo:= SendMessage(HSetDemoCheck, BM_GETCHECK, 0, 0) = BST_CHECKED;
+ if fWriteDemo then
+ begin
+ AssignDemoFile('demo.hwd_1');
+ inc(seed[0]);
+ seed[Length(seed)]:= cDemoSeedSeparator;
+ WriteStrToDemo(seed)
+ end;
+ case ExecAndWait(format('hw.exe %s %s %d %s %d',[Resolutions[SendMessage(HSetResEdit,CB_GETCURSEL,0,0)], sTheme, IN_IPC_PORT, seed, SendMessage(HFullScrCheck,BM_GETCHECK,0,0)]), SW_NORMAL) of
+ High(Cardinal): MessageBox(hwndMain,'error executing game','fuck!',MB_OK);
+ end;
+ if fWriteDemo then
+ CloseDemoFile;
+ seed:= '';
+ ShowWindow(hwndMain, SW_RESTORE)
+ end {else begin
+ MessageBox(hwndMain,'error executing landgen','fuck!',MB_OK);
+ exit
+ end; }
+end;
+
+procedure StartNetGame;
+var i, ii: LongWord;
+ s: shortstring;
+ p: TPoint;
+ sbuf: string;
+begin // totally broken
+GenRandomSeed;
+SendNet('z'+seed);
+sbuf:= GetThemeBySeed;
+if ExecAndWait(format('landgen.exe %s %s',[sbuf, seed]), SW_HIDE) <> 0 then
+ begin
+ MessageBox(hwndMain,'error executing landgen','error',MB_OK);
+ exit;
+ end;
+SendNetAndWait('T');
+SendNet('K'); {
+for i:= 1 to TeamCount do
+ begin
+ s[0]:= #9;
+ s[1]:= 'h';
+ for ii:= 0 to 1 do
+ begin
+ p:= GetRandomMapPoint;
+ PLongWord(@s[2])^:= p.X;
+ PLongWord(@s[6])^:= p.Y;
+ SendNet(s);
+ end;
+ if i < TeamCount then SendNet('k');
+ end; }
+SendNet('G')
+end;
+
+procedure StartDemoView;
+const cBufSize = 32;
+var f: file;
+ buf: array[0..pred(cBufSize)] of byte;
+ i, t: integer;
+begin
+if SendMessage(HDemoList,LB_GETCURSEL,0,0) = LB_ERR then//LBDemos.ItemIndex<0 then
+ begin
+ MessageBox(hwndMain,'Выбери демку слева','hint',MB_OK);
+ exit
+ end;
+GameType:= gtDemo;
+i:= SendMessage(HDemoList,LB_GETCURSEL,0,0);
+t:= SendMessage(HDemoList, LB_GETTEXTLEN, i, 0);
+SetLength(DemoFileName, t);
+SendMessage(HDemoList,LB_GETTEXT, i, LPARAM(@DemoFileName[1]));
+DemoFileName:= Pathz[ptDemos] + DemoFileName;
+AssignFile(f, DemoFileName);
+{$I-}
+FileMode:= fmOpenRead;
+Reset(f, 1);
+FileMode:= fmOpenReadWrite;
+if IOResult <> 0 then
+ begin
+ MessageBox(hwndMain,'file not found','error',MB_OK);
+ exit;
+ end;
+BlockRead(f, buf, cBufSize, t); // вырезаем seed
+seed:= '';
+i:= 0;
+while (char(buf[i]) <> cDemoSeedSeparator)and (i < t) do
+ begin
+ seed:= seed + chr(buf[i]);
+ inc(i);
+ end;
+CloseFile(f);
+{$I+}
+GameStart
+end;
+
+procedure StartLocalGame;
+begin
+GenRandomSeed;
+GameType:= gtLocal;
+GameStart
+end;
+
+
+
+end.
--- a/hedgewars/fIPC.pas Mon Aug 22 21:38:06 2005 +0000
+++ b/hedgewars/fIPC.pas Tue Aug 23 16:17:53 2005 +0000
@@ -1,62 +1,62 @@
-(*
- * Hedgewars, a worms-like game
- * Copyright (c) 2004, 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 fIPC;{$J+}
-interface
-uses Messages, WinSock, Windows;
-const
- IN_IPC_PORT = 46631;
- WM_ASYNC_IPCEVENT = WM_USER + 1;
-
-function InitIPCServer: boolean;
-procedure SendIPC(s: shortstring);
-procedure IPCEvent(sock: TSocket; lParam: LPARAM);
-
-var DemoFileName: string;
-
-implementation
-uses fGUI, fMisc, fNet, uConsts, fGame, SysUtils, fConsts;
-
-var hIPCListenSockTCP : TSocket = INVALID_SOCKET;
- hIPCServerSocket : TSocket = INVALID_SOCKET;
-
-function InitIPCServer: boolean;
-var myaddrTCP: TSockAddrIn;
- t: integer;
-begin
-Result:= false;
-hIPCListenSockTCP:= socket(AF_INET, SOCK_STREAM, 0);
-myaddrTCP.sin_family := AF_INET;
+(*
+ * Hedgewars, a worms-like game
+ * Copyright (c) 2004, 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 fIPC;{$J+}
+interface
+uses Messages, WinSock, Windows;
+const
+ IN_IPC_PORT = 46631;
+ WM_ASYNC_IPCEVENT = WM_USER + 1;
+
+function InitIPCServer: boolean;
+procedure SendIPC(s: shortstring);
+procedure IPCEvent(sock: TSocket; lParam: LPARAM);
+
+var DemoFileName: string;
+
+implementation
+uses fGUI, fMisc, fNet, uConsts, fGame, SysUtils, fConsts;
+
+var hIPCListenSockTCP : TSocket = INVALID_SOCKET;
+ hIPCServerSocket : TSocket = INVALID_SOCKET;
+
+function InitIPCServer: boolean;
+var myaddrTCP: TSockAddrIn;
+ t: integer;
+begin
+Result:= false;
+hIPCListenSockTCP:= socket(AF_INET, SOCK_STREAM, 0);
+myaddrTCP.sin_family := AF_INET;
myaddrTCP.sin_addr.s_addr := $0100007F;
myaddrTCP.sin_port := htons(IN_IPC_PORT);
t:= sizeof(TSockAddrIn);
@@ -64,121 +64,121 @@
if ( listen(hIPCListenSockTCP, 1) <> 0) then exit;
WSAAsyncSelect(hIPCListenSockTCP, hwndMain, WM_ASYNC_IPCEVENT, FD_ACCEPT or FD_READ or FD_CLOSE);
Result:= true
-end;
-
-procedure SendIPC(s: shortstring);
-begin
-if hIPCServerSocket <> INVALID_SOCKET then
- begin
- send(hIPCServerSocket, s[0], Succ(byte(s[0])), 0);
- if fWriteDemo then
- if not((Length(s) > 5) and (copy(s, 1, 5) = 'ebind')) then
- WriteRawToDemo(s)
- end;
-end;
-
-procedure SendConfig;
-const cBufLength = $10000;
-{$INCLUDE revision.inc}
-var f: file;
- buf: array[0..Pred(cBufLength)] of byte;
- i, t: integer;
- s: shortstring;
- sbuf:string;
-begin
-SendIPC('WFrontend svn ' + cRevision);
-SendIPC(format('e$sound %d',[SendMessage(HSetSndCheck, BM_GETCHECK, 0, 0)]));
-case GameType of
- gtLocal: begin
- SendIPC(format('e$gmflags %d',[0]));
- SendIPC('eaddteam');
- ExecCFG(Pathz[ptTeams] + 'unC0Rr.cfg');
- SendIPC('ecolor 65535');
- SendIPC('eadd hh0 0');
- SendIPC('eadd hh1 0');
- SendIPC('eadd hh2 0');
- SendIPC('eadd hh3 0');
- SendIPC('eaddteam');
- ExecCFG(Pathz[ptTeams] + 'test.cfg');
- SendIPC('eadd hh0 1');
- SendIPC('eadd hh1 1');
- SendIPC('eadd hh2 1');
- SendIPC('eadd hh3 1');
- SendIPC('ecolor 16776960');
- end;
- gtDemo: begin
- AssignFile(f, DemoFileName);
- {$I-}
- Reset(f, 1);
- if IOResult <> 0 then
- begin
- SendIPC('ECannot open file: "' + Pathz[ptDemos] + sbuf + '"');
- exit;
- end;
- s:= 'TD';
- s[0]:= #6;
- PLongWord(@s[3])^:= FileSize(f);
- SendIPC(s); // посылаем тип игры - демо и размер демки
- BlockRead(f, buf, cBufLength, t); // вырезаем seed
- i:= 0;
- while (chr(buf[i]) <> cDemoSeedSeparator)and (i < t) do inc(i);
- inc(i);
- // посылаем остаток файла
- repeat
- while i < t do
- begin
- CopyMemory(@s[0], @buf[i], Succ(buf[i]));
- SendIPC(s);
- inc(i, buf[i]);
- inc(i)
- end;
- i:= 0;
- BlockRead(f, buf, cBufLength, t);
- until t = 0;
- Closefile(f);
- {$I+}
- end;
- gtNet: SendNet('C');
- end;
-end;
-
-procedure ParseIPCCommand(s: shortstring);
-begin
-case s[1] of
- '?': if GameType = gtNet then SendNet('?') else SendIPC('!');
- 'C': SendConfig;
- else if GameType = gtNet then SendNet(s);
- if fWriteDemo and (s[1] <> '+') then WriteRawToDemo(s)
- end;
-end;
-
-procedure IPCEvent(sock: TSocket; lParam: LPARAM);
-const sipc: string = '';
-var WSAEvent: word;
- i: integer;
- buf: array[0..255] of byte;
- s: shortstring absolute buf;
-begin
-WSAEvent:= WSAGETSELECTEVENT(lParam);
-case WSAEvent of
- FD_CLOSE: begin
- closesocket(sock);
- hIPCServerSocket:= INVALID_SOCKET;
- exit
- end;
- FD_READ: begin
- repeat
- i:= recv(sock, buf[1], 255, 0);
- if i > 0 then
- begin
- buf[0]:= i;
- sipc:= sipc + s;
- SplitStream2Commands(sipc, ParseIPCCommand);
- end;
- until i < 1;
- end;
- FD_ACCEPT: hIPCServerSocket:= accept(hIPCListenSockTCP, nil, nil);
- end
-end;
-
-end.
+end;
+
+procedure SendIPC(s: shortstring);
+begin
+if hIPCServerSocket <> INVALID_SOCKET then
+ begin
+ send(hIPCServerSocket, s[0], Succ(byte(s[0])), 0);
+ if fWriteDemo then
+ if not((Length(s) > 5) and (copy(s, 1, 5) = 'ebind')) then
+ WriteRawToDemo(s)
+ end;
+end;
+
+procedure SendConfig;
+const cBufLength = $10000;
+{$INCLUDE revision.inc}
+var f: file;
+ buf: array[0..Pred(cBufLength)] of byte;
+ i, t: integer;
+ s: shortstring;
+ sbuf:string;
+begin
+SendIPC('WFrontend svn ' + cRevision);
+SendIPC(format('e$sound %d',[SendMessage(HSetSndCheck, BM_GETCHECK, 0, 0)]));
+case GameType of
+ gtLocal: begin
+ SendIPC(format('e$gmflags %d',[0]));
+ SendIPC('eaddteam');
+ ExecCFG(Pathz[ptTeams] + 'unC0Rr.cfg');
+ SendIPC('ecolor 65535');
+ SendIPC('eadd hh0 0');
+ SendIPC('eadd hh1 0');
+ SendIPC('eadd hh2 0');
+ SendIPC('eadd hh3 0');
+ SendIPC('eaddteam');
+ ExecCFG(Pathz[ptTeams] + 'test.cfg');
+ SendIPC('eadd hh0 1');
+ SendIPC('eadd hh1 1');
+ SendIPC('eadd hh2 1');
+ SendIPC('eadd hh3 1');
+ SendIPC('ecolor 16776960');
+ end;
+ gtDemo: begin
+ AssignFile(f, DemoFileName);
+ {$I-}
+ Reset(f, 1);
+ if IOResult <> 0 then
+ begin
+ SendIPC('ECannot open file: "' + Pathz[ptDemos] + sbuf + '"');
+ exit;
+ end;
+ s:= 'TD';
+ s[0]:= #6;
+ PLongWord(@s[3])^:= FileSize(f);
+ SendIPC(s); // посылаем тип игры - демо и размер демки
+ BlockRead(f, buf, cBufLength, t); // вырезаем seed
+ i:= 0;
+ while (chr(buf[i]) <> cDemoSeedSeparator)and (i < t) do inc(i);
+ inc(i);
+ // посылаем остаток файла
+ repeat
+ while i < t do
+ begin
+ CopyMemory(@s[0], @buf[i], Succ(buf[i]));
+ SendIPC(s);
+ inc(i, buf[i]);
+ inc(i)
+ end;
+ i:= 0;
+ BlockRead(f, buf, cBufLength, t);
+ until t = 0;
+ Closefile(f);
+ {$I+}
+ end;
+ gtNet: SendNet('C');
+ end;
+end;
+
+procedure ParseIPCCommand(s: shortstring);
+begin
+case s[1] of
+ '?': if GameType = gtNet then SendNet('?') else SendIPC('!');
+ 'C': SendConfig;
+ else if GameType = gtNet then SendNet(s);
+ if fWriteDemo and (s[1] <> '+') then WriteRawToDemo(s)
+ end;
+end;
+
+procedure IPCEvent(sock: TSocket; lParam: LPARAM);
+const sipc: string = '';
+var WSAEvent: word;
+ i: integer;
+ buf: array[0..255] of byte;
+ s: shortstring absolute buf;
+begin
+WSAEvent:= WSAGETSELECTEVENT(lParam);
+case WSAEvent of
+ FD_CLOSE: begin
+ closesocket(sock);
+ hIPCServerSocket:= INVALID_SOCKET;
+ exit
+ end;
+ FD_READ: begin
+ repeat
+ i:= recv(sock, buf[1], 255, 0);
+ if i > 0 then
+ begin
+ buf[0]:= i;
+ sipc:= sipc + s;
+ SplitStream2Commands(sipc, ParseIPCCommand);
+ end;
+ until i < 1;
+ end;
+ FD_ACCEPT: hIPCServerSocket:= accept(hIPCListenSockTCP, nil, nil);
+ end
+end;
+
+end.
--- a/hedgewars/fMisc.pas Mon Aug 22 21:38:06 2005 +0000
+++ b/hedgewars/fMisc.pas Tue Aug 23 16:17:53 2005 +0000
@@ -1,203 +1,203 @@
-(*
- * Hedgewars, a worms-like game
- * Copyright (c) 2004, 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 fMisc;
-{$J+}
-interface
-uses uConsts, Windows;
-const
- fWriteDemo: boolean = false;
-type
- TGameType = (gtLocal, gtNet, gtDemo);
- TCommandHandler = procedure (s: shortstring);
-
-procedure ExecCFG(FileName: String);
-procedure AssignDemoFile(Filename: shortstring);
-procedure WriteRawToDemo(s: shortstring);
-procedure WriteStrToDemo(s: shortstring);
-procedure CloseDemoFile;
-procedure GenRandomSeed;
-procedure SaveSettings;
-procedure SplitStream2Commands(var ss: string; Handler: TCommandHandler);
-function MainWndProc(hwnd: HWND; Message: UINT; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall;
-procedure LoadOwnerBitmap(var bmp: HBITMAP; name: string; var dc: HDC; owner:cardinal );
-procedure DoInit;
-procedure InitWSA;
-
-var
- seed: shortstring;
- GameType: TGameType;
-
-implementation
-uses fIPC, uRandom, IniFiles, SysUtils, Messages, fGUI, fNet, WinSock, fOptionsGUI;
-var fDemo: file;
-
-procedure ExecCFG(FileName: String);
-var f: textfile;
- s: shortstring;
-begin
-AssignFile(f, FileName);
-{$I-}
-Reset(f);
-{$I+}
-if IOResult<>0 then SendIPC('ECannot open file: "' + FileName + '"');
-while not eof(f) do
- begin
- ReadLn(f, s);
- if (s[0]<>#0)and(s[1]<>';') then SendIPC('e' + s);
- end;
-CloseFile(f)
-end;
-
-procedure AssignDemoFile(Filename: shortstring);
-begin
-Assign(fDemo, Filename);
-Rewrite(fDemo, 1)
-end;
-
-procedure WriteRawToDemo(s: shortstring);
-begin
-if not fWriteDemo then exit;
-BlockWrite(fDemo, s[0], Succ(byte(s[0])))
-end;
-
-procedure WriteStrToDemo(s: shortstring);
-begin
-if not fWriteDemo then exit;
-BlockWrite(fDemo, s[1], byte(s[0]))
-end;
-
-procedure CloseDemoFile;
-begin
-CloseFile(fDemo)
-end;
-
-procedure GenRandomSeed;
-var i: integer;
-begin
-seed[0]:= chr(7 + GetRandom(6));
-for i:= 1 to byte(seed[0]) do seed[i]:= chr(byte('A') + GetRandom(26));
-seed:= '('+seed+')'
-end;
-
-procedure SaveSettings;
-var inif: TIniFile;
-begin
-inif:= TIniFile.Create(ExtractFilePath(ParamStr(0))+'hw.ini');
-inif.WriteInteger('Misc', 'ResIndex', SendMessage(HSetResEdit, CB_GETCURSEL, 0, 0));
-inif.WriteInteger('Misc', 'EnableSound', SendMessage(HSetSndCheck, BM_GETCHECK, 0, 0));
-inif.WriteInteger('Misc', 'Fullscreen', SendMessage(HFullScrCheck, BM_GETCHECK, 0, 0));
-inif.UpdateFile;
-inif.Free
-end;
-
-procedure SplitStream2Commands(var ss: string; Handler: TCommandHandler);
-var s: shortstring;
-begin
-while (Length(ss) > 1)and(Length(ss) > byte(ss[1])) do
- begin
- s:= copy(ss, 2, byte(ss[1]));
- Delete(ss, 1, Succ(byte(ss[1])));
- Handler(s)
- end;
-end;
-
-function MainWndProc(hwnd: HWND; Message: UINT; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall;
-begin
-case Message of
- WM_ASYNC_IPCEVENT: IPCEvent(wParam, lParam);
- WM_ASYNC_NETEVENT: NetEvent(wParam, lParam);
- WM_COMMAND : DoControlPress(wParam, lParam);
- WM_DRAWITEM: DoDrawButton(wParam,PDRAWITEMSTRUCT(lParam));
- WM_CLOSE : PostQuitMessage(0);
- WM_DESTROY : if hwnd = hwndMain then DoDestroy
- end;
-Result:= DefWindowProc(hwnd, Message, wParam,lParam)
-end;
-
-procedure LoadOwnerBitmap(var bmp: HBITMAP; name: string; var dc: HDC; owner:cardinal );
-begin
-bmp := LoadImage(0,PChar(name), IMAGE_BITMAP,0,0,LR_LOADFROMFILE);
-if bmp = 0 then
- begin
- MessageBox(hwndMain, PChar(name + ' not found'), 'damn', MB_OK);
- PostQuitMessage(0);
- end;
-dc:=CreateCompatibleDC(GetDC(owner));
-SelectObject(dc,bmp);
-end;
-
-procedure DoInit;
-var sr: TSearchRec;
- i: integer;
- inif: TIniFile;
- p: TPoint;
-begin
-GetCursorPos(p);
-SetRandomParams(IntToStr(GetTickCount), IntToStr(p.X)+'(сеху)'+IntToStr(p.Y));
-i:= FindFirst('Data\Maps\*', faDirectory, sr);
-while i=0 do
- begin
- if sr.Name[1]<>'.' then ;//LBMaps.Items.Add(sr.Name);
- i:= FindNext(sr)
- end;
-FindClose(sr);
-
-inif:= TIniFile.Create(ExtractFilePath(ParamStr(0))+'hw.ini');
-i:= inif.ReadInteger('Misc', 'ResIndex', 0);
-if inif.ReadBool('Misc', 'EnableSound', true) then SendMessage(HSetSndCheck,BM_SETCHECK,BST_CHECKED,0);
-if inif.ReadBool('Misc', 'Fullscreen', true) then SendMessage(HFullScrCheck,BM_SETCHECK,BST_CHECKED,0);
-if (i>=0)and(i<=3) then SendMessage(HSetResEdit,CB_SETCURSEL,i,0);
-SetWindowText(HNetIPEdit,PChar(inif.ReadString('Net','IP' , '' )));
-SetWindowText(HNetNameEdit,PChar(inif.ReadString('Net','Nick', 'Unnamed')));
-inif.Free;
-SendMessage(HSetDemoCheck, BM_SETCHECK, BST_CHECKED, 0);
-end;
-
-procedure InitWSA;
-var stWSADataTCPIP: WSADATA;
-begin
-if WSAStartup($0101, stWSADataTCPIP)<>0 then
- begin
- MessageBox(0, 'WSAStartup error !', 'NET ERROR!!!', 0);
- halt
- end;
-if not InitIPCServer then
- begin
- MessageBox(0, 'Error on init IPC server!', 'IPC Error', 0);
- halt
- end
-end;
-
-
-end.
+(*
+ * Hedgewars, a worms-like game
+ * Copyright (c) 2004, 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 fMisc;
+{$J+}
+interface
+uses uConsts, Windows;
+const
+ fWriteDemo: boolean = false;
+type
+ TGameType = (gtLocal, gtNet, gtDemo);
+ TCommandHandler = procedure (s: shortstring);
+
+procedure ExecCFG(FileName: String);
+procedure AssignDemoFile(Filename: shortstring);
+procedure WriteRawToDemo(s: shortstring);
+procedure WriteStrToDemo(s: shortstring);
+procedure CloseDemoFile;
+procedure GenRandomSeed;
+procedure SaveSettings;
+procedure SplitStream2Commands(var ss: string; Handler: TCommandHandler);
+function MainWndProc(hwnd: HWND; Message: UINT; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall;
+procedure LoadOwnerBitmap(var bmp: HBITMAP; name: string; var dc: HDC; owner:cardinal );
+procedure DoInit;
+procedure InitWSA;
+
+var
+ seed: shortstring;
+ GameType: TGameType;
+
+implementation
+uses fIPC, uRandom, IniFiles, SysUtils, Messages, fGUI, fNet, WinSock, fOptionsGUI;
+var fDemo: file;
+
+procedure ExecCFG(FileName: String);
+var f: textfile;
+ s: shortstring;
+begin
+AssignFile(f, FileName);
+{$I-}
+Reset(f);
+{$I+}
+if IOResult<>0 then SendIPC('ECannot open file: "' + FileName + '"');
+while not eof(f) do
+ begin
+ ReadLn(f, s);
+ if (s[0]<>#0)and(s[1]<>';') then SendIPC('e' + s);
+ end;
+CloseFile(f)
+end;
+
+procedure AssignDemoFile(Filename: shortstring);
+begin
+Assign(fDemo, Filename);
+Rewrite(fDemo, 1)
+end;
+
+procedure WriteRawToDemo(s: shortstring);
+begin
+if not fWriteDemo then exit;
+BlockWrite(fDemo, s[0], Succ(byte(s[0])))
+end;
+
+procedure WriteStrToDemo(s: shortstring);
+begin
+if not fWriteDemo then exit;
+BlockWrite(fDemo, s[1], byte(s[0]))
+end;
+
+procedure CloseDemoFile;
+begin
+CloseFile(fDemo)
+end;
+
+procedure GenRandomSeed;
+var i: integer;
+begin
+seed[0]:= chr(7 + GetRandom(6));
+for i:= 1 to byte(seed[0]) do seed[i]:= chr(byte('A') + GetRandom(26));
+seed:= '('+seed+')'
+end;
+
+procedure SaveSettings;
+var inif: TIniFile;
+begin
+inif:= TIniFile.Create(ExtractFilePath(ParamStr(0))+'hw.ini');
+inif.WriteInteger('Misc', 'ResIndex', SendMessage(HSetResEdit, CB_GETCURSEL, 0, 0));
+inif.WriteInteger('Misc', 'EnableSound', SendMessage(HSetSndCheck, BM_GETCHECK, 0, 0));
+inif.WriteInteger('Misc', 'Fullscreen', SendMessage(HFullScrCheck, BM_GETCHECK, 0, 0));
+inif.UpdateFile;
+inif.Free
+end;
+
+procedure SplitStream2Commands(var ss: string; Handler: TCommandHandler);
+var s: shortstring;
+begin
+while (Length(ss) > 1)and(Length(ss) > byte(ss[1])) do
+ begin
+ s:= copy(ss, 2, byte(ss[1]));
+ Delete(ss, 1, Succ(byte(ss[1])));
+ Handler(s)
+ end;
+end;
+
+function MainWndProc(hwnd: HWND; Message: UINT; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall;
+begin
+case Message of
+ WM_ASYNC_IPCEVENT: IPCEvent(wParam, lParam);
+ WM_ASYNC_NETEVENT: NetEvent(wParam, lParam);
+ WM_COMMAND : DoControlPress(wParam, lParam);
+ WM_DRAWITEM: DoDrawButton(wParam,PDRAWITEMSTRUCT(lParam));
+ WM_CLOSE : PostQuitMessage(0);
+ WM_DESTROY : if hwnd = hwndMain then DoDestroy
+ end;
+Result:= DefWindowProc(hwnd, Message, wParam,lParam)
+end;
+
+procedure LoadOwnerBitmap(var bmp: HBITMAP; name: string; var dc: HDC; owner:cardinal );
+begin
+bmp := LoadImage(0,PChar(name), IMAGE_BITMAP,0,0,LR_LOADFROMFILE);
+if bmp = 0 then
+ begin
+ MessageBox(hwndMain, PChar(name + ' not found'), 'damn', MB_OK);
+ PostQuitMessage(0);
+ end;
+dc:=CreateCompatibleDC(GetDC(owner));
+SelectObject(dc,bmp);
+end;
+
+procedure DoInit;
+var sr: TSearchRec;
+ i: integer;
+ inif: TIniFile;
+ p: TPoint;
+begin
+GetCursorPos(p);
+SetRandomParams(IntToStr(GetTickCount), IntToStr(p.X)+'(сеху)'+IntToStr(p.Y));
+i:= FindFirst('Data\Maps\*', faDirectory, sr);
+while i=0 do
+ begin
+ if sr.Name[1]<>'.' then ;//LBMaps.Items.Add(sr.Name);
+ i:= FindNext(sr)
+ end;
+FindClose(sr);
+
+inif:= TIniFile.Create(ExtractFilePath(ParamStr(0))+'hw.ini');
+i:= inif.ReadInteger('Misc', 'ResIndex', 0);
+if inif.ReadBool('Misc', 'EnableSound', true) then SendMessage(HSetSndCheck,BM_SETCHECK,BST_CHECKED,0);
+if inif.ReadBool('Misc', 'Fullscreen', true) then SendMessage(HFullScrCheck,BM_SETCHECK,BST_CHECKED,0);
+if (i>=0)and(i<=3) then SendMessage(HSetResEdit,CB_SETCURSEL,i,0);
+SetWindowText(HNetIPEdit,PChar(inif.ReadString('Net','IP' , '' )));
+SetWindowText(HNetNameEdit,PChar(inif.ReadString('Net','Nick', 'Unnamed')));
+inif.Free;
+SendMessage(HSetDemoCheck, BM_SETCHECK, BST_CHECKED, 0);
+end;
+
+procedure InitWSA;
+var stWSADataTCPIP: WSADATA;
+begin
+if WSAStartup($0101, stWSADataTCPIP)<>0 then
+ begin
+ MessageBox(0, 'WSAStartup error !', 'NET ERROR!!!', 0);
+ halt
+ end;
+if not InitIPCServer then
+ begin
+ MessageBox(0, 'Error on init IPC server!', 'IPC Error', 0);
+ halt
+ end
+end;
+
+
+end.
--- a/hedgewars/fNet.pas Mon Aug 22 21:38:06 2005 +0000
+++ b/hedgewars/fNet.pas Tue Aug 23 16:17:53 2005 +0000
@@ -1,165 +1,165 @@
-(*
- * Hedgewars, a worms-like game
- * Copyright (c) 2004, 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 fNet;{$J+}
-interface
-uses Messages, WinSock, Windows;
-const
- NET_PORT = 46632;
- WM_ASYNC_NETEVENT = WM_USER + 2;
-
-procedure SendNet(s: shortstring);
-procedure SendNetAndWait(s: shortstring);
-procedure NetConnect;
-procedure NetEvent(sock: TSocket; lParam: LPARAM);
-
-var
- TeamCount: LongWord;
-
-implementation
-uses fGUI, fMisc, fGame, fIPC, uConsts, IniFiles, SysUtils;
-var
- hNetClientSocket: TSocket = INVALID_SOCKET;
- isPonged: boolean;
-
-procedure SendNet(s: shortstring);
-begin
-if hNetClientSocket <> INVALID_SOCKET then
- send(hNetClientSocket, s[0], Succ(byte(s[0])), 0)
-end;
-
-procedure SendNetAndWait(s: shortstring);
-begin
-SendNet(s);
-SendNet('?');
-isPonged:= false;
-repeat
- ProcessMessages;
- sleep(1)
-until isPonged
-end;
-
-procedure ParseNetCommand(s: shortstring);
-var sbuf : string;
-begin
-case s[1] of
- '?': SendNet('!');
- 'i': begin
- sbuf:= GetWindowTextStr(HNetNameEdit);
- SendNet('n' + sbuf);;
- end;
- 'z': begin
- seed:= copy(s, 2, length(s) - 1)
- end;
- 'G': begin
- GameType:= gtNet;
- GameStart
- end;
- '@': ExecCFG(Pathz[ptTeams] + 'unC0Rr.cfg');
- '!': begin
- isPonged:= true;
- SendIPC('!');
- end;
- 'T': TeamCount:= PLongWord(@s[2])^
- else SendIPC(s) end;
-end;
-
-procedure NetConnect;
-var rmaddr: SOCKADDR_IN;
- inif: TIniFile;
- sbuf1,sbuf2: string;
-begin
-sbuf1:= GetWindowTextStr(HNetIPEdit);
-inif:= TIniFile.Create(ExtractFilePath(ParamStr(0))+'hw.ini');
-inif.WriteString('Net','IP' , sbuf1);
-sbuf2:= GetWindowTextStr(HNetNameEdit);
-inif.WriteString('Net','Nick', sbuf2);
-inif.Free;
-SetWindowText(HNetConnectionStatic,'Connecting...');
-rmaddr.sin_family := AF_INET;
-rmaddr.sin_addr.s_addr := inet_addr(PChar(sbuf1));
-rmaddr.sin_port := htons(NET_PORT);
-hNetClientSocket:= socket(AF_INET, SOCK_STREAM, 0);
-if INVALID_SOCKET = hNetClientSocket then
- begin
- MessageBox(hwndMain,'connect failed','failed',MB_OK);
- SetWindowText(HNetConnectionStatic,'Error on connect');
- exit
- end;
-WSAAsyncSelect(hNetClientSocket, hwndMain, WM_ASYNC_NETEVENT, FD_CONNECT or FD_READ or FD_CLOSE);
-connect(hNetClientSocket, rmaddr, sizeof(rmaddr))
-end;
-
-procedure NetEvent(sock: TSocket; lParam: LPARAM);
-const snet: string = '';
-var WSAEvent: word;
- i: integer;
- buf: array[0..255] of byte;
- s: shortstring absolute buf;
-begin
-WSAEvent:= WSAGETSELECTEVENT(lParam);
-case WSAEvent of
- FD_CLOSE: begin
- closesocket(sock);
-// hIPCServerSocket:= INVALID_SOCKET; гм-гм... FIXME: что-то тут должно быть имхо
- SetWindowText(HNetConnectionStatic, 'Disconnected');
- GameType:= gtLocal
- end;
- FD_READ: begin
- repeat
- i:= recv(sock, buf[1], 255, 0);
- if i > 0 then
- begin
- buf[0]:= i;
- snet:= snet + s;
- SplitStream2Commands(snet, ParseNetCommand);
- end;
- until i < 1
- end;
- FD_CONNECT: begin
- i:= WSAGETSELECTERROR(lParam);
- if i<>0 then
- begin
- closesocket(sock);
- MessageBox(hwndMain,'Error on connect', 'Error', MB_OK);
- SetWindowText(HNetConnectionStatic, 'Error on connect')
- end else
- begin
- SetWindowText(HNetConnectionStatic,'connected');
- GameType:= gtNet
- end;
- end
- end
-end;
-
-end.
+(*
+ * Hedgewars, a worms-like game
+ * Copyright (c) 2004, 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 fNet;{$J+}
+interface
+uses Messages, WinSock, Windows;
+const
+ NET_PORT = 46632;
+ WM_ASYNC_NETEVENT = WM_USER + 2;
+
+procedure SendNet(s: shortstring);
+procedure SendNetAndWait(s: shortstring);
+procedure NetConnect;
+procedure NetEvent(sock: TSocket; lParam: LPARAM);
+
+var
+ TeamCount: LongWord;
+
+implementation
+uses fGUI, fMisc, fGame, fIPC, uConsts, IniFiles, SysUtils;
+var
+ hNetClientSocket: TSocket = INVALID_SOCKET;
+ isPonged: boolean;
+
+procedure SendNet(s: shortstring);
+begin
+if hNetClientSocket <> INVALID_SOCKET then
+ send(hNetClientSocket, s[0], Succ(byte(s[0])), 0)
+end;
+
+procedure SendNetAndWait(s: shortstring);
+begin
+SendNet(s);
+SendNet('?');
+isPonged:= false;
+repeat
+ ProcessMessages;
+ sleep(1)
+until isPonged
+end;
+
+procedure ParseNetCommand(s: shortstring);
+var sbuf : string;
+begin
+case s[1] of
+ '?': SendNet('!');
+ 'i': begin
+ sbuf:= GetWindowTextStr(HNetNameEdit);
+ SendNet('n' + sbuf);;
+ end;
+ 'z': begin
+ seed:= copy(s, 2, length(s) - 1)
+ end;
+ 'G': begin
+ GameType:= gtNet;
+ GameStart
+ end;
+ '@': ExecCFG(Pathz[ptTeams] + 'unC0Rr.cfg');
+ '!': begin
+ isPonged:= true;
+ SendIPC('!');
+ end;
+ 'T': TeamCount:= PLongWord(@s[2])^
+ else SendIPC(s) end;
+end;
+
+procedure NetConnect;
+var rmaddr: SOCKADDR_IN;
+ inif: TIniFile;
+ sbuf1,sbuf2: string;
+begin
+sbuf1:= GetWindowTextStr(HNetIPEdit);
+inif:= TIniFile.Create(ExtractFilePath(ParamStr(0))+'hw.ini');
+inif.WriteString('Net','IP' , sbuf1);
+sbuf2:= GetWindowTextStr(HNetNameEdit);
+inif.WriteString('Net','Nick', sbuf2);
+inif.Free;
+SetWindowText(HNetConnectionStatic,'Connecting...');
+rmaddr.sin_family := AF_INET;
+rmaddr.sin_addr.s_addr := inet_addr(PChar(sbuf1));
+rmaddr.sin_port := htons(NET_PORT);
+hNetClientSocket:= socket(AF_INET, SOCK_STREAM, 0);
+if INVALID_SOCKET = hNetClientSocket then
+ begin
+ MessageBox(hwndMain,'connect failed','failed',MB_OK);
+ SetWindowText(HNetConnectionStatic,'Error on connect');
+ exit
+ end;
+WSAAsyncSelect(hNetClientSocket, hwndMain, WM_ASYNC_NETEVENT, FD_CONNECT or FD_READ or FD_CLOSE);
+connect(hNetClientSocket, rmaddr, sizeof(rmaddr))
+end;
+
+procedure NetEvent(sock: TSocket; lParam: LPARAM);
+const snet: string = '';
+var WSAEvent: word;
+ i: integer;
+ buf: array[0..255] of byte;
+ s: shortstring absolute buf;
+begin
+WSAEvent:= WSAGETSELECTEVENT(lParam);
+case WSAEvent of
+ FD_CLOSE: begin
+ closesocket(sock);
+// hIPCServerSocket:= INVALID_SOCKET; гм-гм... FIXME: что-то тут должно быть имхо
+ SetWindowText(HNetConnectionStatic, 'Disconnected');
+ GameType:= gtLocal
+ end;
+ FD_READ: begin
+ repeat
+ i:= recv(sock, buf[1], 255, 0);
+ if i > 0 then
+ begin
+ buf[0]:= i;
+ snet:= snet + s;
+ SplitStream2Commands(snet, ParseNetCommand);
+ end;
+ until i < 1
+ end;
+ FD_CONNECT: begin
+ i:= WSAGETSELECTERROR(lParam);
+ if i<>0 then
+ begin
+ closesocket(sock);
+ MessageBox(hwndMain,'Error on connect', 'Error', MB_OK);
+ SetWindowText(HNetConnectionStatic, 'Error on connect')
+ end else
+ begin
+ SetWindowText(HNetConnectionStatic,'connected');
+ GameType:= gtNet
+ end;
+ end
+ end
+end;
+
+end.
--- a/hedgewars/fOptionsGUI.pas Mon Aug 22 21:38:06 2005 +0000
+++ b/hedgewars/fOptionsGUI.pas Tue Aug 23 16:17:53 2005 +0000
@@ -1,86 +1,86 @@
-(*
- * Hedgewars, a worms-like game
- * Copyright (c) 2004, 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 fOptionsGUI;
-interface
-uses windows,
- messages,SysUtils;
-
-procedure DoCreateOptionsWindow;
-procedure ShowOptionsWindow;
-procedure DoCreateOptionsControls;
-
-var HOptTeamName, HOptBGStatic : HWND;
- HOptHedgeName : array[0..7] of HWND;
-
-
-
-implementation
-uses fGUI,
- fConsts, fMisc;
-
-procedure ShowOptionsWindow;
-begin
-ShowWindow(hwndOptions,SW_SHOW);
-ShowWindow(hwndMain, SW_HIDE);
-ShowWindow(HOptTeamName,SW_SHOW)
-end;
-
-procedure DoCreateOptionsControls;
-var i:integer;
-begin
-HOptBGStatic := CreateWindow('STATIC','opt bg img' ,WS_CHILD or WS_VISIBLE or SS_OWNERDRAW, 0, 0, GetSystemMetrics(SM_CXSCREEN), GetSystemMetrics(SM_CYSCREEN) , hwndOptions, cOptBGStatic, HInstance, nil);
-HOptTeamName := CreateWindow('EDIT','Колючая Команда',WS_CHILD or WS_TABSTOP or WS_VISIBLE, trunc(260 * scrx), trunc(70 *scry), trunc(215* scrx) , trunc(28*scry) , hwndOptions, cOptTeamName, HInstance, nil);
-for i := 0 to 7 do
-HOptHedgeName[i] := CreateWindow('EDIT',PChar('Йож '+inttostr(i+1)),WS_CHILD or WS_TABSTOP or WS_VISIBLE, trunc(110 * scrx), trunc((102+i*28)*scry), trunc(260* scrx) , trunc(25*scry) , hwndOptions, cOptTeamName, HInstance, nil);
-end;
-
-procedure DoCreateOptionsWindow;
-var wc: WNDCLASS;
-begin
-FillChar(wc, sizeof(wc), 0);
-wc.style := CS_VREDRAW or CS_HREDRAW;
-wc.hbrBackground := COLOR_BACKGROUND;
-wc.lpfnWndProc := @MainWndProc;
-wc.hInstance := hInstance;
-wc.lpszClassName := cOptionsName;
-wc.hCursor := LoadCursor(hwndOptions,IDC_ARROW);
-if RegisterClass(wc) = 0 then begin MessageBox(0,'RegisterClass failed for opts wnd','Failed',MB_OK); halt; end;
-hwndOptions := CreateWindowEx(0, cOptionsName, cOptionsTitle, WS_POPUP,
- 0, 0,
- GetSystemMetrics(SM_CXSCREEN), GetSystemMetrics(SM_CYSCREEN),
- 0, 0, hInstance, nil)
-end;
-
-
-end.
+(*
+ * Hedgewars, a worms-like game
+ * Copyright (c) 2004, 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 fOptionsGUI;
+interface
+uses windows,
+ messages,SysUtils;
+
+procedure DoCreateOptionsWindow;
+procedure ShowOptionsWindow;
+procedure DoCreateOptionsControls;
+
+var HOptTeamName, HOptBGStatic : HWND;
+ HOptHedgeName : array[0..7] of HWND;
+
+
+
+implementation
+uses fGUI,
+ fConsts, fMisc;
+
+procedure ShowOptionsWindow;
+begin
+ShowWindow(hwndOptions,SW_SHOW);
+ShowWindow(hwndMain, SW_HIDE);
+ShowWindow(HOptTeamName,SW_SHOW)
+end;
+
+procedure DoCreateOptionsControls;
+var i:integer;
+begin
+HOptBGStatic := CreateWindow('STATIC','opt bg img' ,WS_CHILD or WS_VISIBLE or SS_OWNERDRAW, 0, 0, GetSystemMetrics(SM_CXSCREEN), GetSystemMetrics(SM_CYSCREEN) , hwndOptions, cOptBGStatic, HInstance, nil);
+HOptTeamName := CreateWindow('EDIT','Колючая Команда',WS_CHILD or WS_TABSTOP or WS_VISIBLE, trunc(260 * scrx), trunc(70 *scry), trunc(215* scrx) , trunc(28*scry) , hwndOptions, cOptTeamName, HInstance, nil);
+for i := 0 to 7 do
+HOptHedgeName[i] := CreateWindow('EDIT',PChar('Йож '+inttostr(i+1)),WS_CHILD or WS_TABSTOP or WS_VISIBLE, trunc(110 * scrx), trunc((102+i*28)*scry), trunc(260* scrx) , trunc(25*scry) , hwndOptions, cOptTeamName, HInstance, nil);
+end;
+
+procedure DoCreateOptionsWindow;
+var wc: WNDCLASS;
+begin
+FillChar(wc, sizeof(wc), 0);
+wc.style := CS_VREDRAW or CS_HREDRAW;
+wc.hbrBackground := COLOR_BACKGROUND;
+wc.lpfnWndProc := @MainWndProc;
+wc.hInstance := hInstance;
+wc.lpszClassName := cOptionsName;
+wc.hCursor := LoadCursor(hwndOptions,IDC_ARROW);
+if RegisterClass(wc) = 0 then begin MessageBox(0,'RegisterClass failed for opts wnd','Failed',MB_OK); halt; end;
+hwndOptions := CreateWindowEx(0, cOptionsName, cOptionsTitle, WS_POPUP,
+ 0, 0,
+ GetSystemMetrics(SM_CXSCREEN), GetSystemMetrics(SM_CYSCREEN),
+ 0, 0, hInstance, nil)
+end;
+
+
+end.
--- a/hedgewars/getrevnum.dpr Mon Aug 22 21:38:06 2005 +0000
+++ b/hedgewars/getrevnum.dpr Tue Aug 23 16:17:53 2005 +0000
@@ -1,52 +1,52 @@
-(*
- * Hedgewars, a worms-like game
- * Copyright (c) 2004, 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.
- *)
-
-program getrevnum;
-{$APPTYPE CONSOLE}
-{$J+}
-var s: shortstring = '';
- i: integer = 0;
-begin
-write('const cRevision =''');
-while not (eof or (i > 0)) do
- begin
- readln(s);
- i:= Pos('revision="', s)
- end;
-if eof then write('rUNKNOWN')
- else begin
- Delete(s, 1, i + 9);
- write('r',copy(s, 1, Pred(Pos('"', s))))
- end;
-writeln(''';')
-end.
+(*
+ * Hedgewars, a worms-like game
+ * Copyright (c) 2004, 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.
+ *)
+
+program getrevnum;
+{$APPTYPE CONSOLE}
+{$J+}
+var s: shortstring = '';
+ i: integer = 0;
+begin
+write('const cRevision =''');
+while not (eof or (i > 0)) do
+ begin
+ readln(s);
+ i:= Pos('revision="', s)
+ end;
+if eof then write('rUNKNOWN')
+ else begin
+ Delete(s, 1, i + 9);
+ write('r',copy(s, 1, Pred(Pos('"', s))))
+ end;
+writeln(''';')
+end.
--- a/hedgewars/hw.dpr Mon Aug 22 21:38:06 2005 +0000
+++ b/hedgewars/hw.dpr Tue Aug 23 16:17:53 2005 +0000
@@ -1,225 +1,225 @@
-(*
- * Hedgewars, a worms-like game
- * Copyright (c) 2004, 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.
- *)
-
-program hedgewars;
-{$APPTYPE CONSOLE}
-uses
- SDLh,
- uConsts in 'uConsts.pas',
- uGame in 'uGame.pas',
- uMisc in 'uMisc.pas',
- uStore in 'uStore.pas',
- uWorld in 'uWorld.pas',
- uIO in 'uIO.pas',
- uGears in 'uGears.pas',
- uConsole in 'uConsole.pas',
- uKeys in 'uKeys.pas',
- uTeams in 'uTeams.pas',
- 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';
-
-{$INCLUDE options.inc}
-
-// also: GSHandlers.inc
-// CCHandlers.inc
-// HHHandlers.inc
-
-
-procedure OnDestroy; forward;
-
-////////////////////////////////
-procedure DoTimer(Lag: integer); // - обработка таймера
-const cCons: boolean = false;
-var s: string;
-begin
-case GameState of
- gsLandGen: begin
- if (GameFlags and gfForts) = 0 then GenLandSurface
- else MakeFortsMap;
- GameState:= gsStart;
- end;
- gsStart: begin
- AssignHHCoords;
- AdjustColor(cColorNearBlack);
- AdjustColor(cWhiteColor);
- StoreLoad;
- AdjustColor(cConsoleSplitterColor);
- ResetKbd;
- SoundLoad;
- PlayMusic;
- GameState:= gsGame
- end;
- gsGame : begin
- ProcessKbd;
- DoGameTick(Lag);
- DrawWorld(Lag, SDLPrimSurface);
- end;
- gsConsole: begin
- DoGameTick(Lag);
- DrawWorld(Lag, SDLPrimSurface);
- DrawConsole(SDLPrimSurface);
- end;
- gsExit : begin
- OnDestroy;
- end;
- end;
-SDL_Flip(SDLPrimSurface);
-if flagMakeCapture then
- begin
- flagMakeCapture:= false;
- s:= 'hw_' + ParamStr(5) + '_' + inttostr(GameTicks) + '.bmp';
- WriteLnToConsole('Saving ' + s);
- SDL_SaveBMP_RW(SDLPrimSurface, SDL_RWFromFile(PChar(s), 'wb'), 1)
- end;
-end;
-
-////////////////////
-procedure OnDestroy; // - очищаем память
-begin
-{$IFDEF DEBUGFILE}AddFileLog('Freeing resources...');{$ENDIF}
-if isSoundEnabled then ReleaseSound;
-StoreRelease;
-CloseIPC;
-TTF_Quit;
-SDL_Quit;
-halt
-end;
-
-///////////////////
-procedure MainLoop;
-var PrevTime,
- CurrTime: Cardinal;
- event: TSDL_Event;
-begin
-PrevTime:= SDL_GetTicks;
-repeat
-while SDL_PollEvent(@event) <> 0 do
- case event.type_ of
- SDL_KEYDOWN: case GameState of
- gsGame: if event.key.keysym.sym = 96 then
- begin
- cConsoleYAdd:= cConsoleHeight;
- GameState:= gsConsole
- end;
- gsConsole: KeyPressConsole(event.key.keysym.sym);
- end;
- SDL_QUITEV: isTerminated:= true
- end;
-CurrTime:= SDL_GetTicks;
-if PrevTime + cTimerInterval <= CurrTime then
- begin
- DoTimer(CurrTime - PrevTime);
- PrevTime:= CurrTime
- end else {sleep(1)};
-IPCCheckSock
-until isTerminated
-end;
-
-////////////////////
-procedure GetParams;
-var c: integer;
-{$IFDEF DEBUGFILE}
- i: integer;
-begin
-for i:= 0 to ParamCount do
- AddFileLog(inttostr(i) + ': ' + ParamStr(i));
-{$ELSE}
-begin
-{$ENDIF}
-if ParamCount=6 then
- begin
- //TODO: сделать передачу через IPC
- val(ParamStr(1), cScreenWidth, c);
- val(ParamStr(2), cScreenHeight, c);
- Pathz[ptThemeCurrent]:= Pathz[ptThemes] + ParamStr(3)+'/';
- val(ParamStr(4), ipcPort, c);
- SetRandomParams(ParamStr(5), rndfillstr);
- cFullScreen:= ParamStr(6)[1] = '1'
- end else OutError(errmsgShouldntRun, true);
-end;
-
-procedure ShowMainWindow;
-var flags: Longword;
-begin
-flags:= SDL_HWSURFACE or SDL_DOUBLEBUF or SDL_HWACCEL;
-if cFullScreen then flags:= flags or SDL_FULLSCREEN
- else SDL_WM_SetCaption('Hedgewars', nil);
-SDLPrimSurface:= SDL_SetVideoMode(cScreenWidth, cScreenHeight, cBits, flags);
-TryDo(SDLPrimSurface <> nil, errmsgCreateSurface, true);
-PixelFormat:= SDLPrimSurface.format;
-SDL_ShowCursor(0);
-end;
-////////////////////////////////////////////////////////////////////////////////
-/////////////////////////////// m a i n ////////////////////////////////////////
-////////////////////////////////////////////////////////////////////////////////
-{$INCLUDE revision.inc}
-
-begin
-WriteLnToConsole('HedgeWars 0.1, svn '+cRevision);
-WriteLnToConsole(' -= by unC0Rr =- ');
-GetParams;
-Randomize;
-InitGears;
-
-WriteToConsole('Init SDL... ');
-SDLTry(SDL_Init(SDL_INIT_VIDEO) >= 0, true);
-WriteLnToConsole(msgOK);
-
-WriteToConsole('Init SDL_ttf... ');
-SDLTry(TTF_Init >= 0, true);
-WriteLnToConsole(msgOK);
-
-ShowMainWindow;
-
-InitKbdKeyTable;
-InitIPC;
-WriteLnToConsole(msgGettingConfig);
-SendIPCAndWaitReply('C'); // запрос конфига игры
-InitTeams;
-
-if isSoundEnabled then InitSound;
-InitWorld;
-
-StoreInit;
-
-isDeveloperMode:= false;
-
-MainLoop
-
-end.
+(*
+ * Hedgewars, a worms-like game
+ * Copyright (c) 2004, 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.
+ *)
+
+program hedgewars;
+{$APPTYPE CONSOLE}
+uses
+ SDLh,
+ uConsts in 'uConsts.pas',
+ uGame in 'uGame.pas',
+ uMisc in 'uMisc.pas',
+ uStore in 'uStore.pas',
+ uWorld in 'uWorld.pas',
+ uIO in 'uIO.pas',
+ uGears in 'uGears.pas',
+ uConsole in 'uConsole.pas',
+ uKeys in 'uKeys.pas',
+ uTeams in 'uTeams.pas',
+ 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';
+
+{$INCLUDE options.inc}
+
+// also: GSHandlers.inc
+// CCHandlers.inc
+// HHHandlers.inc
+
+
+procedure OnDestroy; forward;
+
+////////////////////////////////
+procedure DoTimer(Lag: integer); // - обработка таймера
+const cCons: boolean = false;
+var s: string;
+begin
+case GameState of
+ gsLandGen: begin
+ if (GameFlags and gfForts) = 0 then GenLandSurface
+ else MakeFortsMap;
+ GameState:= gsStart;
+ end;
+ gsStart: begin
+ AssignHHCoords;
+ AdjustColor(cColorNearBlack);
+ AdjustColor(cWhiteColor);
+ StoreLoad;
+ AdjustColor(cConsoleSplitterColor);
+ ResetKbd;
+ SoundLoad;
+ PlayMusic;
+ GameState:= gsGame
+ end;
+ gsGame : begin
+ ProcessKbd;
+ DoGameTick(Lag);
+ DrawWorld(Lag, SDLPrimSurface);
+ end;
+ gsConsole: begin
+ DoGameTick(Lag);
+ DrawWorld(Lag, SDLPrimSurface);
+ DrawConsole(SDLPrimSurface);
+ end;
+ gsExit : begin
+ OnDestroy;
+ end;
+ end;
+SDL_Flip(SDLPrimSurface);
+if flagMakeCapture then
+ begin
+ flagMakeCapture:= false;
+ s:= 'hw_' + ParamStr(5) + '_' + inttostr(GameTicks) + '.bmp';
+ WriteLnToConsole('Saving ' + s);
+ SDL_SaveBMP_RW(SDLPrimSurface, SDL_RWFromFile(PChar(s), 'wb'), 1)
+ end;
+end;
+
+////////////////////
+procedure OnDestroy; // - очищаем память
+begin
+{$IFDEF DEBUGFILE}AddFileLog('Freeing resources...');{$ENDIF}
+if isSoundEnabled then ReleaseSound;
+StoreRelease;
+CloseIPC;
+TTF_Quit;
+SDL_Quit;
+halt
+end;
+
+///////////////////
+procedure MainLoop;
+var PrevTime,
+ CurrTime: Cardinal;
+ event: TSDL_Event;
+begin
+PrevTime:= SDL_GetTicks;
+repeat
+while SDL_PollEvent(@event) <> 0 do
+ case event.type_ of
+ SDL_KEYDOWN: case GameState of
+ gsGame: if event.key.keysym.sym = 96 then
+ begin
+ cConsoleYAdd:= cConsoleHeight;
+ GameState:= gsConsole
+ end;
+ gsConsole: KeyPressConsole(event.key.keysym.sym);
+ end;
+ SDL_QUITEV: isTerminated:= true
+ end;
+CurrTime:= SDL_GetTicks;
+if PrevTime + cTimerInterval <= CurrTime then
+ begin
+ DoTimer(CurrTime - PrevTime);
+ PrevTime:= CurrTime
+ end else {sleep(1)};
+IPCCheckSock
+until isTerminated
+end;
+
+////////////////////
+procedure GetParams;
+var c: integer;
+{$IFDEF DEBUGFILE}
+ i: integer;
+begin
+for i:= 0 to ParamCount do
+ AddFileLog(inttostr(i) + ': ' + ParamStr(i));
+{$ELSE}
+begin
+{$ENDIF}
+if ParamCount=6 then
+ begin
+ //TODO: сделать передачу через IPC
+ val(ParamStr(1), cScreenWidth, c);
+ val(ParamStr(2), cScreenHeight, c);
+ Pathz[ptThemeCurrent]:= Pathz[ptThemes] + ParamStr(3)+'/';
+ val(ParamStr(4), ipcPort, c);
+ SetRandomParams(ParamStr(5), rndfillstr);
+ cFullScreen:= ParamStr(6)[1] = '1'
+ end else OutError(errmsgShouldntRun, true);
+end;
+
+procedure ShowMainWindow;
+var flags: Longword;
+begin
+flags:= SDL_HWSURFACE or SDL_DOUBLEBUF or SDL_HWACCEL;
+if cFullScreen then flags:= flags or SDL_FULLSCREEN
+ else SDL_WM_SetCaption('Hedgewars', nil);
+SDLPrimSurface:= SDL_SetVideoMode(cScreenWidth, cScreenHeight, cBits, flags);
+TryDo(SDLPrimSurface <> nil, errmsgCreateSurface, true);
+PixelFormat:= SDLPrimSurface.format;
+SDL_ShowCursor(0);
+end;
+////////////////////////////////////////////////////////////////////////////////
+/////////////////////////////// m a i n ////////////////////////////////////////
+////////////////////////////////////////////////////////////////////////////////
+{$INCLUDE revision.inc}
+
+begin
+WriteLnToConsole('HedgeWars 0.1, svn '+cRevision);
+WriteLnToConsole(' -= by unC0Rr =- ');
+GetParams;
+Randomize;
+InitGears;
+
+WriteToConsole('Init SDL... ');
+SDLTry(SDL_Init(SDL_INIT_VIDEO) >= 0, true);
+WriteLnToConsole(msgOK);
+
+WriteToConsole('Init SDL_ttf... ');
+SDLTry(TTF_Init >= 0, true);
+WriteLnToConsole(msgOK);
+
+ShowMainWindow;
+
+InitKbdKeyTable;
+InitIPC;
+WriteLnToConsole(msgGettingConfig);
+SendIPCAndWaitReply('C'); // запрос конфига игры
+InitTeams;
+
+if isSoundEnabled then InitSound;
+InitWorld;
+
+StoreInit;
+
+isDeveloperMode:= false;
+
+MainLoop
+
+end.
--- a/hedgewars/hwserv.dpr Mon Aug 22 21:38:06 2005 +0000
+++ b/hedgewars/hwserv.dpr Tue Aug 23 16:17:53 2005 +0000
@@ -1,90 +1,90 @@
-(*
- * Hedgewars, a worms-like game
- * Copyright (c) 2004, 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.
- *)
-
-program hwserv;
-{$APPTYPE CONSOLE}
-uses
- Windows,
- WinSock,
- Messages,
- uServerMisc in 'uServerMisc.pas',
- uNet,
- uPlayers in 'uPlayers.pas';
-
-function MainWndProc(hwnd: HWND; Message: UINT; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall;
-begin
-case Message of
- WM_CLOSE : begin
- PostQuitMessage(0);
- end;
- WM_ASYNC_NETEVENT: NetSockEvent(wParam, lParam);
- end;
-Result:= DefWindowProc(hwnd, Message, wParam,lParam)
-end;
-
-procedure DoCreateWindow;
-var wc: WNDCLASS;
-begin
-FillChar(wc, sizeof(wc), 0);
-wc.style := CS_VREDRAW or CS_HREDRAW;
-wc.lpfnWndProc := @MainWndProc;
-wc.hInstance := hInstance;
-wc.lpszClassName := cAppName;
-TryDo(RegisterClass(wc) <> 0, 'Cannot register window class');
-hwndMain := CreateWindowEx( 0, cAppName, cAppTitle, WS_POPUP,
- 0, 0,
- GetSystemMetrics(SM_CXSCREEN), GetSystemMetrics(SM_CYSCREEN),
- 0, 0, hInstance, nil);
-TryDo(hwndMain <> 0, 'Cannot create window')
-end;
-
-procedure ProcessMessages;
-var Message: Windows.MSG;
-begin
-if PeekMessage(Message,0,0,0,PM_REMOVE) then
- if Message.message <> WM_QUIT then
- begin
- TranslateMessage(Message);
- DispatchMessage(Message)
- end else isTerminated:= true
-end;
-
-begin
-WriteLn('-= Hedgewars server =-');
-WriteLn('protocol version ', cProtVer);
-DoCreateWindow;
-InitServer;
-repeat
-ProcessMessages;
-until isTerminated
-end.
+(*
+ * Hedgewars, a worms-like game
+ * Copyright (c) 2004, 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.
+ *)
+
+program hwserv;
+{$APPTYPE CONSOLE}
+uses
+ Windows,
+ WinSock,
+ Messages,
+ uServerMisc in 'uServerMisc.pas',
+ uNet,
+ uPlayers in 'uPlayers.pas';
+
+function MainWndProc(hwnd: HWND; Message: UINT; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall;
+begin
+case Message of
+ WM_CLOSE : begin
+ PostQuitMessage(0);
+ end;
+ WM_ASYNC_NETEVENT: NetSockEvent(wParam, lParam);
+ end;
+Result:= DefWindowProc(hwnd, Message, wParam,lParam)
+end;
+
+procedure DoCreateWindow;
+var wc: WNDCLASS;
+begin
+FillChar(wc, sizeof(wc), 0);
+wc.style := CS_VREDRAW or CS_HREDRAW;
+wc.lpfnWndProc := @MainWndProc;
+wc.hInstance := hInstance;
+wc.lpszClassName := cAppName;
+TryDo(RegisterClass(wc) <> 0, 'Cannot register window class');
+hwndMain := CreateWindowEx( 0, cAppName, cAppTitle, WS_POPUP,
+ 0, 0,
+ GetSystemMetrics(SM_CXSCREEN), GetSystemMetrics(SM_CYSCREEN),
+ 0, 0, hInstance, nil);
+TryDo(hwndMain <> 0, 'Cannot create window')
+end;
+
+procedure ProcessMessages;
+var Message: Windows.MSG;
+begin
+if PeekMessage(Message,0,0,0,PM_REMOVE) then
+ if Message.message <> WM_QUIT then
+ begin
+ TranslateMessage(Message);
+ DispatchMessage(Message)
+ end else isTerminated:= true
+end;
+
+begin
+WriteLn('-= Hedgewars server =-');
+WriteLn('protocol version ', cProtVer);
+DoCreateWindow;
+InitServer;
+repeat
+ProcessMessages;
+until isTerminated
+end.
--- a/hedgewars/options.inc Mon Aug 22 21:38:06 2005 +0000
+++ b/hedgewars/options.inc Tue Aug 23 16:17:53 2005 +0000
@@ -1,38 +1,38 @@
-(*
- * Hedgewars, a worms-like game
- * Copyright (c) 2004, 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.
- *)
-
-{$J+}
-{$DEFINE DEBUGFILE}
-{ $DEFINE COUNTTICKS}
-{ $DEFINE DUMP}
-
+(*
+ * Hedgewars, a worms-like game
+ * Copyright (c) 2004, 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.
+ *)
+
+{$J+}
+{$DEFINE DEBUGFILE}
+{ $DEFINE COUNTTICKS}
+{ $DEFINE DUMP}
+
--- a/hedgewars/runhelper.dpr Mon Aug 22 21:38:06 2005 +0000
+++ b/hedgewars/runhelper.dpr Tue Aug 23 16:17:53 2005 +0000
@@ -1,155 +1,160 @@
-(*
- * Hedgewars, a worms-like game
- * Copyright (c) 2004, 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.
- *)
-
-program runhelper;
-{$APPTYPE CONSOLE}
-{$J+}
-uses SDLh;
-var servsock, clsock: PTCPSocket;
- ip: TIPAddress;
- event: TSDL_Event;
-
-procedure Send(s: shortstring);
-begin
-SDLNet_TCP_Send(clsock, @s, succ(byte(s[0])))
-end;
-
-procedure SendConfig;
-begin
-Send('TL');
-Send('eaddteam');
-Send('ename team "C0CuCKAzZz"');
-Send('ename hh0 "Йожык"');
-Send('ename hh1 "Ёжик"');
-Send('ename hh2 "Ёжык"');
-Send('ename hh3 "Йожик"');
-Send('ename hh4 "Ёжик без ножек"');
-Send('ename hh5 "Just hedgehog"');
-Send('ename hh6 "Ёжик без головы"');
-Send('ename hh7 "Валасатый йож"');
-Send('ebind left "+left"');
-Send('ebind right "+right"');
-Send('ebind up "+up"');
-Send('ebind down "+down"');
-Send('ebind F1 "slot 1"');
-Send('ebind F2 "slot 2"');
-Send('ebind F3 "slot 3"');
-Send('ebind F4 "slot 4"');
-Send('ebind F5 "slot 5"');
-Send('ebind F6 "slot 6"');
-Send('ebind F7 "slot 7"');
-Send('ebind F8 "slot 8"');
-Send('ebind F10 "quit"');
-Send('ebind F11 "capture"');
-Send('ebind space "+attack"');
-Send('ebind return "ljump"');
-Send('ebind backspace "hjump"');
-Send('ebind tab "switch"');
-Send('ebind 1 "timer 1"');
-Send('ebind 2 "timer 2"');
-Send('ebind 3 "timer 3"');
-Send('ebind 4 "timer 4"');
-Send('ebind 5 "timer 5"');
-Send('ebind mousel "put"');
-Send('egrave "coffin"');
-Send('ecolor 65535');
-Send('eadd hh0 0');
-Send('eadd hh1 0');
-Send('eadd hh2 0');
-Send('eadd hh3 0');
-Send('eaddteam');
-Send('ename team "-= ЕЖЫ =-"');
-Send('ename hh0 "Маленький"');
-Send('ename hh1 "Удаленький"');
-Send('ename hh2 "Игольчатый"');
-Send('ename hh3 "Стреляный"');
-Send('ename hh4 "Ежиха"');
-Send('ename hh5 "Ежонок"');
-Send('ename hh6 "Инфернальный"');
-Send('ename hh7 "X"');
-Send('egrave Bone');
-Send('ecolor 16776960');
-Send('eadd hh0 1');
-Send('eadd hh1 1');
-Send('eadd hh2 1');
-Send('eadd hh3 1');
-end;
-
-procedure ParseCmd(s: shortstring);
-begin
-case s[1] of
- '?': Send('!');
- 'C': SendConfig;
- end;
-end;
-
-procedure DoIt;
-const ss: string = '';
-var s: shortstring;
- i: integer;
-begin
-i:= SDLNet_TCP_Recv(clsock, @s[1], 255);
-if i = -2 then
- begin
- SDLNet_TCP_Close(clsock);
- clsock:= nil;
- ss:= '';
- exit
- end;
-byte(s[0]):= i;
-ss:= ss + s;
-while (Length(ss) > 1)and(Length(ss) > byte(ss[1])) do
- begin
- s:= copy(ss, 2, byte(ss[1]));
- Delete(ss, 1, Succ(byte(ss[1])));
- ParseCmd(s)
- end;
-end;
-
-begin
-WriteLn('run hw 640 480 avematan 46631 (CVSKGIHSVHX) 1');
-SDL_Init(0);
-SDLNet_Init;
-ip.host:= 0;
-ip.port:= $27B6;
-servsock:= SDLNet_TCP_Open(ip);
-repeat
- if clsock = nil then
- clsock:= SDLNet_TCP_Accept(servsock);
- if clsock <> nil then
- DoIt;
- SDL_PollEvent(@event);
-until event.type_ = SDL_QUITEV;
-SDLNet_Quit;
-SDL_Quit
-end.
+(*
+ * Hedgewars, a worms-like game
+ * Copyright (c) 2004, 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.
+ *)
+
+program runhelper;
+{$APPTYPE CONSOLE}
+{$J+}
+uses SDLh;
+var servsock, clsock: PTCPSocket;
+ ip: TIPAddress;
+ event: TSDL_Event;
+
+procedure Send(s: shortstring);
+begin
+SDLNet_TCP_Send(clsock, @s, succ(byte(s[0])))
+end;
+
+procedure SendConfig;
+begin
+Send('TL');
+Send('e$gmflags 1');
+Send('eaddteam');
+Send('ename team "C0CuCKAzZz"');
+Send('ename hh0 "Йожык"');
+Send('ename hh1 "Ёжик"');
+Send('ename hh2 "Ёжык"');
+Send('ename hh3 "Йожик"');
+Send('ename hh4 "Ёжик без ножек"');
+Send('ename hh5 "Just hedgehog"');
+Send('ename hh6 "Ёжик без головы"');
+Send('ename hh7 "Валасатый йож"');
+Send('ebind left "+left"');
+Send('ebind right "+right"');
+Send('ebind up "+up"');
+Send('ebind down "+down"');
+Send('ebind F1 "slot 1"');
+Send('ebind F2 "slot 2"');
+Send('ebind F3 "slot 3"');
+Send('ebind F4 "slot 4"');
+Send('ebind F5 "slot 5"');
+Send('ebind F6 "slot 6"');
+Send('ebind F7 "slot 7"');
+Send('ebind F8 "slot 8"');
+Send('ebind F10 "quit"');
+Send('ebind F11 "capture"');
+Send('ebind space "+attack"');
+Send('ebind return "ljump"');
+Send('ebind backspace "hjump"');
+Send('ebind tab "switch"');
+Send('ebind 1 "timer 1"');
+Send('ebind 2 "timer 2"');
+Send('ebind 3 "timer 3"');
+Send('ebind 4 "timer 4"');
+Send('ebind 5 "timer 5"');
+Send('ebind mousel "put"');
+Send('egrave "coffin"');
+Send('efort "Barrelhouse"');
+Send('ecolor 65535');
+Send('eadd hh0 0');
+Send('eadd hh1 0');
+Send('eadd hh2 0');
+Send('eadd hh3 0');
+Send('eaddteam');
+Send('ename team "-= ЕЖЫ =-"');
+Send('ename hh0 "Маленький"');
+Send('ename hh1 "Удаленький"');
+Send('ename hh2 "Игольчатый"');
+Send('ename hh3 "Стреляный"');
+Send('ename hh4 "Ежиха"');
+Send('ename hh5 "Ежонок"');
+Send('ename hh6 "Инфернальный"');
+Send('ename hh7 "X"');
+Send('egrave Bone');
+Send('ecolor 16776960');
+Send('eadd hh0 1');
+Send('eadd hh1 1');
+Send('eadd hh2 1');
+Send('eadd hh3 1');
+Send('efort Barrelhouse');
+end;
+
+procedure ParseCmd(s: shortstring);
+begin
+case s[1] of
+ '?': Send('!');
+ 'C': SendConfig;
+ end;
+end;
+
+procedure DoIt;
+const ss: string = '';
+var s: shortstring;
+ i: integer;
+begin
+i:= SDLNet_TCP_Recv(clsock, @s[1], 255);
+if i <= 0 then
+ begin
+ if i = -1 then exit;
+ SDLNet_TCP_Close(clsock);
+ clsock:= nil;
+ ss:= '';
+ exit
+ end;
+byte(s[0]):= i;
+ss:= ss + s;
+while (Length(ss) > 1)and(Length(ss) > byte(ss[1])) do
+ begin
+ s:= copy(ss, 2, byte(ss[1]));
+ Delete(ss, 1, Succ(byte(ss[1])));
+ ParseCmd(s)
+ end;
+end;
+
+begin
+WriteLn('run hw 640 480 avematan 46631 (CVSKGIHSVHX) 1');
+SDL_Init(0);
+SDLNet_Init;
+ip.host:= 0;
+ip.port:= $27B6;
+servsock:= SDLNet_TCP_Open(ip);
+repeat
+ if clsock = nil then
+ clsock:= SDLNet_TCP_Accept(servsock);
+ if clsock <> nil then
+ DoIt;
+ SDL_PollEvent(@event);
+ SDL_Delay(1)
+until event.type_ = SDL_QUITEV;
+SDLNet_Quit;
+SDL_Quit
+end.
--- a/hedgewars/uAI.pas Mon Aug 22 21:38:06 2005 +0000
+++ b/hedgewars/uAI.pas Tue Aug 23 16:17:53 2005 +0000
@@ -1,167 +1,167 @@
-(*
- * 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 uAI;
-interface
-{$INCLUDE options.inc}
-procedure ProcessBot;
-
-implementation
-uses uAIActions, uAIMisc, uMisc, uTeams, uConsts, uAIAmmoTests, uGears, SDLh;
-
-function Go(Gear: PGear; Times: Longword): boolean;
-begin
-Result:= false
-end;
-
-procedure Think;
-var Targets: TTargets;
- Angle, Power: integer;
- Time: Longword;
-
- 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 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);
- inc(t)
- until (t >= Targets.Count)
- 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;
-
-begin
-with CurrentTeam.Hedgehogs[CurrentTeam.CurrHedgehog] do
- if ((Gear.State and (gstAttacked or gstAttacking or gstMoving or gstFalling)) <> 0) then exit;
-
-FillTargets(Targets);
-
-TryGo(0, 0);
-
-if IsActionListEmpty then
- TryGo(0, ctfNotFull);
-if IsActionListEmpty then
- TryGo(0, ctfBreach);
-
-if IsActionListEmpty then
- begin
- AddAction(aia_Weapon, ord(amSkip), 1000);
- AddAction(aia_Attack, aim_push, 1000);
- exit
- 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
-end;
-
-procedure ProcessBot;
-begin
-with CurrentTeam.Hedgehogs[CurrentTeam.CurrHedgehog] do
- if (Gear <> nil)and((Gear.State and gstHHDriven) <> 0) then
- begin
- if IsActionListEmpty then Think;
- ProcessAction
- end
-end;
-
-end.
+(*
+ * 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 uAI;
+interface
+{$INCLUDE options.inc}
+procedure ProcessBot;
+
+implementation
+uses uAIActions, uAIMisc, uMisc, uTeams, uConsts, uAIAmmoTests, uGears, SDLh;
+
+function Go(Gear: PGear; Times: Longword): boolean;
+begin
+Result:= false
+end;
+
+procedure Think;
+var Targets: TTargets;
+ Angle, Power: integer;
+ Time: Longword;
+
+ 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 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);
+ inc(t)
+ until (t >= Targets.Count)
+ 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;
+
+begin
+with CurrentTeam.Hedgehogs[CurrentTeam.CurrHedgehog] do
+ if ((Gear.State and (gstAttacked or gstAttacking or gstMoving or gstFalling)) <> 0) then exit;
+
+FillTargets(Targets);
+
+TryGo(0, 0);
+
+if IsActionListEmpty then
+ TryGo(0, ctfNotFull);
+if IsActionListEmpty then
+ TryGo(0, ctfBreach);
+
+if IsActionListEmpty then
+ begin
+ AddAction(aia_Weapon, ord(amSkip), 1000);
+ AddAction(aia_Attack, aim_push, 1000);
+ exit
+ 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
+end;
+
+procedure ProcessBot;
+begin
+with CurrentTeam.Hedgehogs[CurrentTeam.CurrHedgehog] do
+ if (Gear <> nil)and((Gear.State and gstHHDriven) <> 0) then
+ begin
+ if IsActionListEmpty then Think;
+ ProcessAction
+ end
+end;
+
+end.
--- a/hedgewars/uAIActions.pas Mon Aug 22 21:38:06 2005 +0000
+++ b/hedgewars/uAIActions.pas Tue Aug 23 16:17:53 2005 +0000
@@ -1,187 +1,187 @@
-(*
- * 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;
- aia_Left = 1;
- aia_Right = 2;
- aia_Timer = 3;
- aia_Slot = 4;
- aia_attack = 5;
- aia_Up = 6;
- aia_Down = 7;
-
- aia_Weapon = $80000000;
- aia_WaitX = $80000001;
- aia_WaitY = $80000002;
- aia_LookLeft = $80000003;
- aia_LookRight = $80000004;
-
- aim_push = $80000000;
- aim_release = $80000001;
- ai_specmask = $80000000;
-
-type PAction = ^TAction;
- TAction = record
- Action, Param: Longword;
- Time: Longword;
- Next: PAction;
- end;
-
-function AddAction(Action, Param, TimeDelta: Longword): PAction;
-procedure FreeActionsList;
-function IsActionListEmpty: boolean;
-procedure ProcessAction;
-
-implementation
-uses uMisc, uConsts, uConsole, uTeams;
-
-const ActionIdToStr: array[0..7] of string[16] = (
-{aia_none} '',
-{aia_Left} 'left',
-{aia_Right} 'right',
-{aia_Timer} 'timer',
-{aia_slot} 'slot',
-{aia_attack} 'attack',
-{aia_Up} 'up',
-{aia_Down} 'down'
- );
-
-
-var ActionList,
- FinAction: PAction;
-
-function AddAction(Action, Param, TimeDelta: Longword): PAction;
-begin
-New(Result);
-TryDo(Result <> nil, errmsgDynamicVar, 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;
-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;
-var s: shortstring;
-begin
-if ActionList = nil then exit;
-with ActionList^ 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');
- end else
- begin
- s:= ActionIdToStr[Action];
- if (Param and ai_specmask) <> 0 then
- case Param of
- aim_push: s:= '+' + s;
- aim_release: s:= '-' + s;
- end
- else if Param <> 0 then s:= s + ' ' + inttostr(Param);
- ParseCommand(s)
- end
- end;
-DeleteCurrAction
-end;
-
-end.
+(*
+ * 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;
+ aia_Left = 1;
+ aia_Right = 2;
+ aia_Timer = 3;
+ aia_Slot = 4;
+ aia_attack = 5;
+ aia_Up = 6;
+ aia_Down = 7;
+
+ aia_Weapon = $80000000;
+ aia_WaitX = $80000001;
+ aia_WaitY = $80000002;
+ aia_LookLeft = $80000003;
+ aia_LookRight = $80000004;
+
+ aim_push = $80000000;
+ aim_release = $80000001;
+ ai_specmask = $80000000;
+
+type PAction = ^TAction;
+ TAction = record
+ Action, Param: Longword;
+ Time: Longword;
+ Next: PAction;
+ end;
+
+function AddAction(Action, Param, TimeDelta: Longword): PAction;
+procedure FreeActionsList;
+function IsActionListEmpty: boolean;
+procedure ProcessAction;
+
+implementation
+uses uMisc, uConsts, uConsole, uTeams;
+
+const ActionIdToStr: array[0..7] of string[16] = (
+{aia_none} '',
+{aia_Left} 'left',
+{aia_Right} 'right',
+{aia_Timer} 'timer',
+{aia_slot} 'slot',
+{aia_attack} 'attack',
+{aia_Up} 'up',
+{aia_Down} 'down'
+ );
+
+
+var ActionList,
+ FinAction: PAction;
+
+function AddAction(Action, Param, TimeDelta: Longword): PAction;
+begin
+New(Result);
+TryDo(Result <> nil, errmsgDynamicVar, 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;
+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;
+var s: shortstring;
+begin
+if ActionList = nil then exit;
+with ActionList^ 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');
+ end else
+ begin
+ s:= ActionIdToStr[Action];
+ if (Param and ai_specmask) <> 0 then
+ case Param of
+ aim_push: s:= '+' + s;
+ aim_release: s:= '-' + s;
+ end
+ else if Param <> 0 then s:= s + ' ' + inttostr(Param);
+ ParseCommand(s)
+ end
+ end;
+DeleteCurrAction
+end;
+
+end.
--- a/hedgewars/uAIAmmoTests.pas Mon Aug 22 21:38:06 2005 +0000
+++ b/hedgewars/uAIAmmoTests.pas Tue Aug 23 16:17:53 2005 +0000
@@ -1,196 +1,196 @@
-(*
- * 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 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;
-
-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;
- )
- );
-
-implementation
-uses uMisc, uAIMisc;
-
-function TestGrenade(Me, Targ: TPoint; Flags: Longword; out Time: Longword; out Angle, Power: integer): boolean;
-var Vx, Vy, r: real;
- flHasTrace: boolean;
-
- 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;
-
-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
-end;
-
-function TestBazooka(Me, Targ: TPoint; Flags: Longword; out Time: Longword; out Angle, Power: integer): boolean;
-var Vx, Vy, r: real;
- rTime: real;
- flHasTrace: boolean;
-
- function CheckTrace: boolean;
- var x, y, dX, dY: real;
- t: integer;
- begin
- x:= Me.X + Vx*20;
- y:= Me.Y + Vy*20;
- dX:= Vx;
- dY:= -Vy;
- Result:= false;
- if (Flags and ctfNotFull) = 0 then t:= trunc(rTime)
- else t:= trunc(rTime) - 100;
- 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
- end;
-
-begin
-Time:= 0;
-Result:= false;
-rTime:= 10;
-flHasTrace:= false;
-repeat
- rTime:= rTime + 100 + random*300;
- 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
-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
- begin
- if (Flags and ctfBreach) <> 0 then
- Result:= NoMyHHNear(round(x), round(y), 27)
- else Result:= false;
- exit
- 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;
-
-
-end.
+(*
+ * 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 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;
+
+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;
+ )
+ );
+
+implementation
+uses uMisc, uAIMisc;
+
+function TestGrenade(Me, Targ: TPoint; Flags: Longword; out Time: Longword; out Angle, Power: integer): boolean;
+var Vx, Vy, r: real;
+ flHasTrace: boolean;
+
+ 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;
+
+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
+end;
+
+function TestBazooka(Me, Targ: TPoint; Flags: Longword; out Time: Longword; out Angle, Power: integer): boolean;
+var Vx, Vy, r: real;
+ rTime: real;
+ flHasTrace: boolean;
+
+ function CheckTrace: boolean;
+ var x, y, dX, dY: real;
+ t: integer;
+ begin
+ x:= Me.X + Vx*20;
+ y:= Me.Y + Vy*20;
+ dX:= Vx;
+ dY:= -Vy;
+ Result:= false;
+ if (Flags and ctfNotFull) = 0 then t:= trunc(rTime)
+ else t:= trunc(rTime) - 100;
+ 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
+ end;
+
+begin
+Time:= 0;
+Result:= false;
+rTime:= 10;
+flHasTrace:= false;
+repeat
+ rTime:= rTime + 100 + random*300;
+ 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
+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
+ begin
+ if (Flags and ctfBreach) <> 0 then
+ Result:= NoMyHHNear(round(x), round(y), 27)
+ else Result:= false;
+ exit
+ 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;
+
+
+end.
--- a/hedgewars/uAIMisc.pas Mon Aug 22 21:38:06 2005 +0000
+++ b/hedgewars/uAIMisc.pas Tue Aug 23 16:17:53 2005 +0000
@@ -1,271 +1,271 @@
-(*
- * 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}
-
-type TTargets = record
- Count: integer;
- ar: array[0..cMaxHHIndex*5] of TPoint;
- end;
-
-procedure FillTargets(var Targets: TTargets);
-function DxDy2Angle(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;
-
-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;
-
-begin
-Targets.Count:= 0;
-t:= TeamsList;
-MaxHealth:= 0;
-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
- 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)
- 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;
-
-function DxDy2Angle(const _dY, _dX: Extended): integer;
-const piDIVMaxAngle: Extended = pi/cMaxAngle;
-asm
- fld _dY
- fld _dX
- fpatan
- fld piDIVMaxAngle
- fdiv
- sub esp, 4
- fistp dword ptr [esp]
- pop eax
-end;
-
-function TestColl(x, y, r: integer): boolean;
-begin
-Result:=(((x-r) and $FFFFF800) = 0)and(((y-r) and $FFFFFC00) = 0) and (Land[y-r, x-r] <> 0);
-if Result then exit;
-Result:=(((x-r) and $FFFFF800) = 0)and(((y+r) and $FFFFFC00) = 0) and (Land[y+r, x-r] <> 0);
-if Result then exit;
-Result:=(((x+r) and $FFFFF800) = 0)and(((y-r) and $FFFFFC00) = 0) and (Land[y-r, x+r] <> 0);
-if Result then exit;
-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;
-begin
-i:= 0;
-r:= sqr(r);
-Result:= true;
-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
-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 + cHHHalfHeight >= 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.
+(*
+ * 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}
+
+type TTargets = record
+ Count: integer;
+ ar: array[0..cMaxHHIndex*5] of TPoint;
+ end;
+
+procedure FillTargets(var Targets: TTargets);
+function DxDy2Angle(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;
+
+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;
+
+begin
+Targets.Count:= 0;
+t:= TeamsList;
+MaxHealth:= 0;
+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
+ 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)
+ 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;
+
+function DxDy2Angle(const _dY, _dX: Extended): integer;
+const piDIVMaxAngle: Extended = pi/cMaxAngle;
+asm
+ fld _dY
+ fld _dX
+ fpatan
+ fld piDIVMaxAngle
+ fdiv
+ sub esp, 4
+ fistp dword ptr [esp]
+ pop eax
+end;
+
+function TestColl(x, y, r: integer): boolean;
+begin
+Result:=(((x-r) and $FFFFF800) = 0)and(((y-r) and $FFFFFC00) = 0) and (Land[y-r, x-r] <> 0);
+if Result then exit;
+Result:=(((x-r) and $FFFFF800) = 0)and(((y+r) and $FFFFFC00) = 0) and (Land[y+r, x-r] <> 0);
+if Result then exit;
+Result:=(((x+r) and $FFFFF800) = 0)and(((y-r) and $FFFFFC00) = 0) and (Land[y-r, x+r] <> 0);
+if Result then exit;
+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;
+begin
+i:= 0;
+r:= sqr(r);
+Result:= true;
+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
+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 + cHHHalfHeight >= 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 Mon Aug 22 21:38:06 2005 +0000
+++ b/hedgewars/uCollisions.pas Tue Aug 23 16:17:53 2005 +0000
@@ -1,252 +1,252 @@
-(*
- * 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 uCollisions;
-interface
-uses uGears;
-{$INCLUDE options.inc}
-
-type TCollisionEntry = record
- X, Y, HWidth, HHeight: integer;
- cGear: PGear;
- end;
-
-procedure AddGearCR(Gear: PGear);
-procedure UpdateCR(NewX, NewY: integer; Index: Longword);
-procedure DeleteCR(Gear: PGear);
-function CheckGearsCollision(Gear: PGear; Dir: integer; forX: boolean): boolean;
-function HHTestCollisionYwithGear(Gear: PGear; Dir: integer): boolean;
-function TestCollisionXwithGear(Gear: PGear; Dir: integer): boolean;
-function TestCollisionYwithGear(Gear: PGear; Dir: integer): boolean;
-function TestCollisionXwithXYShift(Gear: PGear; ShiftX, ShiftY: integer; Dir: integer): boolean;
-function TestCollisionYwithXYShift(Gear: PGear; ShiftX, ShiftY: integer; Dir: integer): boolean;
-function TestCollisionY(Gear: PGear; Dir: integer): boolean;
-
-implementation
-uses uMisc, uConsts, uLand;
-
-const MAXRECTSINDEX = 255;
-var Count: Longword = 0;
- crects: array[0..MAXRECTSINDEX] of TCollisionEntry;
-
-procedure AddGearCR(Gear: PGear);
-begin
-{$IFDEF DEBUGFILE}AddFileLog('AddCR crects count = ' + inttostr(Count));{$ENDIF}
-TryDo(Count <= MAXRECTSINDEX, 'Collision rects array overflow', true);
-with crects[Count] do
- begin
- X:= round(Gear.X);
- Y:= round(Gear.Y);
- HWidth:= Gear.HalfWidth;
- HHeight:= Gear.HalfHeight;
- cGear:= Gear
- end;
-Gear.CollIndex:= Count;
-inc(Count)
-end;
-
-procedure UpdateCR(NewX, NewY: integer; Index: Longword);
-begin
-with crects[Index] do
- begin
- X:= NewX;
- Y:= NewY
- end
-end;
-
-procedure DeleteCR(Gear: PGear);
-begin
-{$IFDEF DEBUGFILE}AddFileLog('DelCR crects count = ' + inttostr(Count) + ' deleting ' + inttostr(Gear.CollIndex));{$ENDIF}
-if Gear.CollIndex < Pred(Count) then
- begin
- crects[Gear.CollIndex]:= crects[Pred(Count)];
- crects[Gear.CollIndex].cGear.CollIndex:= Gear.CollIndex
- end;
-Gear.CollIndex:= High(Longword);
-dec(Count)
-end;
-
-function CheckGearsCollision(Gear: PGear; Dir: integer; forX: boolean): boolean;
-var x1, x2, y1, y2: integer;
- i: Longword;
-begin
-x1:= round(Gear.X);
-y1:= round(Gear.Y);
-{if (Gear.State and gstOutOfHH) = 0 then
- begin
- p:= PHedgehog(Gear.Hedgehog)^.Gear;
- if (p <> nil) and
- ((x1 + Gear.HalfWidth < round(p.X) - p.HalfWidth)
- or (x1 - Gear.HalfWidth > round(p.X) + p.HalfWidth)
- or (y1 - Gear.HalfHeight > round(p.Y) + p.HalfHeight)
- or (y1 + Gear.HalfHeight < round(p.Y) - p.HalfHeight)) then Gear.State:= Gear.State or gstOutOfHH;
- end; }
-Result:= false;
-if forX then
- begin
- x1:= x1 + Dir*Gear.HalfWidth;
- x2:= x1;
- y2:= y1 + Gear.HalfHeight - 1;
- y1:= y1 - Gear.HalfHeight + 1
- end else
- begin
- y1:= y1 + Dir*Gear.HalfHeight;
- y2:= y1;
- x2:= x1 + Gear.HalfWidth - 1;
- x1:= x1 - Gear.HalfWidth + 1
- end;
-
-for i:= 0 to Pred(Count) do
- with crects[i] do
- if (Gear.CollIndex <> i)
-// if ((p.Kind = gtHedgehog) and ((p.Hedgehog <> Gear.Hedgehog) or ((Gear.State and gstOutOfHH) <> 0)))
- and (x1 <= X + HWidth)
- and (x2 >= X - HWidth)
- and (y1 <= Y + HHeight)
- and (y2 >= Y - HHeight) then
- begin
- Result:= true;
- exit
- end;
-end;
-
-function HHTestCollisionYwithGear(Gear: PGear; Dir: integer): boolean;
-var x, y, i: integer;
-begin
-Result:= false;
-y:= round(Gear.Y);
-if Dir < 0 then y:= y - Gear.HalfHeight
- else y:= y + Gear.HalfHeight;
-
-if ((y - Dir) and $FFFFFC00) = 0 then
- begin
- x:= round(Gear.X);
- if (((x - Gear.HalfWidth) and $FFFFF800) = 0)and(Land[y - Dir, x - Gear.HalfWidth] <> 0)
- or(((x + Gear.HalfWidth) and $FFFFF800) = 0)and(Land[y - Dir, x + Gear.HalfWidth] <> 0) then
- begin
- Result:= true;
- exit
- end
- end;
-
-if (y and $FFFFFC00) = 0 then
- begin
- x:= round(Gear.X) - Gear.HalfWidth + 1;
- i:= x + Gear.HalfWidth * 2 - 2;
- repeat
- if (x and $FFFFF800) = 0 then Result:= Land[y, x]<>0;
- inc(x)
- until (x > i) or Result;
- if Result then exit;
-
- Result:= CheckGearsCollision(Gear, Dir, false)
- end
-end;
-
-function TestCollisionXwithGear(Gear: PGear; Dir: integer): boolean;
-var x, y, i: integer;
-begin
-Result:= false;
-x:= round(Gear.X);
-if Dir < 0 then x:= x - Gear.HalfWidth
- else x:= x + Gear.HalfWidth;
-if (x and $FFFFF800) = 0 then
- begin
- y:= round(Gear.Y) - Gear.HalfHeight + 1; {*}
- i:= y + Gear.HalfHeight * 2 - 2; {*}
- repeat
- if (y and $FFFFFC00) = 0 then Result:= Land[y, x]<>0;
- inc(y)
- until (y > i) or Result;
- if Result then exit;
- Result:= CheckGearsCollision(Gear, Dir, true)
- end
-end;
-
-function TestCollisionXwithXYShift(Gear: PGear; ShiftX, ShiftY: integer; Dir: integer): boolean;
-begin
-Gear.X:= Gear.X + ShiftX;
-Gear.Y:= Gear.Y + ShiftY;
-Result:= TestCollisionXwithGear(Gear, Dir);
-Gear.X:= Gear.X - ShiftX;
-Gear.Y:= Gear.Y - ShiftY
-end;
-
-function TestCollisionYwithGear(Gear: PGear; Dir: integer): boolean;
-var x, y, i: integer;
-begin
-Result:= false;
-y:= round(Gear.Y);
-if Dir < 0 then y:= y - Gear.HalfHeight
- else y:= y + Gear.HalfHeight;
-if (y and $FFFFFC00) = 0 then
- begin
- x:= round(Gear.X) - Gear.HalfWidth + 1; {*}
- i:= x + Gear.HalfWidth * 2 - 2; {*}
- repeat
- if (x and $FFFFF800) = 0 then Result:= Land[y, x]<>0;
- inc(x)
- until (x > i) or Result;
- if Result then exit;
- Result:= CheckGearsCollision(Gear, Dir, false);
- end
-end;
-
-function TestCollisionY(Gear: PGear; Dir: integer): boolean;
-var x, y, i: integer;
-begin
-Result:= false;
-y:= round(Gear.Y);
-if Dir < 0 then y:= y - Gear.HalfHeight
- else y:= y + Gear.HalfHeight;
-if (y and $FFFFFC00) = 0 then
- begin
- x:= round(Gear.X) - Gear.HalfWidth + 1; {*}
- i:= x + Gear.HalfWidth * 2 - 2; {*}
- repeat
- if (x and $FFFFF800) = 0 then Result:= Land[y, x]<>0;
- inc(x)
- until (x > i) or Result;
- end
-end;
-
-function TestCollisionYwithXYShift(Gear: PGear; ShiftX, ShiftY: integer; Dir: integer): boolean;
-begin
-Gear.X:= Gear.X + ShiftX;
-Gear.Y:= Gear.Y + ShiftY;
-Result:= TestCollisionYwithGear(Gear, Dir);
-Gear.X:= Gear.X - ShiftX;
-Gear.Y:= Gear.Y - ShiftY
-end;
-
-end.
+(*
+ * 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 uCollisions;
+interface
+uses uGears;
+{$INCLUDE options.inc}
+
+type TCollisionEntry = record
+ X, Y, HWidth, HHeight: integer;
+ cGear: PGear;
+ end;
+
+procedure AddGearCR(Gear: PGear);
+procedure UpdateCR(NewX, NewY: integer; Index: Longword);
+procedure DeleteCR(Gear: PGear);
+function CheckGearsCollision(Gear: PGear; Dir: integer; forX: boolean): boolean;
+function HHTestCollisionYwithGear(Gear: PGear; Dir: integer): boolean;
+function TestCollisionXwithGear(Gear: PGear; Dir: integer): boolean;
+function TestCollisionYwithGear(Gear: PGear; Dir: integer): boolean;
+function TestCollisionXwithXYShift(Gear: PGear; ShiftX, ShiftY: integer; Dir: integer): boolean;
+function TestCollisionYwithXYShift(Gear: PGear; ShiftX, ShiftY: integer; Dir: integer): boolean;
+function TestCollisionY(Gear: PGear; Dir: integer): boolean;
+
+implementation
+uses uMisc, uConsts, uLand;
+
+const MAXRECTSINDEX = 255;
+var Count: Longword = 0;
+ crects: array[0..MAXRECTSINDEX] of TCollisionEntry;
+
+procedure AddGearCR(Gear: PGear);
+begin
+{$IFDEF DEBUGFILE}AddFileLog('AddCR crects count = ' + inttostr(Count));{$ENDIF}
+TryDo(Count <= MAXRECTSINDEX, 'Collision rects array overflow', true);
+with crects[Count] do
+ begin
+ X:= round(Gear.X);
+ Y:= round(Gear.Y);
+ HWidth:= Gear.HalfWidth;
+ HHeight:= Gear.HalfHeight;
+ cGear:= Gear
+ end;
+Gear.CollIndex:= Count;
+inc(Count)
+end;
+
+procedure UpdateCR(NewX, NewY: integer; Index: Longword);
+begin
+with crects[Index] do
+ begin
+ X:= NewX;
+ Y:= NewY
+ end
+end;
+
+procedure DeleteCR(Gear: PGear);
+begin
+{$IFDEF DEBUGFILE}AddFileLog('DelCR crects count = ' + inttostr(Count) + ' deleting ' + inttostr(Gear.CollIndex));{$ENDIF}
+if Gear.CollIndex < Pred(Count) then
+ begin
+ crects[Gear.CollIndex]:= crects[Pred(Count)];
+ crects[Gear.CollIndex].cGear.CollIndex:= Gear.CollIndex
+ end;
+Gear.CollIndex:= High(Longword);
+dec(Count)
+end;
+
+function CheckGearsCollision(Gear: PGear; Dir: integer; forX: boolean): boolean;
+var x1, x2, y1, y2: integer;
+ i: Longword;
+begin
+x1:= round(Gear.X);
+y1:= round(Gear.Y);
+{if (Gear.State and gstOutOfHH) = 0 then
+ begin
+ p:= PHedgehog(Gear.Hedgehog)^.Gear;
+ if (p <> nil) and
+ ((x1 + Gear.HalfWidth < round(p.X) - p.HalfWidth)
+ or (x1 - Gear.HalfWidth > round(p.X) + p.HalfWidth)
+ or (y1 - Gear.HalfHeight > round(p.Y) + p.HalfHeight)
+ or (y1 + Gear.HalfHeight < round(p.Y) - p.HalfHeight)) then Gear.State:= Gear.State or gstOutOfHH;
+ end; }
+Result:= false;
+if forX then
+ begin
+ x1:= x1 + Dir*Gear.HalfWidth;
+ x2:= x1;
+ y2:= y1 + Gear.HalfHeight - 1;
+ y1:= y1 - Gear.HalfHeight + 1
+ end else
+ begin
+ y1:= y1 + Dir*Gear.HalfHeight;
+ y2:= y1;
+ x2:= x1 + Gear.HalfWidth - 1;
+ x1:= x1 - Gear.HalfWidth + 1
+ end;
+
+for i:= 0 to Pred(Count) do
+ with crects[i] do
+ if (Gear.CollIndex <> i)
+// if ((p.Kind = gtHedgehog) and ((p.Hedgehog <> Gear.Hedgehog) or ((Gear.State and gstOutOfHH) <> 0)))
+ and (x1 <= X + HWidth)
+ and (x2 >= X - HWidth)
+ and (y1 <= Y + HHeight)
+ and (y2 >= Y - HHeight) then
+ begin
+ Result:= true;
+ exit
+ end;
+end;
+
+function HHTestCollisionYwithGear(Gear: PGear; Dir: integer): boolean;
+var x, y, i: integer;
+begin
+Result:= false;
+y:= round(Gear.Y);
+if Dir < 0 then y:= y - Gear.HalfHeight
+ else y:= y + Gear.HalfHeight;
+
+if ((y - Dir) and $FFFFFC00) = 0 then
+ begin
+ x:= round(Gear.X);
+ if (((x - Gear.HalfWidth) and $FFFFF800) = 0)and(Land[y - Dir, x - Gear.HalfWidth] <> 0)
+ or(((x + Gear.HalfWidth) and $FFFFF800) = 0)and(Land[y - Dir, x + Gear.HalfWidth] <> 0) then
+ begin
+ Result:= true;
+ exit
+ end
+ end;
+
+if (y and $FFFFFC00) = 0 then
+ begin
+ x:= round(Gear.X) - Gear.HalfWidth + 1;
+ i:= x + Gear.HalfWidth * 2 - 2;
+ repeat
+ if (x and $FFFFF800) = 0 then Result:= Land[y, x]<>0;
+ inc(x)
+ until (x > i) or Result;
+ if Result then exit;
+
+ Result:= CheckGearsCollision(Gear, Dir, false)
+ end
+end;
+
+function TestCollisionXwithGear(Gear: PGear; Dir: integer): boolean;
+var x, y, i: integer;
+begin
+Result:= false;
+x:= round(Gear.X);
+if Dir < 0 then x:= x - Gear.HalfWidth
+ else x:= x + Gear.HalfWidth;
+if (x and $FFFFF800) = 0 then
+ begin
+ y:= round(Gear.Y) - Gear.HalfHeight + 1; {*}
+ i:= y + Gear.HalfHeight * 2 - 2; {*}
+ repeat
+ if (y and $FFFFFC00) = 0 then Result:= Land[y, x]<>0;
+ inc(y)
+ until (y > i) or Result;
+ if Result then exit;
+ Result:= CheckGearsCollision(Gear, Dir, true)
+ end
+end;
+
+function TestCollisionXwithXYShift(Gear: PGear; ShiftX, ShiftY: integer; Dir: integer): boolean;
+begin
+Gear.X:= Gear.X + ShiftX;
+Gear.Y:= Gear.Y + ShiftY;
+Result:= TestCollisionXwithGear(Gear, Dir);
+Gear.X:= Gear.X - ShiftX;
+Gear.Y:= Gear.Y - ShiftY
+end;
+
+function TestCollisionYwithGear(Gear: PGear; Dir: integer): boolean;
+var x, y, i: integer;
+begin
+Result:= false;
+y:= round(Gear.Y);
+if Dir < 0 then y:= y - Gear.HalfHeight
+ else y:= y + Gear.HalfHeight;
+if (y and $FFFFFC00) = 0 then
+ begin
+ x:= round(Gear.X) - Gear.HalfWidth + 1; {*}
+ i:= x + Gear.HalfWidth * 2 - 2; {*}
+ repeat
+ if (x and $FFFFF800) = 0 then Result:= Land[y, x]<>0;
+ inc(x)
+ until (x > i) or Result;
+ if Result then exit;
+ Result:= CheckGearsCollision(Gear, Dir, false);
+ end
+end;
+
+function TestCollisionY(Gear: PGear; Dir: integer): boolean;
+var x, y, i: integer;
+begin
+Result:= false;
+y:= round(Gear.Y);
+if Dir < 0 then y:= y - Gear.HalfHeight
+ else y:= y + Gear.HalfHeight;
+if (y and $FFFFFC00) = 0 then
+ begin
+ x:= round(Gear.X) - Gear.HalfWidth + 1; {*}
+ i:= x + Gear.HalfWidth * 2 - 2; {*}
+ repeat
+ if (x and $FFFFF800) = 0 then Result:= Land[y, x]<>0;
+ inc(x)
+ until (x > i) or Result;
+ end
+end;
+
+function TestCollisionYwithXYShift(Gear: PGear; ShiftX, ShiftY: integer; Dir: integer): boolean;
+begin
+Gear.X:= Gear.X + ShiftX;
+Gear.Y:= Gear.Y + ShiftY;
+Result:= TestCollisionYwithGear(Gear, Dir);
+Gear.X:= Gear.X - ShiftX;
+Gear.Y:= Gear.Y - ShiftY
+end;
+
+end.
--- a/hedgewars/uConsole.pas Mon Aug 22 21:38:06 2005 +0000
+++ b/hedgewars/uConsole.pas Tue Aug 23 16:17:53 2005 +0000
@@ -1,297 +1,297 @@
-(*
- * Hedgewars, a worms-like game
- * Copyright (c) 2004, 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 uConsole;
-interface
-uses SDLh;
-{$INCLUDE options.inc}
-const isDeveloperMode: boolean = true;
-type TVariableType = (vtCommand, vtInteger, vtReal, vtBoolean);
- TCommandHandler = procedure (var params: shortstring);
-
-procedure DrawConsole(Surface: PSDL_Surface);
-procedure WriteToConsole(s: shortstring);
-procedure WriteLnToConsole(s: shortstring);
-procedure KeyPressConsole(Key: Longword);
-procedure ParseCommand(CmdStr: shortstring);
-procedure AfterAttack; // экспортируется только для вызова из CurrAmmoGear
-
-implementation
-{$J+}
-uses uMisc, uStore, Types, uConsts, uGears, uTeams, uIO, uKeys, uSound, uWorld, uLand;
-const cLineWidth: integer = 0;
- cLinesCount = 256;
-
-type PVariable = ^TVariable;
- TVariable = record
- Next: PVariable;
- Name: string[15];
- VType: TVariableType;
- Handler: pointer;
- end;
-
-var ConsoleLines: array[byte] of ShortString;
- CurrLine: integer = 0;
- InputStr: shortstring;
- Variables: PVariable = nil;
-
-function RegisterVariable(Name: string; VType: TVariableType; p: pointer): PVariable;
-begin
-try
- New(Result);
-except Result:= nil; OutError(errmsgDynamicVar, true) end;
-FillChar(Result^, sizeof(TVariable), 0);
-Result.Name:= Name;
-Result.VType:= VType;
-Result.Handler:= p;
-if Variables = nil then Variables:= Result
- else begin
- Result.Next:= Variables;
- Variables:= Result
- end
-end;
-
-procedure FreeVariablesList;
-var t, tt: PVariable;
-begin
-tt:= Variables;
-Variables:= nil;
-while tt<>nil do
- begin
- t:= tt;
- tt:= tt.Next;
- try
- Dispose(t)
- except OutError(errmsgDynamicVar) end;
- end;
-end;
-
-procedure SplitBySpace(var a, b: shortstring);
-var i, t: integer;
-begin
-i:= Pos(' ', a);
-if i>0 then
- begin
- for t:= 1 to Pred(i) do
- if (a[t] >= 'A')and(a[t] <= 'Z') then Inc(a[t], 32);
- b:= copy(a, i + 1, Length(a) - i);
- while (b[0]<>#0) and (b[1]=#32) do Delete(b, 1, 1);
- byte(a[0]):= Pred(i)
- end else b:= '';
-end;
-
-procedure DrawConsole(Surface: PSDL_Surface);
-var x, y: integer;
- r: TSDL_Rect;
-begin
-with r do
- begin
- x:= 0;
- y:= cConsoleHeight;
- w:= cScreenWidth;
- h:= 4;
- end;
-SDL_FillRect(Surface, @r, cConsoleSplitterColor);
-for y:= 0 to cConsoleHeight div 256 + 1 do
- for x:= 0 to cScreenWidth div 256 + 1 do
- DrawGear(sConsoleBG, x * 256, cConsoleHeight - 256 - y * 256, Surface);
-for y:= 0 to cConsoleHeight div Fontz[fnt16].Height do
- DXOutText(4, cConsoleHeight - (y + 2) * (Fontz[fnt16].Height + 2), fnt16, ConsoleLines[(CurrLine - 1 - y + cLinesCount) mod cLinesCount], Surface);
-DXOutText(4, cConsoleHeight - Fontz[fnt16].Height - 2, fnt16, '> '+InputStr, Surface);
-end;
-
-procedure WriteToConsole(s: shortstring);
-var Len: integer;
-begin
-{$IFDEF DEBUGFILE}AddFileLog('Console write: ' + s);{$ENDIF}
-Write(s);
-repeat
-Len:= cLineWidth - Length(ConsoleLines[CurrLine]);
-ConsoleLines[CurrLine]:= ConsoleLines[CurrLine] + copy(s, 1, Len);
-Delete(s, 1, Len);
-if byte(ConsoleLines[CurrLine][0])=cLineWidth then
- begin
- inc(CurrLine);
- if CurrLine = cLinesCount then CurrLine:= 0;
- PLongWord(@ConsoleLines[CurrLine])^:= 0
- end;
-until Length(s) = 0
-end;
-
-procedure WriteLnToConsole(s: shortstring);
-begin
-WriteToConsole(s);
-WriteLn;
-inc(CurrLine);
-if CurrLine = cLinesCount then CurrLine:= 0;
-PLongWord(@ConsoleLines[CurrLine])^:= 0
-end;
-
-procedure InitConsole;
-var i: integer;
-begin
-cLineWidth:= cScreenWidth div 10;
-if cLineWidth > 255 then cLineWidth:= 255;
-for i:= 0 to Pred(cLinesCount) do PLongWord(@ConsoleLines[i])^:= 0
-end;
-
-procedure ParseCommand(CmdStr: shortstring);
-type PReal = ^real;
-var i, ii: integer;
- s: shortstring;
- t: PVariable;
- c: char;
-begin
-//WriteLnToConsole(CmdStr);
-if CmdStr[0]=#0 then exit;
-{$IFDEF DEBUGFILE}AddFileLog('ParseCommand "' + CmdStr + '"');{$ENDIF}
-c:= CmdStr[1];
-if c in ['/', '$'] then Delete(CmdStr, 1, 1) else c:= '/';
-SplitBySpace(CmdStr, s);
-t:= Variables;
-while t <> nil do
- begin
- if t.Name = CmdStr then
- begin
- case t.VType of
- vtCommand: if c='/' then
- begin
- TCommandHandler(t.Handler)(s);
- end;
- vtInteger: if c='$' then
- if s[0]=#0 then
- begin
- str(PInteger(t.Handler)^, s);
- WriteLnToConsole('$' + CmdStr + ' is "' + s + '"');
- end else val(s, PInteger(t.Handler)^, i);
- vtReal: if c='$' then
- if s[0]=#0 then
- begin
- str(PReal(t.Handler)^:4:6, s);
- WriteLnToConsole('$' + CmdStr + ' is "' + s + '"');
- end else val(s, PReal(t.Handler)^ , i);
- vtBoolean: if c='$' then
- if s[0]=#0 then
- begin
- str(ord(boolean(t.Handler^)), s);
- WriteLnToConsole('$' + CmdStr + ' is "' + s + '"');
- end else
- begin
- val(s, ii, i);
- boolean(t.Handler^):= not (ii = 0)
- end;
- end;
- exit
- end else t:= t.Next
- end;
-case c of
- '$': WriteLnToConsole(errmsgUnknownVariable + ': "$' + CmdStr + '"')
- else WriteLnToConsole(errmsgUnknownCommand + ': "/' + CmdStr + '"') end
-end;
-
-procedure KeyPressConsole(Key: Longword);
-begin
-case Key of
- 8: if Length(InputStr)>0 then dec(InputStr[0]);
- 13,271: begin
- ParseCommand('/say ' + InputStr);
- InputStr:= ''
- end;
- 96: begin
- GameState:= gsGame;
- cConsoleYAdd:= 0;
- ResetKbd
- end;
- else InputStr:= InputStr + char(Key)
- end
-end;
-
-{$INCLUDE CCHandlers.inc}
-
-procedure AfterAttack;
-begin
-with CurrentTeam.Hedgehogs[CurrentTeam.CurrHedgehog].Gear^,
- CurrentTeam.Hedgehogs[CurrentTeam.CurrHedgehog] do
- begin
- Inc(AttacksNum);
- State:= State and not gstAttacking;
- if Ammo[CurSlot, CurAmmo].NumPerTurn >= AttacksNum then isInMultiShoot:= true
- else begin
- TurnTimeLeft:= Ammoz[Ammo[CurSlot, CurAmmo].AmmoType].TimeAfterTurn;
- State:= State or gstAttacked;
- OnUsedAmmo(Ammo)
- end;
- AttackBar:= 0
- end
-end;
-
-initialization
-InitConsole;
-RegisterVariable('quit' , vtCommand, @chQuit );
-RegisterVariable('capture' , vtCommand, @chCapture );
-RegisterVariable('addteam' , vtCommand, @chAddTeam );
-RegisterVariable('rdriven' , vtCommand, @chTeamLocal );
-//RegisterVariable('gravity' , vtReal , @cGravity ); гравитация не должна быть доступна вообще
-RegisterVariable('c_height', vtInteger, @cConsoleHeight );
-RegisterVariable('gmflags' , vtInteger, @GameFlags );
-RegisterVariable('showfps' , vtBoolean, @cShowFPS );
-RegisterVariable('sound' , vtBoolean, @isSoundEnabled );
-RegisterVariable('name' , vtCommand, @chName );
-RegisterVariable('fort' , vtCommand, @chFort );
-RegisterVariable('grave' , vtCommand, @chGrave );
-RegisterVariable('bind' , vtCommand, @chBind );
-RegisterVariable('add' , vtCommand, @chAdd );
-RegisterVariable('say' , vtCommand, @chSay );
-RegisterVariable('+left' , vtCommand, @chLeft_p );
-RegisterVariable('-left' , vtCommand, @chLeft_m );
-RegisterVariable('+right' , vtCommand, @chRight_p );
-RegisterVariable('-right' , vtCommand, @chRight_m );
-RegisterVariable('+up' , vtCommand, @chUp_p );
-RegisterVariable('-up' , vtCommand, @chUp_m );
-RegisterVariable('+down' , vtCommand, @chDown_p );
-RegisterVariable('-down' , vtCommand, @chDown_m );
-RegisterVariable('+attack' , vtCommand, @chAttack_p );
-RegisterVariable('-attack' , vtCommand, @chAttack_m );
-RegisterVariable('color' , vtCommand, @chColor );
-RegisterVariable('switch' , vtCommand, @chSwitch );
-RegisterVariable('nextturn', vtCommand, @chNextTurn );
-RegisterVariable('timer' , vtCommand, @chTimer );
-RegisterVariable('slot' , vtCommand, @chSlot );
-RegisterVariable('put' , vtCommand, @chPut );
-RegisterVariable('ljump' , vtCommand, @chLJump );
-RegisterVariable('hjump' , vtCommand, @chHJump );
-