- 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 );
-
-finalization
-FreeVariablesList
-
-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 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 );
+
+finalization
+FreeVariablesList
+
+end.
--- a/hedgewars/uConsts.pas Mon Aug 22 21:38:06 2005 +0000
+++ b/hedgewars/uConsts.pas Tue Aug 23 16:17:53 2005 +0000
@@ -1,305 +1,305 @@
-(*
- * 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 uConsts;
-interface
-uses SDLh;
-{$INCLUDE options.inc}
-type TStuff = (sHorizont, sSky, sConsoleBG, sPowerBar, sQuestion);
- TGameState = (gsLandGen, gsStart, gsGame, gsConsole, gsExit);
- TGameType = (gmtLocal, gmtDemo, gmtNet);
- TPathType = (ptData, ptGraphics, ptThemes, ptThemeCurrent, ptTeams, ptMaps,
- ptMapCurrent, ptDemos, ptSounds, ptGraves, ptFonts, ptForts);
- TSprite = (sprWater, sprCloud, sprBomb, sprBigDigit, sprFrame,
- sprLag, sprArrow, sprGrenade, sprTargetP, sprUFO,
- sprSmokeTrace, sprRopeHook);
- TGearType = (gtCloud, gtAmmo_Bomb, gtHedgehog, gtAmmo_Grenade, gtHealthTag,
- gtGrave, gtUFO, gtShotgunShot, gtActionTimer, gtPickHammer, gtRope,
- gtSmokeTrace);
- TSound = (sndGrenadeImpact, sndExplosion, sndThrowPowerUp, sndThrowRelease, sndSplash,
- sndShotgunReload, sndShotgunFire, sndGraveImpact);
- TAmmoType = (amGrenade, amBazooka, amUFO, amShotgun, amPickHammer, amSkip, amRope);
- THWFont = (fnt16, fntBig);
- THHFont = record
- Handle: PTTF_Font;
- Height: integer;
- Name: string[15];
- end;
- TAmmo = record
- Propz: LongWord;
- Count: LongWord;
- NumPerTurn: LongWord;
- Timer: LongWord;
- AmmoType: TAmmoType;
- end;
-
-
-resourcestring
- errmsgCreateSurface = 'Error creating DirectDraw7 surface';
- errmsgNoDesc = 'Unknown error';
- errmsgTransparentSet = 'Error setting transparent color';
- errmsgDynamicVar = 'Error working with dynamic memory';
- errmsgUnknownCommand = 'Unknown command';
- errmsgUnknownVariable = 'Unknown variable';
- errmsgIncorrectUse = 'Incorrect use';
- errmsgShouldntRun = 'This program shouldn''t be run manually';
-
- msgLoading = 'Loading ';
- msgOK = 'ok';
- msgFailed = 'failed';
- msgGettingConfig = 'Getting game config...';
-
-const
- cAppName = 'hw';
- cAppTitle = 'hw';
- cNetProtoVersion = 1;
-
- rndfillstr = 'hw';
-
- cTransparentColor: Cardinal = $000000;
-
- cMaxHHIndex = 9;
- cMaxHHs = 20;
- cHHSurfaceWidth = 512;
- cHHSurfaceHeigth = 256;
-
- cHHHalfHeight = 11;
-
- cKeyMaxIndex = 322;
-
- cMaxCaptions = 4;
-
- cInactDelay = 1500;
-
- gfForts = $00000001;
-
- gstDrowning = $00000001;
- gstHHDriven = $00000002;
- gstMoving = $00000004;
- gstAttacked = $00000008;
- gstAttacking = $00000010;
- gstCollision = $00000020;
- gstHHChooseTarget = $00000040;
- gstFalling = $00000080;
- gstHHJumping = $00000100;
- gsttmpFlag = $00000200;
- gstOutOfHH = $00000400;
- gstHHThinking = $00000800;
-
- gtsStartGame = 1;
-
- gm_Left = $00000001;
- gm_Right = $00000002;
- gm_Up = $00000004;
- gm_Down = $00000008;
- gm_Switch = $00000010;
- gm_Attack = $00000020;
- gm_LJump = $00000040;
- gm_HJump = $00000080;
- gm_Destroy= $00000100;
-
- cMaxSlot = 4;
- cMaxSlotAmmo = 1;
-
- ammoprop_Timerable = $00000001;
- ammoprop_Power = $00000002;
- ammoprop_NeedTarget = $00000004;
- ammoprop_ForwMsgs = $00000008;
- ammoprop_AttackInFall = $00000010;
- ammoprop_AttackInJump = $00000020;
- AMMO_INFINITE = High(LongWord);
-
- capgrpStartGame = 0;
- capgrpAmmoinfo = 1;
- capgrpNetSay = 2;
-
- EXPLAllDamageInRadius = 1;
- EXPLAutoSound = 2;
- EXPLNoDamage = 4;
-
- cToggleConsoleKey = 39;
-
- NoPointX = Low(Integer); // константа для TargetPoint, показывает, что цель не указана
-
- cLandFileName = 'Land.bmp';
- cHHFileName = 'Hedgehog.png';
- cCHFileName = 'Crosshair.png';
- cThemeCFGFilename = 'theme.cfg';
-
- Fontz: array[THWFont] of THHFont = (
- (Height: 12;
- Name: 'UN1251N.TTF'),
- (Height: 24;
- Name: 'UN1251N.TTF')
- );
-
- Pathz: array[TPathType] of string[ 64] = (
- 'Data/', // ptData
- 'Data/Graphics/', // ptGraphics
- 'Data/Themes/', // ptThemes
- 'Data/Themes/Default/', // ptThemeCurrent
- 'Data/Teams/', // ptTeams
- 'Data/Maps/', // ptMaps
- 'Data/Maps/Current/', // ptMapCurrent
- 'Data/Demos/', // ptDemos
- 'Data/Sounds/', // ptSounds
- 'Data/Graphics/Graves/', // ptGraves
- 'Data/Fonts/', // ptFonts
- 'Data/Forts/' // ptForts
- );
-
- StuffLoadData: array[TStuff] of record
- FileName: String[31];
- Path : TPathType;
- end = (
- (FileName: 'horizont.png'; Path: ptThemeCurrent ), // sHorizont
- (FileName: 'Sky.png'; Path: ptThemeCurrent ), // sSky
- (FileName: 'Console.png'; Path: ptGraphics ), // sConsoleBG
- (FileName: 'PowerBar.png'; Path: ptGraphics ), // sPowerBar
- (FileName: 'thinking.png'; Path: ptGraphics ) // sQuestion
- );
- StuffPoz: array[TStuff] of TSDL_Rect = (
- (x: 0; y: 0; w: 512; h: 256), // sHorizont
- (x: 512; y: 0; w: 64; h:1024), // sSky
- (x: 256; y: 256; w: 256; h: 256), // sConsoleBG
- (x: 256; y: 768; w: 256; h: 32), // sPowerBar
- (x: 256; y: 512; w: 32; h: 32) // sQuestion
- );
- SpritesData: array[TSprite] of record
- FileName: String[31];
- Path : TPathType;
- Surface : PSDL_Surface;
- Width, Height: integer;
- end = (
- (FileName: 'BlueWater.png'; Path: ptGraphics; Width: 256; Height: 48),// sprWater
- (FileName: 'Clouds.png'; Path: ptGraphics; Width: 256; Height:128),// sprCloud
- (FileName: 'Bomb.png'; Path: ptGraphics; Width: 16; Height: 16),// sprBomb
- (FileName: 'BigDigits.png'; Path: ptGraphics; Width: 32; Height: 32),// sprBigDigit
- (FileName: 'Frame.png'; Path: ptGraphics; Width: 4; Height: 32),// sprFrame
- (FileName: 'Lag.png'; Path: ptGraphics; Width: 64; Height: 64),// sprLag
- (FileName: 'Arrow.png'; Path: ptGraphics; Width: 16; Height: 16),// sprCursor
- (FileName: 'Grenade.png'; Path: ptGraphics; Width: 32; Height: 32),// sprGrenade
- (FileName: 'Targetp.png'; Path: ptGraphics; Width: 32; Height: 32),// sprTargetP
- (FileName: 'UFO.png'; Path: ptGraphics; Width: 32; Height: 32),// sprUFO
- (FileName:'SmokeTrace.png'; Path: ptGraphics; Width: 32; Height: 32),// sprSmokeTrace
- (FileName: 'RopeHook.png'; Path: ptGraphics; Width: 32; Height: 32) // sprRopeHook
- );
- Soundz: array[TSound] of record
- FileName: String[31];
- Path : TPathType;
- id : PMixChunk;
- end = (
- (FileName: 'grenadeimpact.ogg'; Path: ptSounds ),// sndGrenadeImpact
- (FileName: 'explosion.ogg'; Path: ptSounds ),// sndExplosion
- (FileName: 'throwpowerup.ogg'; Path: ptSounds ),// sndThrowPowerUp
- (FileName: 'throwrelease.ogg'; Path: ptSounds ),// sndThrowRelease
- (FileName: 'splash.ogg'; Path: ptSounds ),// sndSplash
- (FileName: 'shotgunreload.ogg'; Path: ptSounds ),// sndShotgunReload
- (FileName: 'shotgunfire.ogg'; Path: ptSounds ),// sndShotgunFire
- (FileName: 'graveimpact.ogg'; Path: ptSounds ) // sndGraveImpact
- );
-
- Ammoz: array [TAmmoType] of record
- Name: string[32];
- Ammo: TAmmo;
- Slot: Longword;
- TimeAfterTurn: Longword;
- end = (
- (Name: 'Grenade';
- Ammo: (Propz: ammoprop_Timerable or ammoprop_Power;
- Count: AMMO_INFINITE;
- NumPerTurn: 0;
- Timer: 3000;
- AmmoType: amGrenade);
- Slot: 0;
- TimeAfterTurn: 3000),
- (Name: 'Bazooka';
- Ammo: (Propz: ammoprop_Power;
- Count: AMMO_INFINITE;
- NumPerTurn: 0;
- Timer: 0;
- AmmoType: amBazooka);
- Slot: 1;
- TimeAfterTurn: 3000),
- (Name: 'UFO';
- Ammo: (Propz: ammoprop_Power or ammoprop_NeedTarget;
- Count: 4;
- NumPerTurn: 0;
- Timer: 0;
- AmmoType: amUFO);
- Slot: 0;
- TimeAfterTurn: 3000),
- (Name: 'Shotgun';
- Ammo: (Propz: 0;
- Count: AMMO_INFINITE;
- NumPerTurn: 1;
- Timer: 0;
- AmmoType: amShotgun);
- Slot: 2;
- TimeAfterTurn: 3000),
- (Name: 'Pneumatic pick';
- Ammo: (Propz: ammoprop_ForwMsgs or ammoprop_AttackInFall or ammoprop_AttackInJump;
- Count: 2;
- NumPerTurn: 0;
- Timer: 0;
- AmmoType: amPickHammer);
- Slot: 3;
- TimeAfterTurn: 0),
- (Name: 'Skip turn';
- Ammo: (Propz: 0;
- Count: AMMO_INFINITE;
- NumPerTurn: 0;
- Timer: 0;
- AmmoType: amSkip);
- Slot: 4;
- TimeAfterTurn: 0),
- (Name: 'Rope';
- Ammo: (Propz: ammoprop_ForwMsgs or ammoprop_AttackInFall or ammoprop_AttackInJump;
- Count: 5;
- NumPerTurn: 0;
- Timer: 0;
- AmmoType: amRope);
- Slot: 3;
- TimeAfterTurn: 0)
- );
-
- Resolutions: array[0..3] of String = (
- '640 480',
- '800 600',
- '1024 768',
- '1280 1024'
- );
-
-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 uConsts;
+interface
+uses SDLh;
+{$INCLUDE options.inc}
+type TStuff = (sHorizont, sSky, sConsoleBG, sPowerBar, sQuestion);
+ TGameState = (gsLandGen, gsStart, gsGame, gsConsole, gsExit);
+ TGameType = (gmtLocal, gmtDemo, gmtNet);
+ TPathType = (ptData, ptGraphics, ptThemes, ptThemeCurrent, ptTeams, ptMaps,
+ ptMapCurrent, ptDemos, ptSounds, ptGraves, ptFonts, ptForts);
+ TSprite = (sprWater, sprCloud, sprBomb, sprBigDigit, sprFrame,
+ sprLag, sprArrow, sprGrenade, sprTargetP, sprUFO,
+ sprSmokeTrace, sprRopeHook);
+ TGearType = (gtCloud, gtAmmo_Bomb, gtHedgehog, gtAmmo_Grenade, gtHealthTag,
+ gtGrave, gtUFO, gtShotgunShot, gtActionTimer, gtPickHammer, gtRope,
+ gtSmokeTrace);
+ TSound = (sndGrenadeImpact, sndExplosion, sndThrowPowerUp, sndThrowRelease, sndSplash,
+ sndShotgunReload, sndShotgunFire, sndGraveImpact);
+ TAmmoType = (amGrenade, amBazooka, amUFO, amShotgun, amPickHammer, amSkip, amRope);
+ THWFont = (fnt16, fntBig);
+ THHFont = record
+ Handle: PTTF_Font;
+ Height: integer;
+ Name: string[15];
+ end;
+ TAmmo = record
+ Propz: LongWord;
+ Count: LongWord;
+ NumPerTurn: LongWord;
+ Timer: LongWord;
+ AmmoType: TAmmoType;
+ end;
+
+
+resourcestring
+ errmsgCreateSurface = 'Error creating DirectDraw7 surface';
+ errmsgNoDesc = 'Unknown error';
+ errmsgTransparentSet = 'Error setting transparent color';
+ errmsgDynamicVar = 'Error working with dynamic memory';
+ errmsgUnknownCommand = 'Unknown command';
+ errmsgUnknownVariable = 'Unknown variable';
+ errmsgIncorrectUse = 'Incorrect use';
+ errmsgShouldntRun = 'This program shouldn''t be run manually';
+
+ msgLoading = 'Loading ';
+ msgOK = 'ok';
+ msgFailed = 'failed';
+ msgGettingConfig = 'Getting game config...';
+
+const
+ cAppName = 'hw';
+ cAppTitle = 'hw';
+ cNetProtoVersion = 1;
+
+ rndfillstr = 'hw';
+
+ cTransparentColor: Cardinal = $000000;
+
+ cMaxHHIndex = 9;
+ cMaxHHs = 20;
+ cHHSurfaceWidth = 512;
+ cHHSurfaceHeigth = 256;
+
+ cHHHalfHeight = 11;
+
+ cKeyMaxIndex = 322;
+
+ cMaxCaptions = 4;
+
+ cInactDelay = 1500;
+
+ gfForts = $00000001;
+
+ gstDrowning = $00000001;
+ gstHHDriven = $00000002;
+ gstMoving = $00000004;
+ gstAttacked = $00000008;
+ gstAttacking = $00000010;
+ gstCollision = $00000020;
+ gstHHChooseTarget = $00000040;
+ gstFalling = $00000080;
+ gstHHJumping = $00000100;
+ gsttmpFlag = $00000200;
+ gstOutOfHH = $00000400;
+ gstHHThinking = $00000800;
+
+ gtsStartGame = 1;
+
+ gm_Left = $00000001;
+ gm_Right = $00000002;
+ gm_Up = $00000004;
+ gm_Down = $00000008;
+ gm_Switch = $00000010;
+ gm_Attack = $00000020;
+ gm_LJump = $00000040;
+ gm_HJump = $00000080;
+ gm_Destroy= $00000100;
+
+ cMaxSlot = 4;
+ cMaxSlotAmmo = 1;
+
+ ammoprop_Timerable = $00000001;
+ ammoprop_Power = $00000002;
+ ammoprop_NeedTarget = $00000004;
+ ammoprop_ForwMsgs = $00000008;
+ ammoprop_AttackInFall = $00000010;
+ ammoprop_AttackInJump = $00000020;
+ AMMO_INFINITE = High(LongWord);
+
+ capgrpStartGame = 0;
+ capgrpAmmoinfo = 1;
+ capgrpNetSay = 2;
+
+ EXPLAllDamageInRadius = 1;
+ EXPLAutoSound = 2;
+ EXPLNoDamage = 4;
+
+ cToggleConsoleKey = 39;
+
+ NoPointX = Low(Integer); // константа для TargetPoint, показывает, что цель не указана
+
+ cLandFileName = 'Land.bmp';
+ cHHFileName = 'Hedgehog.png';
+ cCHFileName = 'Crosshair.png';
+ cThemeCFGFilename = 'theme.cfg';
+
+ Fontz: array[THWFont] of THHFont = (
+ (Height: 12;
+ Name: 'UN1251N.TTF'),
+ (Height: 24;
+ Name: 'UN1251N.TTF')
+ );
+
+ Pathz: array[TPathType] of string[ 64] = (
+ 'Data/', // ptData
+ 'Data/Graphics/', // ptGraphics
+ 'Data/Themes/', // ptThemes
+ 'Data/Themes/Default/', // ptThemeCurrent
+ 'Data/Teams/', // ptTeams
+ 'Data/Maps/', // ptMaps
+ 'Data/Maps/Current/', // ptMapCurrent
+ 'Data/Demos/', // ptDemos
+ 'Data/Sounds/', // ptSounds
+ 'Data/Graphics/Graves/', // ptGraves
+ 'Data/Fonts/', // ptFonts
+ 'Data/Forts/' // ptForts
+ );
+
+ StuffLoadData: array[TStuff] of record
+ FileName: String[31];
+ Path : TPathType;
+ end = (
+ (FileName: 'horizont.png'; Path: ptThemeCurrent ), // sHorizont
+ (FileName: 'Sky.png'; Path: ptThemeCurrent ), // sSky
+ (FileName: 'Console.png'; Path: ptGraphics ), // sConsoleBG
+ (FileName: 'PowerBar.png'; Path: ptGraphics ), // sPowerBar
+ (FileName: 'thinking.png'; Path: ptGraphics ) // sQuestion
+ );
+ StuffPoz: array[TStuff] of TSDL_Rect = (
+ (x: 0; y: 0; w: 512; h: 256), // sHorizont
+ (x: 512; y: 0; w: 64; h:1024), // sSky
+ (x: 256; y: 256; w: 256; h: 256), // sConsoleBG
+ (x: 256; y: 768; w: 256; h: 32), // sPowerBar
+ (x: 256; y: 512; w: 32; h: 32) // sQuestion
+ );
+ SpritesData: array[TSprite] of record
+ FileName: String[31];
+ Path : TPathType;
+ Surface : PSDL_Surface;
+ Width, Height: integer;
+ end = (
+ (FileName: 'BlueWater.png'; Path: ptGraphics; Width: 256; Height: 48),// sprWater
+ (FileName: 'Clouds.png'; Path: ptGraphics; Width: 256; Height:128),// sprCloud
+ (FileName: 'Bomb.png'; Path: ptGraphics; Width: 16; Height: 16),// sprBomb
+ (FileName: 'BigDigits.png'; Path: ptGraphics; Width: 32; Height: 32),// sprBigDigit
+ (FileName: 'Frame.png'; Path: ptGraphics; Width: 4; Height: 32),// sprFrame
+ (FileName: 'Lag.png'; Path: ptGraphics; Width: 64; Height: 64),// sprLag
+ (FileName: 'Arrow.png'; Path: ptGraphics; Width: 16; Height: 16),// sprCursor
+ (FileName: 'Grenade.png'; Path: ptGraphics; Width: 32; Height: 32),// sprGrenade
+ (FileName: 'Targetp.png'; Path: ptGraphics; Width: 32; Height: 32),// sprTargetP
+ (FileName: 'UFO.png'; Path: ptGraphics; Width: 32; Height: 32),// sprUFO
+ (FileName:'SmokeTrace.png'; Path: ptGraphics; Width: 32; Height: 32),// sprSmokeTrace
+ (FileName: 'RopeHook.png'; Path: ptGraphics; Width: 32; Height: 32) // sprRopeHook
+ );
+ Soundz: array[TSound] of record
+ FileName: String[31];
+ Path : TPathType;
+ id : PMixChunk;
+ end = (
+ (FileName: 'grenadeimpact.ogg'; Path: ptSounds ),// sndGrenadeImpact
+ (FileName: 'explosion.ogg'; Path: ptSounds ),// sndExplosion
+ (FileName: 'throwpowerup.ogg'; Path: ptSounds ),// sndThrowPowerUp
+ (FileName: 'throwrelease.ogg'; Path: ptSounds ),// sndThrowRelease
+ (FileName: 'splash.ogg'; Path: ptSounds ),// sndSplash
+ (FileName: 'shotgunreload.ogg'; Path: ptSounds ),// sndShotgunReload
+ (FileName: 'shotgunfire.ogg'; Path: ptSounds ),// sndShotgunFire
+ (FileName: 'graveimpact.ogg'; Path: ptSounds ) // sndGraveImpact
+ );
+
+ Ammoz: array [TAmmoType] of record
+ Name: string[32];
+ Ammo: TAmmo;
+ Slot: Longword;
+ TimeAfterTurn: Longword;
+ end = (
+ (Name: 'Grenade';
+ Ammo: (Propz: ammoprop_Timerable or ammoprop_Power;
+ Count: AMMO_INFINITE;
+ NumPerTurn: 0;
+ Timer: 3000;
+ AmmoType: amGrenade);
+ Slot: 0;
+ TimeAfterTurn: 3000),
+ (Name: 'Bazooka';
+ Ammo: (Propz: ammoprop_Power;
+ Count: AMMO_INFINITE;
+ NumPerTurn: 0;
+ Timer: 0;
+ AmmoType: amBazooka);
+ Slot: 1;
+ TimeAfterTurn: 3000),
+ (Name: 'UFO';
+ Ammo: (Propz: ammoprop_Power or ammoprop_NeedTarget;
+ Count: 4;
+ NumPerTurn: 0;
+ Timer: 0;
+ AmmoType: amUFO);
+ Slot: 0;
+ TimeAfterTurn: 3000),
+ (Name: 'Shotgun';
+ Ammo: (Propz: 0;
+ Count: AMMO_INFINITE;
+ NumPerTurn: 1;
+ Timer: 0;
+ AmmoType: amShotgun);
+ Slot: 2;
+ TimeAfterTurn: 3000),
+ (Name: 'Pneumatic pick';
+ Ammo: (Propz: ammoprop_ForwMsgs or ammoprop_AttackInFall or ammoprop_AttackInJump;
+ Count: 2;
+ NumPerTurn: 0;
+ Timer: 0;
+ AmmoType: amPickHammer);
+ Slot: 3;
+ TimeAfterTurn: 0),
+ (Name: 'Skip turn';
+ Ammo: (Propz: 0;
+ Count: AMMO_INFINITE;
+ NumPerTurn: 0;
+ Timer: 0;
+ AmmoType: amSkip);
+ Slot: 4;
+ TimeAfterTurn: 0),
+ (Name: 'Rope';
+ Ammo: (Propz: ammoprop_ForwMsgs or ammoprop_AttackInFall or ammoprop_AttackInJump;
+ Count: 5;
+ NumPerTurn: 0;
+ Timer: 0;
+ AmmoType: amRope);
+ Slot: 3;
+ TimeAfterTurn: 0)
+ );
+
+ Resolutions: array[0..3] of String = (
+ '640 480',
+ '800 600',
+ '1024 768',
+ '1280 1024'
+ );
+
+implementation
+
+end.
--- a/hedgewars/uGame.pas Mon Aug 22 21:38:06 2005 +0000
+++ b/hedgewars/uGame.pas Tue Aug 23 16:17:53 2005 +0000
@@ -1,92 +1,92 @@
-(*
- * 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 uGame;
-interface
-uses SDLh;
-{$INCLUDE options.inc}
-
-procedure DoGameTick(Lag: integer);
-
-////////////////////
- implementation
-////////////////////
-uses uMisc, uConsts, uWorld, uKeys, uTeams, uIO, uAI, uGears;
-
-procedure DoGameTick(Lag: integer);
-const SendEmptyPacketTicks: LongWord = 0;
-var i: integer;
-begin
-if CurrentTeam.ExtDriven then
- begin
- if (GameType = gmtDemo) then
- ProcessKbdDemo;
- end
- else begin
- NetGetNextCmd; // на случай, если что-то сказано
- if SendEmptyPacketTicks >= cSendEmptyPacketTime then
- begin
- SendIPC('+');
- SendEmptyPacketTicks:= 0
- end;
- inc(SendEmptyPacketTicks, Lag)
- end;
-
-if Lag > 100 then Lag:= 100;
-
-for i:= 1 to Lag do
- if not CurrentTeam.ExtDriven then
- begin
- with CurrentTeam^ do
- if Hedgehogs[CurrHedgehog].BotLevel <> 0 then ProcessBot;
- ProcessGears
- end else
- begin
- NetGetNextCmd;
- if isInLag then
- case GameType of
- gmtNet: break;
- gmtDemo: begin
- SendIPC('q');
- GameState:= gsExit;
- exit
- end
- end
- else ProcessGears
- end;
-if not CurrentTeam.ExtDriven then isInLag:= false;
-
-MoveWorld
-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 uGame;
+interface
+uses SDLh;
+{$INCLUDE options.inc}
+
+procedure DoGameTick(Lag: integer);
+
+////////////////////
+ implementation
+////////////////////
+uses uMisc, uConsts, uWorld, uKeys, uTeams, uIO, uAI, uGears;
+
+procedure DoGameTick(Lag: integer);
+const SendEmptyPacketTicks: LongWord = 0;
+var i: integer;
+begin
+if CurrentTeam.ExtDriven then
+ begin
+ if (GameType = gmtDemo) then
+ ProcessKbdDemo;
+ end
+ else begin
+ NetGetNextCmd; // на случай, если что-то сказано
+ if SendEmptyPacketTicks >= cSendEmptyPacketTime then
+ begin
+ SendIPC('+');
+ SendEmptyPacketTicks:= 0
+ end;
+ inc(SendEmptyPacketTicks, Lag)
+ end;
+
+if Lag > 100 then Lag:= 100;
+
+for i:= 1 to Lag do
+ if not CurrentTeam.ExtDriven then
+ begin
+ with CurrentTeam^ do
+ if Hedgehogs[CurrHedgehog].BotLevel <> 0 then ProcessBot;
+ ProcessGears
+ end else
+ begin
+ NetGetNextCmd;
+ if isInLag then
+ case GameType of
+ gmtNet: break;
+ gmtDemo: begin
+ SendIPC('q');
+ GameState:= gsExit;
+ exit
+ end
+ end
+ else ProcessGears
+ end;
+if not CurrentTeam.ExtDriven then isInLag:= false;
+
+MoveWorld
+end;
+
+end.
--- a/hedgewars/uGears.pas Mon Aug 22 21:38:06 2005 +0000
+++ b/hedgewars/uGears.pas Tue Aug 23 16:17:53 2005 +0000
@@ -1,508 +1,508 @@
-(*
- * 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 uGears;
-interface
-uses SDLh, uConsts;
-{$INCLUDE options.inc}
-const AllInactive: boolean = false;
-
-type PGear = ^TGear;
- TGearStepProcedure = procedure (Gear: PGear);
- TGear = record
- NextGear, PrevGear: PGear;
- Active: Boolean;
- State : Cardinal;
- X : Real;
- Y : Real;
- dX: Real;
- dY: Real;
- Kind : TGearType;
- doStep: TGearStepProcedure;
- HalfWidth, HalfHeight: integer;
- Angle, Power : Cardinal;
- DirAngle: real;
- Timer : LongWord;
- Elasticity: Real;
- Friction : Real;
- Message : Longword;
- Hedgehog: pointer;
- Health, Damage: LongWord;
- CollIndex: Longword;
- Tag: Longword;
- end;
-
-function AddGear(X, Y: integer; Kind: TGearType; State: Cardinal; const dX: real=0.0; dY: real=0.0; Timer: LongWord=0): PGear;
-procedure ProcessGears;
-procedure SetAllToActive;
-procedure SetAllHHToActive;
-procedure DrawGears(Surface: PSDL_Surface);
-procedure FreeGearsList;
-procedure InitGears;
-procedure AssignHHCoords;
-
-var CurAmmoGear: PGear = nil;
-
-implementation
-uses uWorld, uMisc, uStore, uConsole, uSound, uTeams, uRandom, uCollisions, uLand;
-var GearsList: PGear = nil;
- RopePoints: record
- Count: Longword;
- HookAngle: integer;
- ar: array[0..300] of record
- X, Y: real;
- dLen: real;
- b: boolean;
- end;
- end;
-
-procedure DeleteGear(Gear: PGear); forward;
-procedure doMakeExplosion(X, Y, Radius: integer; Mask: LongWord); forward;
-
-{$INCLUDE GSHandlers.inc}
-{$INCLUDE HHHandlers.inc}
-
-const doStepHandlers: array[TGearType] of TGearStepProcedure = (
- doStepCloud,
- doStepBomb,
- doStepHedgehog,
- doStepGrenade,
- doStepHealthTag,
- doStepGrave,
- doStepUFO,
- doStepShotgunShot,
- doStepActionTimer,
- doStepPickHammer,
- doStepRope,
- doStepSmokeTrace
- );
-
-function AddGear(X, Y: integer; Kind: TGearType; State: Cardinal; const dX: real=0.0; dY: real=0.0; Timer: LongWord=0): PGear;
-begin
-{$IFDEF DEBUGFILE}AddFileLog('AddGear: ('+inttostr(x)+','+inttostr(y)+')');{$ENDIF}
-New(Result);
-{$IFDEF DEBUGFILE}AddFileLog('AddGear: handle = '+inttostr(integer(Result)));{$ENDIF}
-FillChar(Result^, sizeof(TGear), 0);
-Result.X:= X;
-Result.Y:= Y;
-Result.Kind := Kind;
-Result.State:= State;
-Result.Active:= true;
-Result.dX:= dX;
-Result.dY:= dY;
-Result.doStep:= doStepHandlers[Kind];
-Result.CollIndex:= High(Longword);
-if CurrentTeam <> nil then
- Result.Hedgehog:= @CurrentTeam.Hedgehogs[CurrentTeam.CurrHedgehog];
-case Kind of
- gtAmmo_Bomb: begin
- Result.HalfWidth:= 4;
- Result.HalfHeight:= 4;
- Result.Elasticity:= 0.6;
- Result.Friction:= 0.995;
- Result.Timer:= Timer
- end;
- gtHedgehog: begin
- Result.HalfWidth:= 6;
- Result.HalfHeight:= cHHHalfHeight;
- Result.Elasticity:= 0.002;
- Result.Friction:= 0.999;
- end;
-gtAmmo_Grenade: begin
- Result.HalfWidth:= 4;
- Result.HalfHeight:= 4;
- end;
- gtHealthTag: begin
- Result.Timer:= 1500;
- end;
- gtGrave: begin
- Result.HalfWidth:= 10;
- Result.HalfHeight:= 10;
- Result.Elasticity:= 0.6;
- end;
- gtUFO: begin
- Result.HalfWidth:= 5;
- Result.HalfHeight:= 2;
- Result.Timer:= 500;
- Result.Elasticity:= 0.9
- end;
- gtShotgunShot: begin
- Result.Timer:= 900;
- Result.HalfWidth:= 2;
- Result.HalfHeight:= 2
- end;
- gtActionTimer: begin
- Result.Timer:= Timer
- end;
- gtPickHammer: begin
- Result.HalfWidth:= 10;
- Result.HalfHeight:= 2;
- Result.Timer:= 4000
- end;
- gtSmokeTrace: begin
- Result.Tag:= 8
- end;
- gtRope: begin
- Result.HalfWidth:= 3;
- Result.HalfHeight:= 3;
- Result.Friction:= 500;
- RopePoints.Count:= 0;
- end;
- end;
-if GearsList = nil then GearsList:= Result
- else begin
- GearsList.PrevGear:= Result;
- Result.NextGear:= GearsList;
- GearsList:= Result
- end
-end;
-
-procedure DeleteGear(Gear: PGear);
-begin
-if Gear.CollIndex < High(Longword) then DeleteCR(Gear);
-if Gear.Kind = gtHedgehog then
- if CurAmmoGear <> nil then
- begin
- {$IFDEF DEBUGFILE}AddFileLog('DeleteGear: Sending gm_Destroy, hh handle = '+inttostr(integer(Gear)));{$ENDIF}
- Gear.Message:= gm_Destroy;
- CurAmmoGear.Message:= gm_Destroy;
- exit
- end else PHedgehog(Gear.Hedgehog).Gear:= nil;
-if CurAmmoGear = Gear then
- CurAmmoGear:= nil;
-if FollowGear = Gear then FollowGear:= nil;
-{$IFDEF DEBUGFILE}AddFileLog('DeleteGear: handle = '+inttostr(integer(Gear)));{$ENDIF}
-if Gear.NextGear <> nil then Gear.NextGear.PrevGear:= Gear.PrevGear;
-if Gear.PrevGear <> nil then Gear.PrevGear.NextGear:= Gear.NextGear
- else begin
- GearsList:= Gear^.NextGear;
- if GearsList <> nil then GearsList.PrevGear:= nil
- end;
-Dispose(Gear)
-end;
-
-function CheckNoDamage: boolean; // returns TRUE in case of no damaged hhs
-var Gear: PGear;
-begin
-Result:= true;
-Gear:= GearsList;
-while Gear <> nil do
- begin
- if Gear.Kind = gtHedgehog then
- if Gear.Damage <> 0 then
- begin
- Result:= false;
- if Gear.Health < Gear.Damage then Gear.Health:= 0
- else dec(Gear.Health, Gear.Damage);
- AddGear(Round(Gear.X), Round(Gear.Y) - 32, gtHealthTag, Gear.Damage).Hedgehog:= Gear.Hedgehog;
- RenderHealth(PHedgehog(Gear.Hedgehog)^);
-
- Gear.Damage:= 0
- end;
- Gear:= Gear.NextGear
- end;
-end;
-
-procedure ProcessGears;
-const delay: integer = cInactDelay;
-var Gear, t: PGear;
-{$IFDEF COUNTTICKS}
- tickcntA, tickcntB: LongWord;
-const cntSecTicks: LongWord = 0;
-{$ENDIF}
-begin
-{$IFDEF COUNTTICKS}
-asm
- push eax
- push edx
- rdtsc
- mov tickcntA, eax
- mov tickcntB, edx
- pop edx
- pop eax
-end;
-{$ENDIF}
-AllInactive:= true;
-t:= GearsList;
-while t<>nil do
- begin
- Gear:= t;
- t:= Gear.NextGear;
- if Gear.Active then Gear.doStep(Gear);
- end;
-if AllInactive then
- if (delay > 0)and not isInMultiShoot then
- begin
- if delay = cInactDelay then SetAllToActive;
- dec(delay)
- end
- else begin
- delay:= cInactDelay;
- if CheckNoDamage then
- if isInMultiShoot then isInMultiShoot:= false
- else ParseCommand('/nextturn');
- end;
-if TurnTimeLeft > 0 then
- if CurrentTeam <> nil then
- if CurrentTeam.Hedgehogs[CurrentTeam.CurrHedgehog].Gear <> nil then
- if ((CurrentTeam.Hedgehogs[CurrentTeam.CurrHedgehog].Gear.State and gstAttacking) = 0)
- and not isInMultiShoot then dec(TurnTimeLeft);
-inc(GameTicks);
-{$IFDEF COUNTTICKS}
-asm
- push eax
- push edx
- rdtsc
- sub eax, [tickcntA]
- sbb edx, [tickcntB]
- add [cntSecTicks], eax
- pop edx
- pop eax
-end;
-if (GameTicks and 1023) = 0 then
- begin
- cntTicks:= cntSecTicks shr 10;
- {$IFDEF DEBUGFILE}
- AddFileLog('<' + inttostr(cntTicks) + '>x1024 ticks');
- {$ENDIF}
- cntSecTicks:= 0
- end;
-{$ENDIF}
-end;
-
-procedure SetAllToActive;
-var t: PGear;
-begin
-AllInactive:= false;
-t:= GearsList;
-while t<>nil do
- begin
- t.Active:= true;
- t:= t.NextGear
- end
-end;
-
-procedure SetAllHHToActive;
-var t: PGear;
-begin
-AllInactive:= false;
-t:= GearsList;
-while t<>nil do
- begin
- if t.Kind = gtHedgehog then t.Active:= true;
- t:= t.NextGear
- end
-end;
-
-procedure DrawGears(Surface: PSDL_Surface);
-var Gear: PGear;
- i: Longword;
-
- procedure DrawRopeLine(X1, Y1, X2, Y2: integer);
- var i: integer;
- t, k: real;
- r: TSDL_Rect;
- begin
- if abs(X1 - X2) > abs(Y1 - Y2) then
- begin
- if X1 > X2 then
- begin
- i:= X1;
- X1:= X2;
- X2:= i;
- i:= Y1;
- Y1:= Y2;
- Y2:= i
- end;
- k:= (Y2 - Y1) / (X2 - X1);
- if X1 < 0 then
- begin
- t:= Y1 - 2 - k * X1;
- X1:= 0
- end else t:= Y1 - 2;
- if X2 > cScreenWidth then X2:= cScreenWidth;
- r.x:= X1;
- while r.x <= X2 do
- begin
- r.y:= round(t);
- r.w:= 4;
- r.h:= 4;
- SDL_FillRect(Surface, @r, cWhiteColor);
- t:= t + k*3;
- inc(r.x, 3)
- end;
- end else
- begin
- if Y1 > Y2 then
- begin
- i:= X1;
- X1:= X2;
- X2:= i;
- i:= Y1;
- Y1:= Y2;
- Y2:= i
- end;
- k:= (X2 - X1) / (Y2 - Y1);
- if Y1 < 0 then
- begin
- t:= X1 - 2 - k * Y1;
- Y1:= 0
- end else t:= X1 - 2;
- if Y2 > cScreenHeight then Y2:= cScreenHeight;
- r.y:= Y1;
- while r.y <= Y2 do
- begin
- r.x:= round(t);
- r.w:= 4;
- r.h:= 4;
- SDL_FillRect(Surface, @r, cWhiteColor);
- t:= t + k*3;
- inc(r.y, 3)
- end;
- end
- end;
-
-begin
-Gear:= GearsList;
-while Gear<>nil do
- begin
- case Gear.Kind of
- gtCloud: DrawSprite(sprCloud , Round(Gear.X) + WorldDx, Round(Gear.Y) + WorldDy, Gear.State, Surface);
- gtAmmo_Bomb: DrawSprite(sprBomb , Round(Gear.X) - 8 + WorldDx, Round(Gear.Y) - 8 + WorldDy, trunc(Gear.DirAngle), Surface);
- gtHedgehog: DrawHedgehog(Round(Gear.X) - 14 + WorldDx, Round(Gear.Y) - 18 + WorldDy, Sign(Gear.dX),
- 0, PHedgehog(Gear.Hedgehog).visStepPos div 2,
- Surface);
- gtAmmo_Grenade: DrawSprite(sprGrenade , Round(Gear.X) - 16 + WorldDx, Round(Gear.Y) - 16 + WorldDy, DxDy2Angle32(Gear.dY, Gear.dX), Surface);
- gtHealthTag: DrawCaption(Round(Gear.X) + WorldDx, Round(Gear.Y) + WorldDy, PHedgehog(Gear.Hedgehog).HealthTagRect, Surface, true);
- gtGrave: DrawSpriteFromRect(PHedgehog(Gear.Hedgehog).Team.GraveRect, Round(Gear.X) + WorldDx - 16, Round(Gear.Y) + WorldDy - 16, 32, (GameTicks shr 7) and 7, Surface);
- gtUFO: DrawSprite(sprUFO, Round(Gear.X) - 16 + WorldDx, Round(Gear.Y) - 16 + WorldDy, (GameTicks shr 7) mod 4, Surface);
- gtSmokeTrace: if Gear.Tag < 8 then DrawSprite(sprSmokeTrace, Round(Gear.X) - 16 + WorldDx, Round(Gear.Y) - 16 + WorldDy, Gear.Tag, Surface);
- gtRope: begin
- DrawRopeLine(Round(Gear.X) + WorldDx, Round(Gear.Y) + WorldDy,
- Round(PHedgehog(Gear.Hedgehog).Gear.X) + WorldDx, Round(PHedgehog(Gear.Hedgehog).Gear.Y) + WorldDy);
- if RopePoints.Count > 0 then
- begin
- i:= 0;
- while i < Pred(RopePoints.Count) do
- begin
- DrawRopeLine(Round(RopePoints.ar[i].X) + WorldDx, Round(RopePoints.ar[i].Y) + WorldDy,
- Round(RopePoints.ar[Succ(i)].X) + WorldDx, Round(RopePoints.ar[Succ(i)].Y) + WorldDy);
- inc(i)
- end;
- DrawRopeLine(Round(RopePoints.ar[i].X) + WorldDx, Round(RopePoints.ar[i].Y) + WorldDy,
- Round(Gear.X) + WorldDx, Round(Gear.Y) + WorldDy);
- DrawSprite(sprRopeHook, Round(RopePoints.ar[0].X) + WorldDx - 16, Round(RopePoints.ar[0].Y) + WorldDy - 16, RopePoints.HookAngle, Surface);
- end else
- DrawSprite(sprRopeHook, Round(Gear.X) - 16 + WorldDx, Round(Gear.Y) - 16 + WorldDy, DxDy2Angle32(Gear.dY, Gear.dX), Surface);
- end;
- end;
- Gear:= Gear.NextGear
- end;
-end;
-
-procedure FreeGearsList;
-var t, tt: PGear;
-begin
-tt:= GearsList;
-GearsList:= nil;
-while tt<>nil do
- begin
- t:= tt;
- tt:= tt.NextGear;
- try
- Dispose(t)
- except OutError(errmsgDynamicVar) end;
- end;
-end;
-
-procedure InitGears;
-var i: integer;
-begin
-for i:= 0 to cCloudsNumber do AddGear( - cScreenWidth + i * ((cScreenWidth * 2 + 2304) div cCloudsNumber), -128, gtCloud, random(4), (0.5-random)*0.01);
-AddGear(0, 0, gtActionTimer, gtsStartGame, 0, 0, 2000).Health:= 3;
-end;
-
-procedure doMakeExplosion(X, Y, Radius: integer; Mask: LongWord);
-var Gear: PGear;
- dmg: integer;
-begin
-TargetPoint.X:= NoPointX;
-{$IFDEF DEBUGFILE}if Radius > 3 then AddFileLog('Explosion: at (' + inttostr(x) + ',' + inttostr(y) + ')');{$ENDIF}
-DrawExplosion(X, Y, Radius);
-if (Mask and EXPLAutoSound)<>0 then PlaySound(sndExplosion);
-if (Mask and EXPLNoDamage)<>0 then exit;
-if (Mask and EXPLAllDamageInRadius)=0 then Radius:= Radius shl 1;
-Gear:= GearsList;
-while Gear <> nil do
- begin
- dmg:= Radius - Round(sqrt(sqr(Gear.X - X) + sqr(Gear.Y - Y)));
- if dmg > 0 then
- begin
- dmg:= dmg shr 1;
- case Gear.Kind of
- gtHedgehog: begin
- inc(Gear.Damage, dmg);
- Gear.dX:= Gear.dX + dmg / 200 * sign(Gear.X - X);
- Gear.dY:= Gear.dY + dmg / 200 * sign(Gear.Y - Y);
- FollowGear:= Gear
- end;
- gtGrave: Gear.dY:= - dmg / 250;
- end;
- end;
- Gear:= Gear.NextGear
- end
-end;
-
-procedure AssignHHCoords;
-var Gear: PGear;
- pX, pY: integer;
-begin
-Gear:= GearsList;
-while Gear <> nil do
- begin
- if Gear.Kind = gtHedgehog then
- begin
- GetHHPoint(pX, pY);
- Gear.X:= pX;
- Gear.Y:= pY
- end;
- Gear:= Gear.NextGear
- end
-end;
-
-initialization
-
-finalization
-FreeGearsList
-
-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 uGears;
+interface
+uses SDLh, uConsts;
+{$INCLUDE options.inc}
+const AllInactive: boolean = false;
+
+type PGear = ^TGear;
+ TGearStepProcedure = procedure (Gear: PGear);
+ TGear = record
+ NextGear, PrevGear: PGear;
+ Active: Boolean;
+ State : Cardinal;
+ X : Real;
+ Y : Real;
+ dX: Real;
+ dY: Real;
+ Kind : TGearType;
+ doStep: TGearStepProcedure;
+ HalfWidth, HalfHeight: integer;
+ Angle, Power : Cardinal;
+ DirAngle: real;
+ Timer : LongWord;
+ Elasticity: Real;
+ Friction : Real;
+ Message : Longword;
+ Hedgehog: pointer;
+ Health, Damage: LongWord;
+ CollIndex: Longword;
+ Tag: Longword;
+ end;
+
+function AddGear(X, Y: integer; Kind: TGearType; State: Cardinal; const dX: real=0.0; dY: real=0.0; Timer: LongWord=0): PGear;
+procedure ProcessGears;
+procedure SetAllToActive;
+procedure SetAllHHToActive;
+procedure DrawGears(Surface: PSDL_Surface);
+procedure FreeGearsList;
+procedure InitGears;
+procedure AssignHHCoords;
+
+var CurAmmoGear: PGear = nil;
+
+implementation
+uses uWorld, uMisc, uStore, uConsole, uSound, uTeams, uRandom, uCollisions, uLand;
+var GearsList: PGear = nil;
+ RopePoints: record
+ Count: Longword;
+ HookAngle: integer;
+ ar: array[0..300] of record
+ X, Y: real;
+ dLen: real;
+ b: boolean;
+ end;
+ end;
+
+procedure DeleteGear(Gear: PGear); forward;
+procedure doMakeExplosion(X, Y, Radius: integer; Mask: LongWord); forward;
+
+{$INCLUDE GSHandlers.inc}
+{$INCLUDE HHHandlers.inc}
+
+const doStepHandlers: array[TGearType] of TGearStepProcedure = (
+ doStepCloud,
+ doStepBomb,
+ doStepHedgehog,
+ doStepGrenade,
+ doStepHealthTag,
+ doStepGrave,
+ doStepUFO,
+ doStepShotgunShot,
+ doStepActionTimer,
+ doStepPickHammer,
+ doStepRope,
+ doStepSmokeTrace
+ );
+
+function AddGear(X, Y: integer; Kind: TGearType; State: Cardinal; const dX: real=0.0; dY: real=0.0; Timer: LongWord=0): PGear;
+begin
+{$IFDEF DEBUGFILE}AddFileLog('AddGear: ('+inttostr(x)+','+inttostr(y)+')');{$ENDIF}
+New(Result);
+{$IFDEF DEBUGFILE}AddFileLog('AddGear: handle = '+inttostr(integer(Result)));{$ENDIF}
+FillChar(Result^, sizeof(TGear), 0);
+Result.X:= X;
+Result.Y:= Y;
+Result.Kind := Kind;
+Result.State:= State;
+Result.Active:= true;
+Result.dX:= dX;
+Result.dY:= dY;
+Result.doStep:= doStepHandlers[Kind];
+Result.CollIndex:= High(Longword);
+if CurrentTeam <> nil then
+ Result.Hedgehog:= @CurrentTeam.Hedgehogs[CurrentTeam.CurrHedgehog];
+case Kind of
+ gtAmmo_Bomb: begin
+ Result.HalfWidth:= 4;
+ Result.HalfHeight:= 4;
+ Result.Elasticity:= 0.6;
+ Result.Friction:= 0.995;
+ Result.Timer:= Timer
+ end;
+ gtHedgehog: begin
+ Result.HalfWidth:= 6;
+ Result.HalfHeight:= cHHHalfHeight;
+ Result.Elasticity:= 0.002;
+ Result.Friction:= 0.999;
+ end;
+gtAmmo_Grenade: begin
+ Result.HalfWidth:= 4;
+ Result.HalfHeight:= 4;
+ end;
+ gtHealthTag: begin
+ Result.Timer:= 1500;
+ end;
+ gtGrave: begin
+ Result.HalfWidth:= 10;
+ Result.HalfHeight:= 10;
+ Result.Elasticity:= 0.6;
+ end;
+ gtUFO: begin
+ Result.HalfWidth:= 5;
+ Result.HalfHeight:= 2;
+ Result.Timer:= 500;
+ Result.Elasticity:= 0.9
+ end;
+ gtShotgunShot: begin
+ Result.Timer:= 900;
+ Result.HalfWidth:= 2;
+ Result.HalfHeight:= 2
+ end;
+ gtActionTimer: begin
+ Result.Timer:= Timer
+ end;
+ gtPickHammer: begin
+ Result.HalfWidth:= 10;
+ Result.HalfHeight:= 2;
+ Result.Timer:= 4000
+ end;
+ gtSmokeTrace: begin
+ Result.Tag:= 8
+ end;
+ gtRope: begin
+ Result.HalfWidth:= 3;
+ Result.HalfHeight:= 3;
+ Result.Friction:= 500;
+ RopePoints.Count:= 0;
+ end;
+ end;
+if GearsList = nil then GearsList:= Result
+ else begin
+ GearsList.PrevGear:= Result;
+ Result.NextGear:= GearsList;
+ GearsList:= Result
+ end
+end;
+
+procedure DeleteGear(Gear: PGear);
+begin
+if Gear.CollIndex < High(Longword) then DeleteCR(Gear);
+if Gear.Kind = gtHedgehog then
+ if CurAmmoGear <> nil then
+ begin
+ {$IFDEF DEBUGFILE}AddFileLog('DeleteGear: Sending gm_Destroy, hh handle = '+inttostr(integer(Gear)));{$ENDIF}
+ Gear.Message:= gm_Destroy;
+ CurAmmoGear.Message:= gm_Destroy;
+ exit
+ end else PHedgehog(Gear.Hedgehog).Gear:= nil;
+if CurAmmoGear = Gear then
+ CurAmmoGear:= nil;
+if FollowGear = Gear then FollowGear:= nil;
+{$IFDEF DEBUGFILE}AddFileLog('DeleteGear: handle = '+inttostr(integer(Gear)));{$ENDIF}
+if Gear.NextGear <> nil then Gear.NextGear.PrevGear:= Gear.PrevGear;
+if Gear.PrevGear <> nil then Gear.PrevGear.NextGear:= Gear.NextGear
+ else begin
+ GearsList:= Gear^.NextGear;
+ if GearsList <> nil then GearsList.PrevGear:= nil
+ end;
+Dispose(Gear)
+end;
+
+function CheckNoDamage: boolean; // returns TRUE in case of no damaged hhs
+var Gear: PGear;
+begin
+Result:= true;
+Gear:= GearsList;
+while Gear <> nil do
+ begin
+ if Gear.Kind = gtHedgehog then
+ if Gear.Damage <> 0 then
+ begin
+ Result:= false;
+ if Gear.Health < Gear.Damage then Gear.Health:= 0
+ else dec(Gear.Health, Gear.Damage);
+ AddGear(Round(Gear.X), Round(Gear.Y) - 32, gtHealthTag, Gear.Damage).Hedgehog:= Gear.Hedgehog;
+ RenderHealth(PHedgehog(Gear.Hedgehog)^);
+
+ Gear.Damage:= 0
+ end;
+ Gear:= Gear.NextGear
+ end;
+end;
+
+procedure ProcessGears;
+const delay: integer = cInactDelay;
+var Gear, t: PGear;
+{$IFDEF COUNTTICKS}
+ tickcntA, tickcntB: LongWord;
+const cntSecTicks: LongWord = 0;
+{$ENDIF}
+begin
+{$IFDEF COUNTTICKS}
+asm
+ push eax
+ push edx
+ rdtsc
+ mov tickcntA, eax
+ mov tickcntB, edx
+ pop edx
+ pop eax
+end;
+{$ENDIF}
+AllInactive:= true;
+t:= GearsList;
+while t<>nil do
+ begin
+ Gear:= t;
+ t:= Gear.NextGear;
+ if Gear.Active then Gear.doStep(Gear);
+ end;
+if AllInactive then
+ if (delay > 0)and not isInMultiShoot then
+ begin
+ if delay = cInactDelay then SetAllToActive;
+ dec(delay)
+ end
+ else begin
+ delay:= cInactDelay;
+ if CheckNoDamage then
+ if isInMultiShoot then isInMultiShoot:= false
+ else ParseCommand('/nextturn');
+ end;
+if TurnTimeLeft > 0 then
+ if CurrentTeam <> nil then
+ if CurrentTeam.Hedgehogs[CurrentTeam.CurrHedgehog].Gear <> nil then
+ if ((CurrentTeam.Hedgehogs[CurrentTeam.CurrHedgehog].Gear.State and gstAttacking) = 0)
+ and not isInMultiShoot then dec(TurnTimeLeft);
+inc(GameTicks);
+{$IFDEF COUNTTICKS}
+asm
+ push eax
+ push edx
+ rdtsc
+ sub eax, [tickcntA]
+ sbb edx, [tickcntB]
+ add [cntSecTicks], eax
+ pop edx
+ pop eax
+end;
+if (GameTicks and 1023) = 0 then
+ begin
+ cntTicks:= cntSecTicks shr 10;
+ {$IFDEF DEBUGFILE}
+ AddFileLog('<' + inttostr(cntTicks) + '>x1024 ticks');
+ {$ENDIF}
+ cntSecTicks:= 0
+ end;
+{$ENDIF}
+end;
+
+procedure SetAllToActive;
+var t: PGear;
+begin
+AllInactive:= false;
+t:= GearsList;
+while t<>nil do
+ begin
+ t.Active:= true;
+ t:= t.NextGear
+ end
+end;
+
+procedure SetAllHHToActive;
+var t: PGear;
+begin
+AllInactive:= false;
+t:= GearsList;
+while t<>nil do
+ begin
+ if t.Kind = gtHedgehog then t.Active:= true;
+ t:= t.NextGear
+ end
+end;
+
+procedure DrawGears(Surface: PSDL_Surface);
+var Gear: PGear;
+ i: Longword;
+
+ procedure DrawRopeLine(X1, Y1, X2, Y2: integer);
+ var i: integer;
+ t, k: real;
+ r: TSDL_Rect;
+ begin
+ if abs(X1 - X2) > abs(Y1 - Y2) then
+ begin
+ if X1 > X2 then
+ begin
+ i:= X1;
+ X1:= X2;
+ X2:= i;
+ i:= Y1;
+ Y1:= Y2;
+ Y2:= i
+ end;
+ k:= (Y2 - Y1) / (X2 - X1);
+ if X1 < 0 then
+ begin
+ t:= Y1 - 2 - k * X1;
+ X1:= 0
+ end else t:= Y1 - 2;
+ if X2 > cScreenWidth then X2:= cScreenWidth;
+ r.x:= X1;
+ while r.x <= X2 do
+ begin
+ r.y:= round(t);
+ r.w:= 4;
+ r.h:= 4;
+ SDL_FillRect(Surface, @r, cWhiteColor);
+ t:= t + k*3;
+ inc(r.x, 3)
+ end;
+ end else
+ begin
+ if Y1 > Y2 then
+ begin
+ i:= X1;
+ X1:= X2;
+ X2:= i;
+ i:= Y1;
+ Y1:= Y2;
+ Y2:= i
+ end;
+ k:= (X2 - X1) / (Y2 - Y1);
+ if Y1 < 0 then
+ begin
+ t:= X1 - 2 - k * Y1;
+ Y1:= 0
+ end else t:= X1 - 2;
+ if Y2 > cScreenHeight then Y2:= cScreenHeight;
+ r.y:= Y1;
+ while r.y <= Y2 do
+ begin
+ r.x:= round(t);
+ r.w:= 4;
+ r.h:= 4;
+ SDL_FillRect(Surface, @r, cWhiteColor);
+ t:= t + k*3;
+ inc(r.y, 3)
+ end;
+ end
+ end;
+
+begin
+Gear:= GearsList;
+while Gear<>nil do
+ begin
+ case Gear.Kind of
+ gtCloud: DrawSprite(sprCloud , Round(Gear.X) + WorldDx, Round(Gear.Y) + WorldDy, Gear.State, Surface);
+ gtAmmo_Bomb: DrawSprite(sprBomb , Round(Gear.X) - 8 + WorldDx, Round(Gear.Y) - 8 + WorldDy, trunc(Gear.DirAngle), Surface);
+ gtHedgehog: DrawHedgehog(Round(Gear.X) - 14 + WorldDx, Round(Gear.Y) - 18 + WorldDy, Sign(Gear.dX),
+ 0, PHedgehog(Gear.Hedgehog).visStepPos div 2,
+ Surface);
+ gtAmmo_Grenade: DrawSprite(sprGrenade , Round(Gear.X) - 16 + WorldDx, Round(Gear.Y) - 16 + WorldDy, DxDy2Angle32(Gear.dY, Gear.dX), Surface);
+ gtHealthTag: DrawCaption(Round(Gear.X) + WorldDx, Round(Gear.Y) + WorldDy, PHedgehog(Gear.Hedgehog).HealthTagRect, Surface, true);
+ gtGrave: DrawSpriteFromRect(PHedgehog(Gear.Hedgehog).Team.GraveRect, Round(Gear.X) + WorldDx - 16, Round(Gear.Y) + WorldDy - 16, 32, (GameTicks shr 7) and 7, Surface);
+ gtUFO: DrawSprite(sprUFO, Round(Gear.X) - 16 + WorldDx, Round(Gear.Y) - 16 + WorldDy, (GameTicks shr 7) mod 4, Surface);
+ gtSmokeTrace: if Gear.Tag < 8 then DrawSprite(sprSmokeTrace, Round(Gear.X) - 16 + WorldDx, Round(Gear.Y) - 16 + WorldDy, Gear.Tag, Surface);
+ gtRope: begin
+ DrawRopeLine(Round(Gear.X) + WorldDx, Round(Gear.Y) + WorldDy,
+ Round(PHedgehog(Gear.Hedgehog).Gear.X) + WorldDx, Round(PHedgehog(Gear.Hedgehog).Gear.Y) + WorldDy);
+ if RopePoints.Count > 0 then
+ begin
+ i:= 0;
+ while i < Pred(RopePoints.Count) do
+ begin
+ DrawRopeLine(Round(RopePoints.ar[i].X) + WorldDx, Round(RopePoints.ar[i].Y) + WorldDy,
+ Round(RopePoints.ar[Succ(i)].X) + WorldDx, Round(RopePoints.ar[Succ(i)].Y) + WorldDy);
+ inc(i)
+ end;
+ DrawRopeLine(Round(RopePoints.ar[i].X) + WorldDx, Round(RopePoints.ar[i].Y) + WorldDy,
+ Round(Gear.X) + WorldDx, Round(Gear.Y) + WorldDy);
+ DrawSprite(sprRopeHook, Round(RopePoints.ar[0].X) + WorldDx - 16, Round(RopePoints.ar[0].Y) + WorldDy - 16, RopePoints.HookAngle, Surface);
+ end else
+ DrawSprite(sprRopeHook, Round(Gear.X) - 16 + WorldDx, Round(Gear.Y) - 16 + WorldDy, DxDy2Angle32(Gear.dY, Gear.dX), Surface);
+ end;
+ end;
+ Gear:= Gear.NextGear
+ end;
+end;
+
+procedure FreeGearsList;
+var t, tt: PGear;
+begin
+tt:= GearsList;
+GearsList:= nil;
+while tt<>nil do
+ begin
+ t:= tt;
+ tt:= tt.NextGear;
+ try
+ Dispose(t)
+ except OutError(errmsgDynamicVar) end;
+ end;
+end;
+
+procedure InitGears;
+var i: integer;
+begin
+for i:= 0 to cCloudsNumber do AddGear( - cScreenWidth + i * ((cScreenWidth * 2 + 2304) div cCloudsNumber), -128, gtCloud, random(4), (0.5-random)*0.01);
+AddGear(0, 0, gtActionTimer, gtsStartGame, 0, 0, 2000).Health:= 3;
+end;
+
+procedure doMakeExplosion(X, Y, Radius: integer; Mask: LongWord);
+var Gear: PGear;
+ dmg: integer;
+begin
+TargetPoint.X:= NoPointX;
+{$IFDEF DEBUGFILE}if Radius > 3 then AddFileLog('Explosion: at (' + inttostr(x) + ',' + inttostr(y) + ')');{$ENDIF}
+DrawExplosion(X, Y, Radius);
+if (Mask and EXPLAutoSound)<>0 then PlaySound(sndExplosion);
+if (Mask and EXPLNoDamage)<>0 then exit;
+if (Mask and EXPLAllDamageInRadius)=0 then Radius:= Radius shl 1;
+Gear:= GearsList;
+while Gear <> nil do
+ begin
+ dmg:= Radius - Round(sqrt(sqr(Gear.X - X) + sqr(Gear.Y - Y)));
+ if dmg > 0 then
+ begin
+ dmg:= dmg shr 1;
+ case Gear.Kind of
+ gtHedgehog: begin
+ inc(Gear.Damage, dmg);
+ Gear.dX:= Gear.dX + dmg / 200 * sign(Gear.X - X);
+ Gear.dY:= Gear.dY + dmg / 200 * sign(Gear.Y - Y);
+ FollowGear:= Gear
+ end;
+ gtGrave: Gear.dY:= - dmg / 250;
+ end;
+ end;
+ Gear:= Gear.NextGear
+ end
+end;
+
+procedure AssignHHCoords;
+var Gear: PGear;
+ pX, pY: integer;
+begin
+Gear:= GearsList;
+while Gear <> nil do
+ begin
+ if Gear.Kind = gtHedgehog then
+ begin
+ GetHHPoint(pX, pY);
+ Gear.X:= pX;
+ Gear.Y:= pY
+ end;
+ Gear:= Gear.NextGear
+ end
+end;
+
+initialization
+
+finalization
+FreeGearsList
+
+end.
--- a/hedgewars/uIO.pas Mon Aug 22 21:38:06 2005 +0000
+++ b/hedgewars/uIO.pas Tue Aug 23 16:17:53 2005 +0000
@@ -1,208 +1,249 @@
-(*
- * 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 uIO;
-interface
-uses SDLh;
-{$INCLUDE options.inc}
-
-const ipcPort: Word = 0;
-
-procedure SendIPC(s: shortstring);
-procedure SendIPCAndWaitReply(s: shortstring);
-procedure IPCCheckSock;
-procedure InitIPC;
-procedure CloseIPC;
-procedure NetGetNextCmd;
-
-implementation
-uses uConsole, uConsts, uWorld, uMisc;
-const isPonged: boolean = false;
-var IPCSock: PTCPSocket;
- fds: PSDLNet_SocketSet;
-
- extcmd: array[word] of packed record
- Time: LongWord;
- case byte of
- 1: (len: byte;
- cmd: Char;
- X, Y: integer;);
- 2: (str: shortstring);
- end;
- cmdcurpos: integer = 0;
- cmdendpos: integer = -1;
-
-procedure InitIPC;
-var ipaddr: TIPAddress;
-begin
-WriteToConsole('Init SDL_Net... ');
-SDLTry(SDLNet_Init = 0, true);
-fds:= SDLNet_AllocSocketSet(1);
-SDLTry(fds <> nil, true);
-WriteLnToConsole(msgOK);
-WriteToConsole('Establishing IPC connection... ');
-SDLTry(SDLNet_ResolveHost(ipaddr, '127.0.0.1', ipcPort) = 0, true);
-IPCSock:= SDLNet_TCP_Open(ipaddr);
-SDLTry(IPCSock <> nil, true);
-WriteLnToConsole(msgOK)
-end;
-
-procedure CloseIPC;
-begin
-SDLNet_FreeSocketSet(fds);
-SDLNet_TCP_Close(IPCSock);
-SDLNet_Quit
-end;
-
-procedure ParseIPCCommand(s: shortstring);
-begin
-case s[1] of
- '!': isPonged:= true;
- '?': SendIPC('!');
- 'e': ParseCommand(copy(s, 2, Length(s) - 1));
- 'E': OutError(copy(s, 2, Length(s) - 1), true);
- 'W': OutError(copy(s, 2, Length(s) - 1), false);
- 'T': case s[2] of
- 'L': GameType:= gmtLocal;
- 'D': GameType:= gmtDemo;
- 'N': GameType:= gmtNet;
- else OutError(errmsgIncorrectUse + ' IPC "T" :' + s[2], true) end;
- else
- inc(cmdendpos);
- extcmd[cmdendpos].Time := PLongWord(@s[byte(s[0]) - 3])^;
- extcmd[cmdendpos].str := s;
- {$IFDEF DEBUGFILE}AddFileLog('IPC in: '+s[1]+' ticks '+inttostr(extcmd[cmdendpos].Time)+' at '+inttostr(cmdendpos));{$ENDIF}
- dec(extcmd[cmdendpos].len, 4)
- end
-end;
-
-procedure IPCCheckSock;
-const ss: string = '';
-var i: integer;
- buf: array[0..255] of byte;
- s: shortstring absolute buf;
-begin
-fds.numsockets:= 0;
-SDLNet_AddSocket(fds, IPCSock);
-
-while SDLNet_CheckSockets(fds, 0) > 0 do
- begin
- i:= SDLNet_TCP_Recv(IPCSock, @buf[1], 255);
- if i > 0 then
- begin
- buf[0]:= i;
- ss:= ss + s;
- while (Length(ss) > 1)and(Length(ss) > byte(ss[1])) do
- begin
- ParseIPCCommand(copy(ss, 2, byte(ss[1])));
- Delete(ss, 1, Succ(byte(ss[1])))
- end
- end else OutError('IPC connection lost', true)
- end;
-end;
-
-procedure SendIPC(s: shortstring);
-begin
-//WriteLnToConsole(s);
-if s[0]>#251 then s[0]:= #251;
-PLongWord(@s[Succ(byte(s[0]))])^:= GameTicks;
-{$IFDEF DEBUGFILE}AddFileLog('IPC send: '+s);{$ENDIF}
-inc(s[0],4);
-SDLNet_TCP_Send(IPCSock, @s, Succ(byte(s[0])))
-end;
-
-procedure SendIPCAndWaitReply(s: shortstring);
-begin
-SendIPC(s);
-s:= '?';
-SDLNet_TCP_Send(IPCSock, @s, Succ(byte(s[0])));
-isPonged:= false;
-repeat
- IPCCheckSock;
- SDL_Delay(1)
-until isPonged
-end;
-
-procedure NetGetNextCmd;
-var tmpflag: boolean;
-begin
-while (cmdcurpos <= cmdendpos)and(extcmd[cmdcurpos].cmd = 's') do
- begin
- WriteLnToConsole('> ' + copy(extcmd[cmdcurpos].str, 2, Pred(extcmd[cmdcurpos].len)));
- AddCaption('> ' + copy(extcmd[cmdcurpos].str, 2, Pred(extcmd[cmdcurpos].len)), $FFFFFF, capgrpNetSay);
- inc(cmdcurpos)
- end;
-
-if cmdcurpos <= cmdendpos then
- if GameTicks > extcmd[cmdcurpos].Time then
- outerror('oops, queue error. in buffer: '+extcmd[cmdcurpos].cmd+' ('+inttostr(GameTicks)+' > '+inttostr(extcmd[cmdcurpos].Time)+')', true);
-
-tmpflag:= true;
-while (cmdcurpos <= cmdendpos)and(GameTicks = extcmd[cmdcurpos].Time) do
- begin
- case extcmd[cmdcurpos].cmd of
- 'L': ParseCommand('/+left');
- 'l': ParseCommand('/-left');
- 'R': ParseCommand('/+right');
- 'r': ParseCommand('/-right');
- 'U': ParseCommand('/+up');
- 'u': ParseCommand('/-up');
- 'D': ParseCommand('/+down');
- 'd': ParseCommand('/-down');
- 'A': ParseCommand('/+attack');
- 'a': ParseCommand('/-attack');
- 'S': ParseCommand('/switch');
- 'j': ParseCommand('/ljump');
- 'J': ParseCommand('/hjump');
- 'N': begin
- tmpflag:= false;
- {$IFDEF DEBUGFILE}AddFileLog('got cmd "N": time '+inttostr(extcmd[cmdcurpos].Time)){$ENDIF}
- end;
- 'p': begin
- TargetPoint.X:= extcmd[cmdcurpos].X;
- TargetPoint.Y:= extcmd[cmdcurpos].Y;
- ParseCommand('/put')
- end;
- 'P': begin
- CursorPoint.X:= extcmd[cmdcurpos].X + WorldDx;
- CursorPoint.Y:= extcmd[cmdcurpos].Y + WorldDy;
- end;
- '1'..'5': ParseCommand('/timer ' + extcmd[cmdcurpos].cmd);
- #128..#131: ParseCommand('/slot ' + char(byte(extcmd[cmdcurpos].cmd) - 79))
- end;
- inc(cmdcurpos)
- end;
-isInLag:= (cmdcurpos > cmdendpos) and tmpflag
-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 uIO;
+interface
+uses SDLh;
+{$INCLUDE options.inc}
+
+const ipcPort: Word = 0;
+
+procedure SendIPC(s: shortstring);
+procedure SendIPCAndWaitReply(s: shortstring);
+procedure IPCCheckSock;
+procedure InitIPC;
+procedure CloseIPC;
+procedure NetGetNextCmd;
+procedure LoadFortPoints(Fort: shortstring; isRight: boolean; Count: Longword);
+
+implementation
+uses uConsole, uConsts, uWorld, uMisc, uRandom, uLand;
+const isPonged: boolean = false;
+var IPCSock: PTCPSocket;
+ fds: PSDLNet_SocketSet;
+
+ extcmd: array[word] of packed record
+ Time: LongWord;
+ case byte of
+ 1: (len: byte;
+ cmd: Char;
+ X, Y: integer;);
+ 2: (str: shortstring);
+ end;
+ cmdcurpos: integer = 0;
+ cmdendpos: integer = -1;
+
+procedure InitIPC;
+var ipaddr: TIPAddress;
+begin
+WriteToConsole('Init SDL_Net... ');
+SDLTry(SDLNet_Init = 0, true);
+fds:= SDLNet_AllocSocketSet(1);
+SDLTry(fds <> nil, true);
+WriteLnToConsole(msgOK);
+WriteToConsole('Establishing IPC connection... ');
+SDLTry(SDLNet_ResolveHost(ipaddr, '127.0.0.1', ipcPort) = 0, true);
+IPCSock:= SDLNet_TCP_Open(ipaddr);
+SDLTry(IPCSock <> nil, true);
+WriteLnToConsole(msgOK)
+end;
+
+procedure CloseIPC;
+begin
+SDLNet_FreeSocketSet(fds);
+SDLNet_TCP_Close(IPCSock);
+SDLNet_Quit
+end;
+
+procedure ParseIPCCommand(s: shortstring);
+begin
+case s[1] of
+ '!': isPonged:= true;
+ '?': SendIPC('!');
+ 'e': ParseCommand(copy(s, 2, Length(s) - 1));
+ 'E': OutError(copy(s, 2, Length(s) - 1), true);
+ 'W': OutError(copy(s, 2, Length(s) - 1), false);
+ 'T': case s[2] of
+ 'L': GameType:= gmtLocal;
+ 'D': GameType:= gmtDemo;
+ 'N': GameType:= gmtNet;
+ else OutError(errmsgIncorrectUse + ' IPC "T" :' + s[2], true) end;
+ else
+ inc(cmdendpos);
+ extcmd[cmdendpos].Time := PLongWord(@s[byte(s[0]) - 3])^;
+ extcmd[cmdendpos].str := s;
+ {$IFDEF DEBUGFILE}AddFileLog('IPC in: '+s[1]+' ticks '+inttostr(extcmd[cmdendpos].Time)+' at '+inttostr(cmdendpos));{$ENDIF}
+ dec(extcmd[cmdendpos].len, 4)
+ end
+end;
+
+procedure IPCCheckSock;
+const ss: string = '';
+var i: integer;
+ buf: array[0..255] of byte;
+ s: shortstring absolute buf;
+begin
+fds.numsockets:= 0;
+SDLNet_AddSocket(fds, IPCSock);
+
+while SDLNet_CheckSockets(fds, 0) > 0 do
+ begin
+ i:= SDLNet_TCP_Recv(IPCSock, @buf[1], 255);
+ if i > 0 then
+ begin
+ buf[0]:= i;
+ ss:= ss + s;
+ while (Length(ss) > 1)and(Length(ss) > byte(ss[1])) do
+ begin
+ ParseIPCCommand(copy(ss, 2, byte(ss[1])));
+ Delete(ss, 1, Succ(byte(ss[1])))
+ end
+ end else OutError('IPC connection lost', true)
+ end;
+end;
+
+procedure SendIPC(s: shortstring);
+begin
+//WriteLnToConsole(s);
+if s[0]>#251 then s[0]:= #251;
+PLongWord(@s[Succ(byte(s[0]))])^:= GameTicks;
+{$IFDEF DEBUGFILE}AddFileLog('IPC send: '+s);{$ENDIF}
+inc(s[0],4);
+SDLNet_TCP_Send(IPCSock, @s, Succ(byte(s[0])))
+end;
+
+procedure SendIPCAndWaitReply(s: shortstring);
+begin
+SendIPC(s);
+s:= '?';
+SDLNet_TCP_Send(IPCSock, @s, Succ(byte(s[0])));
+isPonged:= false;
+repeat
+ IPCCheckSock;
+ SDL_Delay(1)
+until isPonged
+end;
+
+procedure NetGetNextCmd;
+var tmpflag: boolean;
+begin
+while (cmdcurpos <= cmdendpos)and(extcmd[cmdcurpos].cmd = 's') do
+ begin
+ WriteLnToConsole('> ' + copy(extcmd[cmdcurpos].str, 2, Pred(extcmd[cmdcurpos].len)));
+ AddCaption('> ' + copy(extcmd[cmdcurpos].str, 2, Pred(extcmd[cmdcurpos].len)), $FFFFFF, capgrpNetSay);
+ inc(cmdcurpos)
+ end;
+
+if cmdcurpos <= cmdendpos then
+ if GameTicks > extcmd[cmdcurpos].Time then
+ outerror('oops, queue error. in buffer: '+extcmd[cmdcurpos].cmd+' ('+inttostr(GameTicks)+' > '+inttostr(extcmd[cmdcurpos].Time)+')', true);
+
+tmpflag:= true;
+while (cmdcurpos <= cmdendpos)and(GameTicks = extcmd[cmdcurpos].Time) do
+ begin
+ case extcmd[cmdcurpos].cmd of
+ 'L': ParseCommand('/+left');
+ 'l': ParseCommand('/-left');
+ 'R': ParseCommand('/+right');
+ 'r': ParseCommand('/-right');
+ 'U': ParseCommand('/+up');
+ 'u': ParseCommand('/-up');
+ 'D': ParseCommand('/+down');
+ 'd': ParseCommand('/-down');
+ 'A': ParseCommand('/+attack');
+ 'a': ParseCommand('/-attack');
+ 'S': ParseCommand('/switch');
+ 'j': ParseCommand('/ljump');
+ 'J': ParseCommand('/hjump');
+ 'N': begin
+ tmpflag:= false;
+ {$IFDEF DEBUGFILE}AddFileLog('got cmd "N": time '+inttostr(extcmd[cmdcurpos].Time)){$ENDIF}
+ end;
+ 'p': begin
+ TargetPoint.X:= extcmd[cmdcurpos].X;
+ TargetPoint.Y:= extcmd[cmdcurpos].Y;
+ ParseCommand('/put')
+ end;
+ 'P': begin
+ CursorPoint.X:= extcmd[cmdcurpos].X + WorldDx;
+ CursorPoint.Y:= extcmd[cmdcurpos].Y + WorldDy;
+ end;
+ '1'..'5': ParseCommand('/timer ' + extcmd[cmdcurpos].cmd);
+ #128..#131: ParseCommand('/slot ' + char(byte(extcmd[cmdcurpos].cmd) - 79))
+ end;
+ inc(cmdcurpos)
+ end;
+isInLag:= (cmdcurpos > cmdendpos) and tmpflag
+end;
+
+procedure LoadFortPoints(Fort: shortstring; isRight: boolean; Count: Longword);
+const cMAXFORTPOINTS = 20;
+var f: textfile;
+ i, t: integer;
+ cnt: Longword;
+ ar: array[0..Pred(cMAXFORTPOINTS)] of TPoint;
+ p: TPoint;
+begin
+if isRight then Fort:= Pathz[ptForts] + Fort + 'R.txt'
+ else Fort:= Pathz[ptForts] + Fort + 'L.txt';
+WriteToConsole(msgLoading + Fort + ' ');
+{$I-}
+AssignFile(f, Fort);
+Reset(f);
+cnt:= 0;
+while not (eof(f) or (cnt = cMAXFORTPOINTS)) do
+ begin
+ Readln(f, ar[cnt].x, ar[cnt].y);
+ if isRight then inc(ar[cnt].x, 1024);
+ inc(cnt);
+ end;
+Closefile(f);
+{$I+}
+TryDo(IOResult = 0, msgFailed, true);
+WriteLnToConsole(msgOK);
+TryDo(Count < cnt, 'Fort doesn''t contain needed spawn points', true);
+for i:= 0 to Pred(cnt) do
+ begin
+ t:= GetRandom(cnt);
+ if i <> t then
+ begin
+ p:= ar[i];
+ ar[i]:= ar[t];
+ ar[t]:= p
+ end
+ end;
+for i:= 0 to Pred(Count) do
+ AddHHPoint(ar[i].x, ar[i].y);
+end;
+
+end.
--- a/hedgewars/uKeys.pas Mon Aug 22 21:38:06 2005 +0000
+++ b/hedgewars/uKeys.pas Tue Aug 23 16:17:53 2005 +0000
@@ -1,128 +1,128 @@
-(*
- * 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 uKeys;
-interface
-{$INCLUDE options.inc}
-
-function KeyNameToCode(name: string): word;
-procedure ProcessKbd;
-procedure ResetKbd;
-procedure ProcessKbdDemo;
-procedure InitKbdKeyTable;
-
-implementation
-uses SDLh, uTeams, uConsole, uConsts, uMisc;
-
-type TKeyboardState = array[0..322] of Byte;
-var tkbd: TKeyboardState;
- KeyNames: array [0..cKeyMaxIndex] of string[15];
-
-function KeyNameToCode(name: string): word;
-begin
-Result:= cKeyMaxIndex;
-while (Result>0)and(KeyNames[Result]<>name) do dec(Result)
-end;
-
-procedure ProcessKbd;
-var i: integer;
- s: shortstring;
- pkbd: PByteArray;
-begin
-if (CurrentTeam = nil)
- or (CurrentTeam.ExtDriven)
- or (CurrentTeam.Hedgehogs[CurrentTeam.CurrHedgehog].BotLevel <> 0) then exit;
-pkbd:= SDL_GetKeyState(nil);
-i:= SDL_GetMouseState(nil, nil);
-pkbd^[1]:= (i and 1);
-pkbd^[2]:= ((i shl 1) and 1);
-pkbd^[3]:= ((i shl 2) and 1);
-for i:= 1 to cKeyMaxIndex do
- if CurrentTeam.Aliases[i][0]<>#0 then
- begin
- if CurrentTeam.Aliases[i][1]='+' then
- begin
- if (pkbd^[i] <> 0)and(tkbd[i] = 0) then ParseCommand(CurrentTeam.Aliases[i]) else
- if (pkbd^[i] = 0)and(tkbd[i] <> 0) then
- begin
- s:= CurrentTeam.Aliases[i];
- s[1]:= '-';
- ParseCommand(s)
- end;
- end else
- if (tkbd[i] = 0) and (pkbd^[i] <> 0) then ParseCommand(CurrentTeam.Aliases[i]);
- tkbd[i]:= pkbd^[i]
- end
-end;
-
-procedure ProcessKbdDemo;
-var pkbd: PByteArray;
-begin
-pkbd:= PByteArray(SDL_GetKeyState(nil));
-if pkbd^[27] <> 0 then
- begin
- ParseCommand('/quit');
- end;
-end;
-
-procedure ResetKbd;
-var i, t: integer;
- pkbd: PByteArray;
-begin
-pkbd:= PByteArray(SDL_GetKeyState(@i));
-for t:= 0 to Pred(i) do
- tkbd[i]:= pkbd^[i]
-end;
-
-procedure InitKbdKeyTable;
-var i, t: integer;
- s: string[15];
-begin
-KeyNames[1]:= 'mousel';
-KeyNames[2]:= 'mousem';
-KeyNames[3]:= 'mouser';
-for i:= 4 to cKeyMaxIndex do
- begin
- s:= SDL_GetKeyName(i);
- if s = 'unknown key' then KeyNames[i]:= ''
- else begin
- for t:= 1 to Length(s) do
- if s[t] = ' ' then s[t]:= '_';
- KeyNames[i]:= s
- end;
- end
-end;
-
-initialization
-
-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 uKeys;
+interface
+{$INCLUDE options.inc}
+
+function KeyNameToCode(name: string): word;
+procedure ProcessKbd;
+procedure ResetKbd;
+procedure ProcessKbdDemo;
+procedure InitKbdKeyTable;
+
+implementation
+uses SDLh, uTeams, uConsole, uConsts, uMisc;
+
+type TKeyboardState = array[0..322] of Byte;
+var tkbd: TKeyboardState;
+ KeyNames: array [0..cKeyMaxIndex] of string[15];
+
+function KeyNameToCode(name: string): word;
+begin
+Result:= cKeyMaxIndex;
+while (Result>0)and(KeyNames[Result]<>name) do dec(Result)
+end;
+
+procedure ProcessKbd;
+var i: integer;
+ s: shortstring;
+ pkbd: PByteArray;
+begin
+if (CurrentTeam = nil)
+ or (CurrentTeam.ExtDriven)
+ or (CurrentTeam.Hedgehogs[CurrentTeam.CurrHedgehog].BotLevel <> 0) then exit;
+pkbd:= SDL_GetKeyState(nil);
+i:= SDL_GetMouseState(nil, nil);
+pkbd^[1]:= (i and 1);
+pkbd^[2]:= ((i shl 1) and 1);
+pkbd^[3]:= ((i shl 2) and 1);
+for i:= 1 to cKeyMaxIndex do
+ if CurrentTeam.Aliases[i][0]<>#0 then
+ begin
+ if CurrentTeam.Aliases[i][1]='+' then
+ begin
+ if (pkbd^[i] <> 0)and(tkbd[i] = 0) then ParseCommand(CurrentTeam.Aliases[i]) else
+ if (pkbd^[i] = 0)and(tkbd[i] <> 0) then
+ begin
+ s:= CurrentTeam.Aliases[i];
+ s[1]:= '-';
+ ParseCommand(s)
+ end;
+ end else
+ if (tkbd[i] = 0) and (pkbd^[i] <> 0) then ParseCommand(CurrentTeam.Aliases[i]);
+ tkbd[i]:= pkbd^[i]
+ end
+end;
+
+procedure ProcessKbdDemo;
+var pkbd: PByteArray;
+begin
+pkbd:= PByteArray(SDL_GetKeyState(nil));
+if pkbd^[27] <> 0 then
+ begin
+ ParseCommand('/quit');
+ end;
+end;
+
+procedure ResetKbd;
+var i, t: integer;
+ pkbd: PByteArray;
+begin
+pkbd:= PByteArray(SDL_GetKeyState(@i));
+for t:= 0 to Pred(i) do
+ tkbd[i]:= pkbd^[i]
+end;
+
+procedure InitKbdKeyTable;
+var i, t: integer;
+ s: string[15];
+begin
+KeyNames[1]:= 'mousel';
+KeyNames[2]:= 'mousem';
+KeyNames[3]:= 'mouser';
+for i:= 4 to cKeyMaxIndex do
+ begin
+ s:= SDL_GetKeyName(i);
+ if s = 'unknown key' then KeyNames[i]:= ''
+ else begin
+ for t:= 1 to Length(s) do
+ if s[t] = ' ' then s[t]:= '_';
+ KeyNames[i]:= s
+ end;
+ end
+end;
+
+initialization
+
+end.
--- a/hedgewars/uLand.pas Mon Aug 22 21:38:06 2005 +0000
+++ b/hedgewars/uLand.pas Tue Aug 23 16:17:53 2005 +0000
@@ -1,502 +1,503 @@
-(*
- * 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 uLand;
-interface
-uses SDLh;
-{$include options.inc}
-type TLandArray = packed array[0..1023, 0..2047] of LongWord;
-
-var Land: TLandArray;
- LandSurface: PSDL_Surface;
-
-procedure GenLandSurface;
-procedure MakeFortsMap;
-procedure AddHHPoint(_x, _y: integer);
-procedure GetHHPoint(out _x, _y: integer);
-procedure RandomizeHHPoints;
-
-implementation
-uses uConsole, uStore, uMisc, uConsts, uRandom, uTeams;
-
-type TPixAr = record
- Count: Longword;
- ar: array[word] of TPoint;
- end;
-
-var HHPoints: record
- First, Last: word;
- ar: array[1..Pred(cMaxHHs)] of TPoint
- end = (First: 1);
-
-procedure BlitImageAndGenerateCollisionInfo(cpX, cpY: Longword; Image, Surface: PSDL_Surface);
-var i, p: LongWord;
- x, y: Longword;
- bpp: integer;
- r: TSDL_Rect;
-begin
-r.x:= cpX;
-r.y:= cpY;
-SDL_UpperBlit(Image, nil, Surface, @r);
-WriteToConsole('Generating collision info... ');
-
-if SDL_MustLock(Image) then
- SDLTry(SDL_LockSurface(Image) >= 0, true);
-
-bpp:= Image.format.BytesPerPixel;
-WriteToConsole('('+inttostr(bpp)+') ');
-p:= LongWord(Image.pixels);
-case bpp of
- 1: OutError('We don''t work with 8 bit surfaces', true);
- 2: for y:= 0 to Pred(Image.h) do
- begin
- i:= Longword(@Land[cpY + y, cpX]);
- for x:= 0 to Pred(Image.w) do
- if PWord(p + x * 2)^ = 0 then PLongWord(i + x * 4)^:= 0
- else PLongWord(i + x * 4)^:= 1;
- inc(p, Image.pitch);
- end;
- 3: for y:= 0 to Pred(Image.h) do
- begin
- i:= Longword(@Land[cpY + y, cpX]);
- for x:= 0 to Pred(Image.w) do
- if (PByte(p + x * 3 + 0)^ = 0)
- and (PByte(p + x * 3 + 1)^ = 0)
- and (PByte(p + x * 3 + 2)^ = 0) then PLongWord(i + x * 4)^:= 0
- else PLongWord(i + x * 4)^:= 1;
- inc(p, Image.pitch);
- end;
- 4: for y:= 0 to Pred(Image.h) do
- begin
- i:= Longword(@Land[cpY + y, cpX]);
- for x:= 0 to Pred(Image.w) do
- if PLongword(p + x * 4)^ = 0 then PLongWord(i + x * 4)^:= 0
- else PLongWord(i + x * 4)^:= 1;
- inc(p, Image.pitch);
- end;
- end;
-if SDL_MustLock(Image) then
- SDL_UnlockSurface(Image);
-WriteLnToConsole(msgOK)
-end;
-
-procedure GenEdge(out pa: TPixAr);
-var angle, r: real;
- len1: Longword;
-begin
-len1:= 0;
-angle:= 5*pi/6;
-r:= 410;
-repeat
- angle:= angle + 0.1 + getrandom * 0.1;
- pa.ar[len1].X:= 544 + trunc(r*cos(angle));
- pa.ar[len1].Y:= 1080 + trunc(1.5*r*sin(angle));
- if r<380 then r:= r+getrandom*110
- else r:= r - getrandom*80;
- inc(len1);
-until angle > 7/4*pi;
-
-angle:= -pi/6;
-r:= 510;
-pa.ar[len1].X:= 644 + trunc(r*cos(angle));
-pa.ar[len1].Y:= 1080 + trunc(r*sin(angle));
-angle:= -pi;
-
-repeat
- angle:= angle + 0.1 + getrandom*0.1;
- pa.ar[len1].X:= 1504 + trunc(r*cos(angle));
- pa.ar[len1].Y:= 880 + trunc(1.5*r*sin(angle));
- if r<410 then r:= r + getrandom*80
- else r:= r - getrandom*110;
- inc(len1);
-until angle > 1/4*pi;
-pa.ar[len1]:= pa.ar[0];
-pa.Count:= Succ(len1)
-end;
-
-procedure DrawBezierBorder(var pa: TPixAr);
-var x, y, i: integer;
- tx, ty, vx, vy, vlen, t: real;
- r1, r2, r3, r4: real;
- x1, y1, x2, y2, cx1, cy1, cx2, cy2, tsq, tcb: real;
-begin
-vx:= 0;
-vy:= 0;
-with pa do
-for i:= 0 to Count-2 do
- begin
- vlen:= sqrt(sqr(ar[i + 1].x - ar[i ].X) + sqr(ar[i + 1].y - ar[i ].y));
- t:= sqrt(sqr(ar[i + 1].x - ar[i + 2].X) + sqr(ar[i + 1].y - ar[i + 2].y));
- if t<vlen then vlen:= t;
- vlen:= vlen/3;
- tx:= ar[i+2].X - ar[i].X;
- ty:= ar[i+2].y - ar[i].y;
- t:= sqrt(sqr(tx)+sqr(ty));
- if t = 0 then
- begin
- tx:= -tx * 100000;
- ty:= -ty * 100000;
- end else
- begin
- tx:= -tx/t;
- ty:= -ty/t;
- end;
- t:= 1.0*vlen;
- tx:= tx*t;
- ty:= ty*t;
- x1:= ar[i].x;
- y1:= ar[i].y;
- x2:= ar[i + 1].x;
- y2:= ar[i + 1].y;
- cx1:= ar[i].X + trunc(vx);
- cy1:= ar[i].y + trunc(vy);
- cx2:= ar[i+1].X + trunc(tx);
- cy2:= ar[i+1].y + trunc(ty);
- vx:= -tx;
- vy:= -ty;
- t:= 0;
- while t <= 1.0 do
- begin
- tsq:= sqr(t);
- tcb:= tsq * t;
- r1:= (1 - 3*t + 3*tsq - tcb) * x1;
- r2:= ( 3*t - 6*tsq + 3*tcb) * cx1;
- r3:= ( 3*tsq - 3*tcb) * cx2;
- r4:= ( tcb) * x2;
- X:= round(r1 + r2 + r3 + r4);
- r1:= (1 - 3*t + 3*tsq - tcb) * y1;
- r2:= ( 3*t - 6*tsq + 3*tcb) * cy1;
- r3:= ( 3*tsq - 3*tcb) * cy2;
- r4:= ( tcb) * y2;
- Y:= round(r1 + r2 + r3 + r4);
- t:= t + 0.001;
- if ((x and $FFFFF800) = 0) and ((y and $FFFFFC00) = 0) then
- Land[y, x]:= $FFFFFF;
- end;
- end;
-end;
-
-procedure FillLand(x, y: integer);
-var Stack: record
- Count: Longword;
- points: array[0..8192] of record
- xl, xr, y, dir: integer;
- end
- end;
-
- procedure Push(_xl, _xr, _y, _dir: integer);
- begin
- _y:= _y + _dir;
- if (_y < 0) or (_y > 1023) then exit;
- with Stack.points[Stack.Count] do
- begin
- xl:= _xl;
- xr:= _xr;
- y:= _y;
- dir:= _dir
- end;
- inc(Stack.Count);
- TryDo(Stack.Count < 8192, 'stack overflow', true)
- end;
-
- procedure Pop(out _xl, _xr, _y, _dir: integer);
- begin
- dec(Stack.Count);
- with Stack.points[Stack.Count] do
- begin
- _xl:= xl;
- _xr:= xr;
- _y:= y;
- _dir:= dir
- end
- end;
-
-var xl, xr, dir: integer;
-begin
-Stack.Count:= 0;
-xl:= x - 1;
-xr:= x;
-Push(xl, xr, 1024, -1);
-while Stack.Count > 0 do
- begin
- Pop(xl, xr, y, dir);
- while (xl > 0) and (Land[y, xl] = 0) do dec(xl);
- while (xr < 2047) and (Land[y, xr] = 0) do inc(xr);
- while (xl < xr) do
- begin
- while (xl <= xr) and (Land[y, xl] <> 0) do inc(xl);
- x:= xl;
- while (xl <= xr) and (Land[y, xl] = 0) do
- begin
- Land[y, xl]:= $FFFFFF;
- inc(xl)
- end;
- if x < xl then Push(x, Pred(xl), y, dir)
- end;
- end;
-end;
-
-procedure ColorizeLand(Surface: PSDL_Surface);
-var tmpsurf: PSDL_Surface;
- r: TSDL_Rect;
-begin
-tmpsurf:= LoadImage(Pathz[ptThemeCurrent] + 'LandTex.png');
-r.y:= 0;
-while r.y < 1024 do
- begin
- r.x:= 0;
- while r.x < 2048 do
- begin
- SDL_UpperBlit(tmpsurf, nil, Surface, @r);
- inc(r.x, tmpsurf.w)
- end;
- inc(r.y, tmpsurf.h)
- end;
-SDL_FreeSurface(tmpsurf);
-
-tmpsurf:= SDL_CreateRGBSurfaceFrom(@Land, 2048, 1024, 32, 2048*4, $FF0000, $FF00, $FF, 0);
-SDLTry(tmpsurf <> nil, true);
-SDL_SetColorKey(tmpsurf, SDL_SRCCOLORKEY, SDL_MapRGB(tmpsurf.format, $FF, $FF, $FF));
-SDL_UpperBlit(tmpsurf, nil, Surface, nil)
-end;
-
-procedure AddBorder(Surface: PSDL_Surface);
-var tmpsurf: PSDL_Surface;
- r, rr: TSDL_Rect;
- x, yd, yu: integer;
-begin
-tmpsurf:= LoadImage(Pathz[ptThemeCurrent] + 'Border.png');
-for x:= 0 to 2047 do
- begin
- yd:= 1023;
- repeat
- while (yd > 0 ) and (Land[yd, x] = 0) do dec(yd);
- if (yd < 0) then yd:= 0;
- while (yd < 1024) and (Land[yd, x] <> 0) do inc(yd);
- dec(yd);
- yu:= yd;
- while (yu > 0 ) and (Land[yu, x] <> 0) do dec(yu);
- while (yu < yd ) and (Land[yu, x] = 0) do inc(yu);
- if (yd < 1023) and ((yd - yu) >= 16) then
- begin
- rr.x:= x;
- rr.y:= yd - 15;
- r.x:= x mod tmpsurf.w;
- r.y:= 16;
- r.w:= 1;
- r.h:= 16;
- SDL_UpperBlit(tmpsurf, @r, Surface, @rr);
- end;
- if (yu > 0) then
- begin
- rr.x:= x;
- rr.y:= yu;
- r.x:= x mod tmpsurf.w;
- r.y:= 0;
- r.w:= 1;
- r.h:= min(16, yd - yu + 1);
- SDL_UpperBlit(tmpsurf, @r, Surface, @rr);
- end;
- yd:= yu - 1;
- until yd < 0;
- end;
-end;
-
-procedure AddGirders(Surface: PSDL_Surface);
-var tmpsurf: PSDL_Surface;
- x1, x2, y, k, i: integer;
- r, rr: TSDL_Rect;
-
- function CountZeroz(x, y: integer): Longword;
- var i: integer;
- begin
- Result:= 0;
- for i:= y to y + 15 do
- if Land[i, x] <> 0 then inc(Result)
- end;
-
-begin
-y:= 256;
-repeat
- inc(y, 24);
- x1:= 1024;
- x2:= 1024;
- while (x1 > 100) and (CountZeroz(x1, y) = 0) do dec(x1, 2);
- i:= x1 - 12;
- repeat
- k:= CountZeroz(x1, y);
- dec(x1, 2)
- until (x1 < 100) or (k = 0) or (k = 16) or (x1 < i);
- inc(x1, 2);
- if k = 16 then
- begin
- while (x2 < 1900) and (CountZeroz(x2, y) = 0) do inc(x2, 2);
- i:= x2 + 12;
- repeat
- k:= CountZeroz(x2, y);
- inc(x2, 2)
- until (x2 > 1900) or (k = 0) or (k = 16) or (x2 > i);
- if (x2 < 1900) and (k = 16) and (x2 - x1 > 250) then break;
- end;
-x1:= 0;
-until y > 900;
-if x1 > 0 then
- begin
- tmpsurf:= LoadImage(Pathz[ptGraphics] + 'Girder.png');
- rr.x:= x1;
- rr.y:= y;
- while rr.x + 100 < x2 do
- begin
- SDL_UpperBlit(tmpsurf, nil, Surface, @rr);
- inc(rr.x, 100);
- end;
- r.x:= 0;
- r.y:= 0;
- r.w:= x2 - rr.x;
- r.h:= 16;
- SDL_UpperBlit(tmpsurf, @r, Surface, @rr);
- SDL_FreeSurface(tmpsurf);
- for k:= y to y + 15 do
- for i:= x1 to x2 do Land[k, i]:= $FFFFFF
- end
-end;
-
-procedure AddHHPoints;
-var i, x, y: integer;
-begin
-for i:= 0 to 9 do
- begin
- y:= 0;
- x:= i * 160 + 300;
- repeat
- inc(y, 2);
- until (y > 1023) or (Land[y, x - 6] <> 0) or (Land[y, x - 3] <> 0) or (Land[y, x] <> 0)
- or (Land[y, x + 3] <> 0) or (Land[y, x + 6] <> 0);
- AddHHPoint(x, y - 12)
- end;
-end;
-
-procedure GenLandSurface;
-var pa: TPixAr;
- tmpsurf: PSDL_Surface;
-begin
-GenEdge(pa);
-DrawBezierBorder(pa);
-FillLand(1023, 1023);
-AddProgress;
-with PixelFormat^ do
- tmpsurf:= SDL_CreateRGBSurface(SDL_HWSURFACE, 2048, 1024, BitsPerPixel, RMask, GMask, BMask, 0);
-ColorizeLand(tmpsurf);
-AddProgress;
-AddBorder(tmpsurf);
-with PixelFormat^ do
- LandSurface:= SDL_CreateRGBSurface(SDL_HWSURFACE, 2048, 1024, BitsPerPixel, RMask, GMask, BMask, 0);
-SDL_FillRect(LandSurface, nil, 0);
-AddGirders(LandSurface);
-SDL_SetColorKey(tmpsurf, SDL_SRCCOLORKEY, 0);
-SDL_UpperBlit(tmpsurf, nil, LandSurface, nil);
-SDL_FreeSurface(tmpsurf);
-AddProgress;
-AddHHPoints;
-RandomizeHHPoints;
-end;
-
-procedure MakeFortsMap;
-var p: PTeam;
- tmpsurf: PSDL_Surface;
-begin
-p:= TeamsList;
-TryDo(p <> nil, 'No teams on map!', true);
-with PixelFormat^ do
- LandSurface:= SDL_CreateRGBSurface(SDL_HWSURFACE, 2048, 1024, BitsPerPixel, RMask, GMask, BMask, 0);
-tmpsurf:= LoadImage(Pathz[ptForts] + p.FortName + 'L.png');
-BlitImageAndGenerateCollisionInfo(0, 0, tmpsurf, LandSurface);
-SDL_FreeSurface(tmpsurf);
-p:= p.Next;
-TryDo(p <> nil, 'Only one team on map!', true);
-tmpsurf:= LoadImage(Pathz[ptForts] + p.FortName + 'R.png');
-BlitImageAndGenerateCollisionInfo(1024, 0, tmpsurf, LandSurface);
-SDL_FreeSurface(tmpsurf);
-p:= p.Next;
-TryDo(p = nil, 'More than 2 teams on map in forts mode!', true);
-AddHHPoints
-end;
-
-procedure AddHHPoint(_x, _y: integer);
-begin
-with HHPoints do
- begin
- inc(Last);
- TryDo(Last < cMaxHHs, 'HHs coords queue overflow', true);
- with ar[Last] do
- begin
- x:= _x;
- y:= _y
- end
- end
-end;
-
-procedure GetHHPoint(out _x, _y: integer);
-begin
-with HHPoints do
- begin
- TryDo(First <= Last, 'HHs coords queue underflow ' + inttostr(First), true);
- with ar[First] do
- begin
- _x:= x;
- _y:= y
- end;
- inc(First)
- end
-end;
-
-procedure RandomizeHHPoints;
-var i, t: integer;
- p: TPoint;
-begin
-with HHPoints do
- begin
- for i:= First to Last do
- begin
- t:= GetRandom(Last - First + 1) + First;
- if i <> t then
- begin
- p:= ar[i];
- ar[i]:= ar[t];
- ar[t]:= p
- end
- end
- 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 uLand;
+interface
+uses SDLh;
+{$include options.inc}
+type TLandArray = packed array[0..1023, 0..2047] of LongWord;
+
+var Land: TLandArray;
+ LandSurface: PSDL_Surface;
+
+procedure GenLandSurface;
+procedure MakeFortsMap;
+procedure AddHHPoint(_x, _y: integer);
+procedure GetHHPoint(out _x, _y: integer);
+procedure RandomizeHHPoints;
+
+implementation
+uses uConsole, uStore, uMisc, uConsts, uRandom, uTeams, uIO;
+
+type TPixAr = record
+ Count: Longword;
+ ar: array[word] of TPoint;
+ end;
+
+var HHPoints: record
+ First, Last: word;
+ ar: array[1..Pred(cMaxHHs)] of TPoint
+ end = (First: 1);
+
+procedure BlitImageAndGenerateCollisionInfo(cpX, cpY: Longword; Image, Surface: PSDL_Surface);
+var i, p: LongWord;
+ x, y: Longword;
+ bpp: integer;
+ r: TSDL_Rect;
+begin
+r.x:= cpX;
+r.y:= cpY;
+SDL_UpperBlit(Image, nil, Surface, @r);
+WriteToConsole('Generating collision info... ');
+
+if SDL_MustLock(Image) then
+ SDLTry(SDL_LockSurface(Image) >= 0, true);
+
+bpp:= Image.format.BytesPerPixel;
+WriteToConsole('('+inttostr(bpp)+') ');
+p:= LongWord(Image.pixels);
+case bpp of
+ 1: OutError('We don''t work with 8 bit surfaces', true);
+ 2: for y:= 0 to Pred(Image.h) do
+ begin
+ i:= Longword(@Land[cpY + y, cpX]);
+ for x:= 0 to Pred(Image.w) do
+ if PWord(p + x * 2)^ = 0 then PLongWord(i + x * 4)^:= 0
+ else PLongWord(i + x * 4)^:= 1;
+ inc(p, Image.pitch);
+ end;
+ 3: for y:= 0 to Pred(Image.h) do
+ begin
+ i:= Longword(@Land[cpY + y, cpX]);
+ for x:= 0 to Pred(Image.w) do
+ if (PByte(p + x * 3 + 0)^ = 0)
+ and (PByte(p + x * 3 + 1)^ = 0)
+ and (PByte(p + x * 3 + 2)^ = 0) then PLongWord(i + x * 4)^:= 0
+ else PLongWord(i + x * 4)^:= 1;
+ inc(p, Image.pitch);
+ end;
+ 4: for y:= 0 to Pred(Image.h) do
+ begin
+ i:= Longword(@Land[cpY + y, cpX]);
+ for x:= 0 to Pred(Image.w) do
+ if PLongword(p + x * 4)^ = 0 then PLongWord(i + x * 4)^:= 0
+ else PLongWord(i + x * 4)^:= 1;
+ inc(p, Image.pitch);
+ end;
+ end;
+if SDL_MustLock(Image) then
+ SDL_UnlockSurface(Image);
+WriteLnToConsole(msgOK)
+end;
+
+procedure GenEdge(out pa: TPixAr);
+var angle, r: real;
+ len1: Longword;
+begin
+len1:= 0;
+angle:= 5*pi/6;
+r:= 410;
+repeat
+ angle:= angle + 0.1 + getrandom * 0.1;
+ pa.ar[len1].X:= 544 + trunc(r*cos(angle));
+ pa.ar[len1].Y:= 1080 + trunc(1.5*r*sin(angle));
+ if r<380 then r:= r+getrandom*110
+ else r:= r - getrandom*80;
+ inc(len1);
+until angle > 7/4*pi;
+
+angle:= -pi/6;
+r:= 510;
+pa.ar[len1].X:= 644 + trunc(r*cos(angle));
+pa.ar[len1].Y:= 1080 + trunc(r*sin(angle));
+angle:= -pi;
+
+repeat
+ angle:= angle + 0.1 + getrandom*0.1;
+ pa.ar[len1].X:= 1504 + trunc(r*cos(angle));
+ pa.ar[len1].Y:= 880 + trunc(1.5*r*sin(angle));
+ if r<410 then r:= r + getrandom*80
+ else r:= r - getrandom*110;
+ inc(len1);
+until angle > 1/4*pi;
+pa.ar[len1]:= pa.ar[0];
+pa.Count:= Succ(len1)
+end;
+
+procedure DrawBezierBorder(var pa: TPixAr);
+var x, y, i: integer;
+ tx, ty, vx, vy, vlen, t: real;
+ r1, r2, r3, r4: real;
+ x1, y1, x2, y2, cx1, cy1, cx2, cy2, tsq, tcb: real;
+begin
+vx:= 0;
+vy:= 0;
+with pa do
+for i:= 0 to Count-2 do
+ begin
+ vlen:= sqrt(sqr(ar[i + 1].x - ar[i ].X) + sqr(ar[i + 1].y - ar[i ].y));
+ t:= sqrt(sqr(ar[i + 1].x - ar[i + 2].X) + sqr(ar[i + 1].y - ar[i + 2].y));
+ if t<vlen then vlen:= t;
+ vlen:= vlen/3;
+ tx:= ar[i+2].X - ar[i].X;
+ ty:= ar[i+2].y - ar[i].y;
+ t:= sqrt(sqr(tx)+sqr(ty));
+ if t = 0 then
+ begin
+ tx:= -tx * 100000;
+ ty:= -ty * 100000;
+ end else
+ begin
+ tx:= -tx/t;
+ ty:= -ty/t;
+ end;
+ t:= 1.0*vlen;
+ tx:= tx*t;
+ ty:= ty*t;
+ x1:= ar[i].x;
+ y1:= ar[i].y;
+ x2:= ar[i + 1].x;
+ y2:= ar[i + 1].y;
+ cx1:= ar[i].X + trunc(vx);
+ cy1:= ar[i].y + trunc(vy);
+ cx2:= ar[i+1].X + trunc(tx);
+ cy2:= ar[i+1].y + trunc(ty);
+ vx:= -tx;
+ vy:= -ty;
+ t:= 0;
+ while t <= 1.0 do
+ begin
+ tsq:= sqr(t);
+ tcb:= tsq * t;
+ r1:= (1 - 3*t + 3*tsq - tcb) * x1;
+ r2:= ( 3*t - 6*tsq + 3*tcb) * cx1;
+ r3:= ( 3*tsq - 3*tcb) * cx2;
+ r4:= ( tcb) * x2;
+ X:= round(r1 + r2 + r3 + r4);
+ r1:= (1 - 3*t + 3*tsq - tcb) * y1;
+ r2:= ( 3*t - 6*tsq + 3*tcb) * cy1;
+ r3:= ( 3*tsq - 3*tcb) * cy2;
+ r4:= ( tcb) * y2;
+ Y:= round(r1 + r2 + r3 + r4);
+ t:= t + 0.001;
+ if ((x and $FFFFF800) = 0) and ((y and $FFFFFC00) = 0) then
+ Land[y, x]:= $FFFFFF;
+ end;
+ end;
+end;
+
+procedure FillLand(x, y: integer);
+var Stack: record
+ Count: Longword;
+ points: array[0..8192] of record
+ xl, xr, y, dir: integer;
+ end
+ end;
+
+ procedure Push(_xl, _xr, _y, _dir: integer);
+ begin
+ _y:= _y + _dir;
+ if (_y < 0) or (_y > 1023) then exit;
+ with Stack.points[Stack.Count] do
+ begin
+ xl:= _xl;
+ xr:= _xr;
+ y:= _y;
+ dir:= _dir
+ end;
+ inc(Stack.Count);
+ TryDo(Stack.Count < 8192, 'stack overflow', true)
+ end;
+
+ procedure Pop(out _xl, _xr, _y, _dir: integer);
+ begin
+ dec(Stack.Count);
+ with Stack.points[Stack.Count] do
+ begin
+ _xl:= xl;
+ _xr:= xr;
+ _y:= y;
+ _dir:= dir
+ end
+ end;
+
+var xl, xr, dir: integer;
+begin
+Stack.Count:= 0;
+xl:= x - 1;
+xr:= x;
+Push(xl, xr, 1024, -1);
+while Stack.Count > 0 do
+ begin
+ Pop(xl, xr, y, dir);
+ while (xl > 0) and (Land[y, xl] = 0) do dec(xl);
+ while (xr < 2047) and (Land[y, xr] = 0) do inc(xr);
+ while (xl < xr) do
+ begin
+ while (xl <= xr) and (Land[y, xl] <> 0) do inc(xl);
+ x:= xl;
+ while (xl <= xr) and (Land[y, xl] = 0) do
+ begin
+ Land[y, xl]:= $FFFFFF;
+ inc(xl)
+ end;
+ if x < xl then Push(x, Pred(xl), y, dir)
+ end;
+ end;
+end;
+
+procedure ColorizeLand(Surface: PSDL_Surface);
+var tmpsurf: PSDL_Surface;
+ r: TSDL_Rect;
+begin
+tmpsurf:= LoadImage(Pathz[ptThemeCurrent] + 'LandTex.png');
+r.y:= 0;
+while r.y < 1024 do
+ begin
+ r.x:= 0;
+ while r.x < 2048 do
+ begin
+ SDL_UpperBlit(tmpsurf, nil, Surface, @r);
+ inc(r.x, tmpsurf.w)
+ end;
+ inc(r.y, tmpsurf.h)
+ end;
+SDL_FreeSurface(tmpsurf);
+
+tmpsurf:= SDL_CreateRGBSurfaceFrom(@Land, 2048, 1024, 32, 2048*4, $FF0000, $FF00, $FF, 0);
+SDLTry(tmpsurf <> nil, true);
+SDL_SetColorKey(tmpsurf, SDL_SRCCOLORKEY, SDL_MapRGB(tmpsurf.format, $FF, $FF, $FF));
+SDL_UpperBlit(tmpsurf, nil, Surface, nil)
+end;
+
+procedure AddBorder(Surface: PSDL_Surface);
+var tmpsurf: PSDL_Surface;
+ r, rr: TSDL_Rect;
+ x, yd, yu: integer;
+begin
+tmpsurf:= LoadImage(Pathz[ptThemeCurrent] + 'Border.png');
+for x:= 0 to 2047 do
+ begin
+ yd:= 1023;
+ repeat
+ while (yd > 0 ) and (Land[yd, x] = 0) do dec(yd);
+ if (yd < 0) then yd:= 0;
+ while (yd < 1024) and (Land[yd, x] <> 0) do inc(yd);
+ dec(yd);
+ yu:= yd;
+ while (yu > 0 ) and (Land[yu, x] <> 0) do dec(yu);
+ while (yu < yd ) and (Land[yu, x] = 0) do inc(yu);
+ if (yd < 1023) and ((yd - yu) >= 16) then
+ begin
+ rr.x:= x;
+ rr.y:= yd - 15;
+ r.x:= x mod tmpsurf.w;
+ r.y:= 16;
+ r.w:= 1;
+ r.h:= 16;
+ SDL_UpperBlit(tmpsurf, @r, Surface, @rr);
+ end;
+ if (yu > 0) then
+ begin
+ rr.x:= x;
+ rr.y:= yu;
+ r.x:= x mod tmpsurf.w;
+ r.y:= 0;
+ r.w:= 1;
+ r.h:= min(16, yd - yu + 1);
+ SDL_UpperBlit(tmpsurf, @r, Surface, @rr);
+ end;
+ yd:= yu - 1;
+ until yd < 0;
+ end;
+end;
+
+procedure AddGirders(Surface: PSDL_Surface);
+var tmpsurf: PSDL_Surface;
+ x1, x2, y, k, i: integer;
+ r, rr: TSDL_Rect;
+
+ function CountZeroz(x, y: integer): Longword;
+ var i: integer;
+ begin
+ Result:= 0;
+ for i:= y to y + 15 do
+ if Land[i, x] <> 0 then inc(Result)
+ end;
+
+begin
+y:= 256;
+repeat
+ inc(y, 24);
+ x1:= 1024;
+ x2:= 1024;
+ while (x1 > 100) and (CountZeroz(x1, y) = 0) do dec(x1, 2);
+ i:= x1 - 12;
+ repeat
+ k:= CountZeroz(x1, y);
+ dec(x1, 2)
+ until (x1 < 100) or (k = 0) or (k = 16) or (x1 < i);
+ inc(x1, 2);
+ if k = 16 then
+ begin
+ while (x2 < 1900) and (CountZeroz(x2, y) = 0) do inc(x2, 2);
+ i:= x2 + 12;
+ repeat
+ k:= CountZeroz(x2, y);
+ inc(x2, 2)
+ until (x2 > 1900) or (k = 0) or (k = 16) or (x2 > i);
+ if (x2 < 1900) and (k = 16) and (x2 - x1 > 250) then break;
+ end;
+x1:= 0;
+until y > 900;
+if x1 > 0 then
+ begin
+ tmpsurf:= LoadImage(Pathz[ptGraphics] + 'Girder.png');
+ rr.x:= x1;
+ rr.y:= y;
+ while rr.x + 100 < x2 do
+ begin
+ SDL_UpperBlit(tmpsurf, nil, Surface, @rr);
+ inc(rr.x, 100);
+ end;
+ r.x:= 0;
+ r.y:= 0;
+ r.w:= x2 - rr.x;
+ r.h:= 16;
+ SDL_UpperBlit(tmpsurf, @r, Surface, @rr);
+ SDL_FreeSurface(tmpsurf);
+ for k:= y to y + 15 do
+ for i:= x1 to x2 do Land[k, i]:= $FFFFFF
+ end
+end;
+
+procedure AddHHPoints;
+var i, x, y: integer;
+begin
+for i:= 0 to 9 do
+ begin
+ y:= 0;
+ x:= i * 160 + 300;
+ repeat
+ inc(y, 2);
+ until (y > 1023) or (Land[y, x - 6] <> 0) or (Land[y, x - 3] <> 0) or (Land[y, x] <> 0)
+ or (Land[y, x + 3] <> 0) or (Land[y, x + 6] <> 0);
+ AddHHPoint(x, y - 12)
+ end;
+end;
+
+procedure GenLandSurface;
+var pa: TPixAr;
+ tmpsurf: PSDL_Surface;
+begin
+GenEdge(pa);
+DrawBezierBorder(pa);
+FillLand(1023, 1023);
+AddProgress;
+with PixelFormat^ do
+ tmpsurf:= SDL_CreateRGBSurface(SDL_HWSURFACE, 2048, 1024, BitsPerPixel, RMask, GMask, BMask, 0);
+ColorizeLand(tmpsurf);
+AddProgress;
+AddBorder(tmpsurf);
+with PixelFormat^ do
+ LandSurface:= SDL_CreateRGBSurface(SDL_HWSURFACE, 2048, 1024, BitsPerPixel, RMask, GMask, BMask, 0);
+SDL_FillRect(LandSurface, nil, 0);
+AddGirders(LandSurface);
+SDL_SetColorKey(tmpsurf, SDL_SRCCOLORKEY, 0);
+SDL_UpperBlit(tmpsurf, nil, LandSurface, nil);
+SDL_FreeSurface(tmpsurf);
+AddProgress;
+AddHHPoints;
+RandomizeHHPoints;
+end;
+
+procedure MakeFortsMap;
+var p: PTeam;
+ tmpsurf: PSDL_Surface;
+begin
+p:= TeamsList;
+TryDo(p <> nil, 'No teams on map!', true);
+with PixelFormat^ do
+ LandSurface:= SDL_CreateRGBSurface(SDL_HWSURFACE, 2048, 1024, BitsPerPixel, RMask, GMask, BMask, 0);
+tmpsurf:= LoadImage(Pathz[ptForts] + p.FortName + 'L.png');
+BlitImageAndGenerateCollisionInfo(0, 0, tmpsurf, LandSurface);
+SDL_FreeSurface(tmpsurf);
+LoadFortPoints(p.FortName, false, TeamSize(p));
+p:= p.Next;
+TryDo(p <> nil, 'Only one team on map!', true);
+tmpsurf:= LoadImage(Pathz[ptForts] + p.FortName + 'R.png');
+BlitImageAndGenerateCollisionInfo(1024, 0, tmpsurf, LandSurface);
+SDL_FreeSurface(tmpsurf);
+LoadFortPoints(p.FortName, true, TeamSize(p));
+p:= p.Next;
+TryDo(p = nil, 'More than 2 teams on map in forts mode!', true);
+end;
+
+procedure AddHHPoint(_x, _y: integer);
+begin
+with HHPoints do
+ begin
+ inc(Last);
+ TryDo(Last < cMaxHHs, 'HHs coords queue overflow', true);
+ with ar[Last] do
+ begin
+ x:= _x;
+ y:= _y
+ end
+ end
+end;
+
+procedure GetHHPoint(out _x, _y: integer);
+begin
+with HHPoints do
+ begin
+ TryDo(First <= Last, 'HHs coords queue underflow ' + inttostr(First), true);
+ with ar[First] do
+ begin
+ _x:= x;
+ _y:= y
+ end;
+ inc(First)
+ end
+end;
+
+procedure RandomizeHHPoints;
+var i, t: integer;
+ p: TPoint;
+begin
+with HHPoints do
+ begin
+ for i:= First to Last do
+ begin
+ t:= GetRandom(Last - First + 1) + First;
+ if i <> t then
+ begin
+ p:= ar[i];
+ ar[i]:= ar[t];
+ ar[t]:= p
+ end
+ end
+ end
+end;
+
+end.
--- a/hedgewars/uMisc.pas Mon Aug 22 21:38:06 2005 +0000
+++ b/hedgewars/uMisc.pas Tue Aug 23 16:17:53 2005 +0000
@@ -1,210 +1,210 @@
-(*
- * 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 uMisc;
-interface
-uses uConsts, SDLh;
-{$INCLUDE options.inc}
-var isCursorVisible : boolean = false;
- isTerminated : boolean = false;
- isInLag : boolean = false;
- isSoundEnabled : boolean = true;
- isInMultiShoot : boolean = false;
-
- GameState : TGameState = gsLandGen;
- GameType : TGameType = gmtLocal;
- GameFlags : Longword = 0;
- TurnTimeLeft : Longword = 0;
- cHedgehogTurnTime: Longword = 30000;
-
- cLandYShift : integer = 888;
- cCloudsNumber : integer = 9;
- cConsoleHeight : integer = 320;
- cConsoleYAdd : integer = 0;
- cTimerInterval : Cardinal = 15;
- cScreenWidth : integer = 1024;
- cScreenHeight : integer = 768;
- cBits : integer = 16;
- cWaterLine : integer = 1024;
- cVisibleWater : integer = 64;
- cScreenEdgesDist : integer = 240;
-
- GameTicks : LongWord = 0;
-
- cSkyColor : Cardinal = 0;
- cWaterColor : Cardinal = $32397A;
- cMapBackColor : Cardinal = $FFFFFF;
- cWhiteColor : Cardinal = $FFFFFF;
- cConsoleSplitterColor : Cardinal = $FF0000;
- cColorNearBlack : Cardinal = 16;
- cExplosionBorderColor : LongWord = $808080;
-
- cDrownSpeed : Real = 0.06;
- cMaxWindSpeed : Real = 0.0003;
- cWindSpeed : Real = 0.0001;
- cGravity : Real = 0.0005;
-
- cShowFPS : boolean = true;
- cFullScreen : boolean = true;
-
-const
- cMaxPower = 1500;
- cMaxAngle = 2048;
- cPowerDivisor = 1500;
-
-var
- cSendEmptyPacketTime : LongWord = 2000;
- cSendCursorPosTime : LongWord = 50;
-
- flagMakeCapture: boolean = false;
-
- AttackBar : integer = 0; // 0 - отсутствует, 1 - внизу, 2 - как в wwp
-
-function Sign(r: real): integer;
-function Min(a, b: integer): integer;
-function Max(a, b: integer): integer;
-procedure OutError(Msg: String; const isFatalError: boolean=false);
-procedure TryDo(Assert: boolean; Msg: string; isFatal: boolean);
-procedure SDLTry(Assert: boolean; isFatal: boolean);
-function IntToStr(n: integer): shortstring;
-function FloatToStr(n: real): shortstring;
-function arctan(const Y, X: real): real;
-function DxDy2Angle32(const _dY, _dX: Extended): integer;
-procedure AdjustColor(var Color: Longword);
-{$IFDEF DEBUGFILE}
-procedure AddFileLog(s: shortstring);
-{$ENDIF}
-
-var CursorPoint: TPoint;
- TargetPoint: TPoint = (X: NoPointX; Y: 0);
-
-implementation
-uses uConsole, uStore;
-{$IFDEF DEBUGFILE}
-var f: textfile;
-{$ENDIF}
-
-
-function Sign(r: real): integer;
-begin
-if r < 0 then Result:= -1 else Result:= 1
-end;
-
-function Min(a, b: integer): integer;
-begin
-if a < b then Result:= a else Result:= b
-end;
-
-function Max(a, b: integer): integer;
-begin
-if a > b then Result:= a else Result:= b
-end;
-
-procedure OutError(Msg: String; const isFatalError: boolean=false);
-begin
-{$IFDEF DEBUGFILE}AddFileLog(Msg);{$ENDIF}
-if isFatalError then
- begin
- WriteLn(Msg);
- SDL_Quit;
- Readln;
- halt(1)
- end else WriteLnToConsole(Msg)
-end;
-
-procedure TryDo(Assert: boolean; Msg: string; isFatal: boolean);
-begin
-if not Assert then OutError(msg, isFatal)
-end;
-
-procedure SDLTry(Assert: boolean; isFatal: boolean);
-begin
-if not Assert then OutError(SDL_GetError, isFatal)
-end;
-
-procedure AdjustColor(var Color: Cardinal);
-begin
-Color:= SDL_MapRGB(PixelFormat, (Color shr 16) and $FF, (Color shr 8) and $FF, Color and $FF)
-end;
-
-function IntToStr(n: integer): shortstring;
-begin
-str(n, Result)
-end;
-
-function FloatToStr(n: real): shortstring;
-begin
-str(n, Result)
-end;
-
-function arctan(const Y, X: real): real;
-asm
- fld Y
- fld X
- fpatan
- fwait
-end;
-
-function DxDy2Angle32(const _dY, _dX: Extended): integer;
-const piDIV32: Extended = pi/32;
-asm
- fld _dY
- fld _dX
- fpatan
- fld piDIV32
- fdiv
- sub esp, 4
- fistp dword ptr [esp]
- pop eax
- shr eax, 1
- and eax, $1F
-end;
-
-
-{$IFDEF DEBUGFILE}
-procedure AddFileLog(s: shortstring);
-begin
-writeln(f, GameTicks: 6, ': ', s);
-flush(f)
-end;
-
-initialization
-assignfile(f, 'debug.txt');
-rewrite(f);
-finalization
-writeln(f, '-= halt at ',GameTicks,' ticks =-');
-Flush(f);
-closefile(f)
-{$ENDIF}
-
-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 uMisc;
+interface
+uses uConsts, SDLh;
+{$INCLUDE options.inc}
+var isCursorVisible : boolean = false;
+ isTerminated : boolean = false;
+ isInLag : boolean = false;
+ isSoundEnabled : boolean = true;
+ isInMultiShoot : boolean = false;
+
+ GameState : TGameState = gsLandGen;
+ GameType : TGameType = gmtLocal;
+ GameFlags : Longword = 0;
+ TurnTimeLeft : Longword = 0;
+ cHedgehogTurnTime: Longword = 30000;
+
+ cLandYShift : integer = 888;
+ cCloudsNumber : integer = 9;
+ cConsoleHeight : integer = 320;
+ cConsoleYAdd : integer = 0;
+ cTimerInterval : Cardinal = 15;
+ cScreenWidth : integer = 1024;
+ cScreenHeight : integer = 768;
+ cBits : integer = 16;
+ cWaterLine : integer = 1024;
+ cVisibleWater : integer = 64;
+ cScreenEdgesDist : integer = 240;
+
+ GameTicks : LongWord = 0;
+
+ cSkyColor : Cardinal = 0;
+ cWaterColor : Cardinal = $32397A;
+ cMapBackColor : Cardinal = $FFFFFF;
+ cWhiteColor : Cardinal = $FFFFFF;
+ cConsoleSplitterColor : Cardinal = $FF0000;
+ cColorNearBlack : Cardinal = 16;
+ cExplosionBorderColor : LongWord = $808080;
+
+ cDrownSpeed : Real = 0.06;
+ cMaxWindSpeed : Real = 0.0003;
+ cWindSpeed : Real = 0.0001;
+ cGravity : Real = 0.0005;
+
+ cShowFPS : boolean = true;
+ cFullScreen : boolean = true;
+
+const
+ cMaxPower = 1500;
+ cMaxAngle = 2048;
+ cPowerDivisor = 1500;
+
+var
+ cSendEmptyPacketTime : LongWord = 2000;
+ cSendCursorPosTime : LongWord = 50;
+
+ flagMakeCapture: boolean = false;
+
+ AttackBar : integer = 0; // 0 - отсутствует, 1 - внизу, 2 - как в wwp
+
+function Sign(r: real): integer;
+function Min(a, b: integer): integer;
+function Max(a, b: integer): integer;
+procedure OutError(Msg: String; const isFatalError: boolean=false);
+procedure TryDo(Assert: boolean; Msg: string; isFatal: boolean);
+procedure SDLTry(Assert: boolean; isFatal: boolean);
+function IntToStr(n: integer): shortstring;
+function FloatToStr(n: real): shortstring;
+function arctan(const Y, X: real): real;
+function DxDy2Angle32(const _dY, _dX: Extended): integer;
+procedure AdjustColor(var Color: Longword);
+{$IFDEF DEBUGFILE}
+procedure AddFileLog(s: shortstring);
+{$ENDIF}
+
+var CursorPoint: TPoint;
+ TargetPoint: TPoint = (X: NoPointX; Y: 0);
+
+implementation
+uses uConsole, uStore;
+{$IFDEF DEBUGFILE}
+var f: textfile;
+{$ENDIF}
+
+
+function Sign(r: real): integer;
+begin
+if r < 0 then Result:= -1 else Result:= 1
+end;
+
+function Min(a, b: integer): integer;
+begin
+if a < b then Result:= a else Result:= b
+end;
+
+function Max(a, b: integer): integer;
+begin
+if a > b then Result:= a else Result:= b
+end;
+
+procedure OutError(Msg: String; const isFatalError: boolean=false);
+begin
+{$IFDEF DEBUGFILE}AddFileLog(Msg);{$ENDIF}
+if isFatalError then
+ begin
+ WriteLn(Msg);
+ SDL_Quit;
+ Readln;
+ halt(1)
+ end else WriteLnToConsole(Msg)
+end;
+
+procedure TryDo(Assert: boolean; Msg: string; isFatal: boolean);
+begin
+if not Assert then OutError(msg, isFatal)
+end;
+
+procedure SDLTry(Assert: boolean; isFatal: boolean);
+begin
+if not Assert then OutError(SDL_GetError, isFatal)
+end;
+
+procedure AdjustColor(var Color: Cardinal);
+begin
+Color:= SDL_MapRGB(PixelFormat, (Color shr 16) and $FF, (Color shr 8) and $FF, Color and $FF)
+end;
+
+function IntToStr(n: integer): shortstring;
+begin
+str(n, Result)
+end;
+
+function FloatToStr(n: real): shortstring;
+begin
+str(n, Result)
+end;
+
+function arctan(const Y, X: real): real;
+asm
+ fld Y
+ fld X
+ fpatan
+ fwait
+end;
+
+function DxDy2Angle32(const _dY, _dX: Extended): integer;
+const piDIV32: Extended = pi/32;
+asm
+ fld _dY
+ fld _dX
+ fpatan
+ fld piDIV32
+ fdiv
+ sub esp, 4
+ fistp dword ptr [esp]
+ pop eax
+ shr eax, 1
+ and eax, $1F
+end;
+
+
+{$IFDEF DEBUGFILE}
+procedure AddFileLog(s: shortstring);
+begin
+writeln(f, GameTicks: 6, ': ', s);
+flush(f)
+end;
+
+initialization
+assignfile(f, 'debug.txt');
+rewrite(f);
+finalization
+writeln(f, '-= halt at ',GameTicks,' ticks =-');
+Flush(f);
+closefile(f)
+{$ENDIF}
+
+end.
--- a/hedgewars/uNet.pas Mon Aug 22 21:38:06 2005 +0000
+++ b/hedgewars/uNet.pas Tue Aug 23 16:17:53 2005 +0000
@@ -1,155 +1,155 @@
-(*
- * 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 uNet;
-interface
-uses WinSock, Messages;
-const
- IN_NET_PORT = 46632;
- WM_ASYNC_NETEVENT = WM_USER + 7;
-
-type TCommandHandler = procedure (s: shortstring);
-
-procedure SplitStream2Commands(var ss: string; Handler: TCommandHandler);
-procedure SendSock(Socket: TSocket; s: shortstring);
-procedure InitServer;
-procedure NetSockEvent(sock, lParam: Longword);
-
-var hNetListenSockTCP: TSocket = INVALID_SOCKET;
-
-implementation
-uses uServerMisc, uPlayers;
-
-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;
-
-procedure SendSock(Socket: TSocket; s: shortstring);
-begin
-//writeln(socket, '> ', s);
-send(Socket, s[0], Succ(byte(s[0])), 0)
-end;
-
-procedure InitServer;
-var myaddrTCP: TSockAddrIn;
- t: integer;
- stWSADataTCPIP : WSADATA;
-begin
-TryDo(WSAStartup($0101, stWSADataTCPIP) = 0, 'Error on WSAStartup');
-hNetListenSockTCP:= socket(AF_INET, SOCK_STREAM, 0);
-myaddrTCP.sin_family := AF_INET;
-myaddrTCP.sin_addr.s_addr := $0;
-myaddrTCP.sin_port := htons(IN_NET_PORT);
-t:= sizeof(TSockAddrIn);
-TryDo( bind(hNetListenSockTCP, myaddrTCP, t) = 0, 'Error on bind' );
-TryDo( listen(hNetListenSockTCP, 1) = 0, 'Error on listen');
-WSAAsyncSelect(hNetListenSockTCP, hwndMain, WM_ASYNC_NETEVENT, FD_ACCEPT or FD_READ or FD_CLOSE)
-end;
-
-procedure ParseNetCommand(Player: PPlayer; s: shortstring);
-begin
-case s[1] of
- '?': SendSock(player.socket, '!');
- 'n': begin
- player.Name:= copy(s, 2, length(s) - 1);
- Writeln(player.socket, ' now is ', player.Name)
- end;
- 'C': SendConfig(player);
- 'G': SendAll('G');
- 'T': begin
- s[0]:= #5;
- s[1]:= 'T';
- PLongWord(@s[2])^:= GetTeamCount;
- SendSock(player.socket, s)
- end;
- 'K': SelectFirstCFGTeam;
- 'k': SelectNextCFGTeam;
- 'h': ConfCurrTeam(s);
- else SendAllButOne(Player, s) end
-end;
-
-procedure NetSockEvent(sock, lParam: Longword);
-var i: integer;
- buf: array[0..255] of byte;
- s: shortstring absolute buf;
- WSAEvent: word;
- player: PPlayer;
- sa: TSockAddr;
-begin
-WSAEvent:= WSAGETSELECTEVENT(lParam);
-case WSAEvent of
- FD_ACCEPT: begin
- i:= sizeof(sa);
- sock:= accept(hNetListenSockTCP, @sa, @i);
- Writeln('Connected player ', sock, ' from ', inet_ntoa(sa.sin_addr));
- AddPlayer(sock);
- SendSock(sock, 'i')
- end;
- FD_CLOSE: begin
- player:= FindPlayerbySock(sock);
- TryDo(player <> nil, 'FD_CLOSE from unknown player??');
- Write('Player quit: ');
- if player.Name[0]=#0 then Writeln('socket ', player.socket)
- else Writeln(player.Name);
- DeletePlayer(player);
- closesocket(sock);
- end;
- FD_READ: begin
- player:= FindPlayerbySock(sock);
- TryDo(player <> nil, 'FD_READ from unknown player??');
- repeat
- i:= recv(sock, buf[1], 255, 0);
- if i > 0 then
- begin
- buf[0]:= i;
- player.inbuf:= player.inbuf + s;
- while (Length(player.inbuf) > 1)and(Length(player.inbuf) > byte(player.inbuf[1])) do
- begin
- ParseNetCommand(player, copy(player.inbuf, 2, byte(player.inbuf[1])));
- Delete(player.inbuf, 1, Succ(byte(player.inbuf[1])))
- end;
- end;
- until i < 1;
- 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 uNet;
+interface
+uses WinSock, Messages;
+const
+ IN_NET_PORT = 46632;
+ WM_ASYNC_NETEVENT = WM_USER + 7;
+
+type TCommandHandler = procedure (s: shortstring);
+
+procedure SplitStream2Commands(var ss: string; Handler: TCommandHandler);
+procedure SendSock(Socket: TSocket; s: shortstring);
+procedure InitServer;
+procedure NetSockEvent(sock, lParam: Longword);
+
+var hNetListenSockTCP: TSocket = INVALID_SOCKET;
+
+implementation
+uses uServerMisc, uPlayers;
+
+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;
+
+procedure SendSock(Socket: TSocket; s: shortstring);
+begin
+//writeln(socket, '> ', s);
+send(Socket, s[0], Succ(byte(s[0])), 0)
+end;
+
+procedure InitServer;
+var myaddrTCP: TSockAddrIn;
+ t: integer;
+ stWSADataTCPIP : WSADATA;
+begin
+TryDo(WSAStartup($0101, stWSADataTCPIP) = 0, 'Error on WSAStartup');
+hNetListenSockTCP:= socket(AF_INET, SOCK_STREAM, 0);
+myaddrTCP.sin_family := AF_INET;
+myaddrTCP.sin_addr.s_addr := $0;
+myaddrTCP.sin_port := htons(IN_NET_PORT);
+t:= sizeof(TSockAddrIn);
+TryDo( bind(hNetListenSockTCP, myaddrTCP, t) = 0, 'Error on bind' );
+TryDo( listen(hNetListenSockTCP, 1) = 0, 'Error on listen');
+WSAAsyncSelect(hNetListenSockTCP, hwndMain, WM_ASYNC_NETEVENT, FD_ACCEPT or FD_READ or FD_CLOSE)
+end;
+
+procedure ParseNetCommand(Player: PPlayer; s: shortstring);
+begin
+case s[1] of
+ '?': SendSock(player.socket, '!');
+ 'n': begin
+ player.Name:= copy(s, 2, length(s) - 1);
+ Writeln(player.socket, ' now is ', player.Name)
+ end;
+ 'C': SendConfig(player);
+ 'G': SendAll('G');
+ 'T': begin
+ s[0]:= #5;
+ s[1]:= 'T';
+ PLongWord(@s[2])^:= GetTeamCount;
+ SendSock(player.socket, s)
+ end;
+ 'K': SelectFirstCFGTeam;
+ 'k': SelectNextCFGTeam;
+ 'h': ConfCurrTeam(s);
+ else SendAllButOne(Player, s) end
+end;
+
+procedure NetSockEvent(sock, lParam: Longword);
+var i: integer;
+ buf: array[0..255] of byte;
+ s: shortstring absolute buf;
+ WSAEvent: word;
+ player: PPlayer;
+ sa: TSockAddr;
+begin
+WSAEvent:= WSAGETSELECTEVENT(lParam);
+case WSAEvent of
+ FD_ACCEPT: begin
+ i:= sizeof(sa);
+ sock:= accept(hNetListenSockTCP, @sa, @i);
+ Writeln('Connected player ', sock, ' from ', inet_ntoa(sa.sin_addr));
+ AddPlayer(sock);
+ SendSock(sock, 'i')
+ end;
+ FD_CLOSE: begin
+ player:= FindPlayerbySock(sock);
+ TryDo(player <> nil, 'FD_CLOSE from unknown player??');
+ Write('Player quit: ');
+ if player.Name[0]=#0 then Writeln('socket ', player.socket)
+ else Writeln(player.Name);
+ DeletePlayer(player);
+ closesocket(sock);
+ end;
+ FD_READ: begin
+ player:= FindPlayerbySock(sock);
+ TryDo(player <> nil, 'FD_READ from unknown player??');
+ repeat
+ i:= recv(sock, buf[1], 255, 0);
+ if i > 0 then
+ begin
+ buf[0]:= i;
+ player.inbuf:= player.inbuf + s;
+ while (Length(player.inbuf) > 1)and(Length(player.inbuf) > byte(player.inbuf[1])) do
+ begin
+ ParseNetCommand(player, copy(player.inbuf, 2, byte(player.inbuf[1])));
+ Delete(player.inbuf, 1, Succ(byte(player.inbuf[1])))
+ end;
+ end;
+ until i < 1;
+ end
+ end
+end;
+
+
+end.
--- a/hedgewars/uPlayers.pas Mon Aug 22 21:38:06 2005 +0000
+++ b/hedgewars/uPlayers.pas Tue Aug 23 16:17:53 2005 +0000
@@ -1,191 +1,191 @@
-(*
- * 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 uPlayers;
-interface
-uses windows, WinSock;
-type PPlayer = ^TPlayer;
- PTeam = ^TTeam;
- TTeam = record
- hhs: array[0..7] of TPoint;
- hhCount: LongWord;
- end;
- TPlayer = record
- socket: TSocket;
- NextPlayer, PrevPlayer: PPlayer;
- Name: string[31];
- inbuf: string;
- isme: boolean;
- CurrTeam: LongWord;
- TeamCount: LongWord;
- Teams: array[0..3] of TTeam
- end;
-
-function AddPlayer(sock: TSocket): PPlayer;
-procedure DeletePlayer(Player: PPlayer);
-function FindPlayerbySock(sock: TSocket): PPlayer;
-procedure SendAll(s: shortstring);
-procedure SendAllButOne(Player: PPlayer; s: shortstring);
-procedure SelectFirstCFGTeam;
-procedure SelectNextCFGTeam;
-function GetTeamCount: Longword;
-procedure ConfCurrTeam(s: shortstring);
-procedure SendConfig(player: PPlayer);
-
-var CurrCFGPlayer: PPlayer;
-
-implementation
-uses uServerMisc, uNet, SysUtils;
-var PlayersList: PPlayer = nil;
-
-function AddPlayer(sock: TSocket): PPlayer;
-begin
-New(Result);
-TryDo(Result <> nil, 'Error adding player!');
-FillChar(Result^, sizeof(TPlayer), 0);
-Result.socket:= sock;
-Result.TeamCount:= 2;
-if PlayersList = nil then begin PlayersList:= Result; result.isme:= true end
- else begin
- PlayersList.PrevPlayer:= Result;
- Result.NextPlayer:= PlayersList;
- PlayersList:= Result
- end
-end;
-
-procedure DeletePlayer(Player: PPlayer);
-begin
-if Player = nil then OutError('Trying remove nil player!', false);
-if Player.NextPlayer <> nil then Player.NextPlayer.PrevPlayer:= Player.PrevPlayer;
-if Player.PrevPlayer <> nil then Player.PrevPlayer.NextPlayer:= Player.NextPlayer
- else begin
- PlayersList:= Player^.NextPlayer;
- if PlayersList <> nil then PlayersList.PrevPlayer:= nil
- end;
-Dispose(Player)
-end;
-
-function FindPlayerbySock(sock: TSocket): PPlayer;
-begin
-Result:= PlayersList;
-while (Result<>nil)and(Result.socket<>sock) do
- Result:= Result.NextPlayer
-end;
-
-procedure SendAll(s: shortstring);
-var p: PPlayer;
-begin
-p:= PlayersList;
-while p <> nil do
- begin
- SendSock(p.socket, s);
- p:= p.NextPlayer
- end;
-end;
-
-procedure SendAllButOne(Player: PPlayer; s: shortstring);
-var p: PPlayer;
-begin
-p:= Player.NextPlayer;
-while p <> nil do
- begin
- SendSock(p.socket, s);
- p:= p.NextPlayer
- end;
-p:= PlayersList;
-while p <> Player do
- begin
- SendSock(p.socket, s);
- p:= p.NextPlayer
- end;
-end;
-
-function GetTeamCount: Longword;
-var p: PPlayer;
-begin
-p:= PlayersList;
-Result:= 0;
-while p <> nil do
- begin
- inc(Result, p.TeamCount);
- p:= p.NextPlayer
- end;
-end;
-
-procedure SelectFirstCFGTeam;
-begin
-CurrCFGPlayer:= PlayersList
-end;
-
-procedure SelectNextCFGTeam;
-begin
-if CurrCFGPlayer = nil then OutError('Trying select next on nil current', true);
-if Succ(CurrCFGPlayer.CurrTeam) < CurrCFGPlayer.TeamCount then inc(CurrCFGPlayer.CurrTeam)
- else CurrCFGPlayer:= CurrCFGPlayer.NextPlayer
-end;
-
-procedure ConfCurrTeam(s: shortstring);
-begin
-if CurrCFGPlayer = nil then OutError('Trying select next on nil current', true);
-case s[1] of
- 'h': with CurrCFGPlayer.Teams[CurrCFGPlayer.CurrTeam] do
- begin
- hhs[hhCount].X:= PLongWord(@s[2])^;
- hhs[hhCount].Y:= PLongWord(@s[6])^;
- inc(hhCount);
- end;
- end;
-end;
-
-procedure SendConfig(player: PPlayer);
-var p: PPlayer;
- i, t: integer;
-begin
-p:= PlayersList;
-while p <> nil do
- begin
- for t:= 0 to Pred(player.TeamCount) do
- begin
- SendSock(player.socket, 'eaddteam');
- if p = player then SendSock(player.socket, '@')
- else SendSock(player.socket, 'erdriven');
- for i:= 0 to Pred(player.Teams[t].hhCount) do
- SendSock(player.socket, Format('eadd hh%d %d %d %d',[i, p.Teams[t].hhs[i].X, p.Teams[t].hhs[i].Y, 0]));
- Sendsock(player.socket, Format('ecolor %d',[random($A0A0A0)+$5F5F5F]))
- end;
- p:= p.NextPlayer
- 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 uPlayers;
+interface
+uses windows, WinSock;
+type PPlayer = ^TPlayer;
+ PTeam = ^TTeam;
+ TTeam = record
+ hhs: array[0..7] of TPoint;
+ hhCount: LongWord;
+ end;
+ TPlayer = record
+ socket: TSocket;
+ NextPlayer, PrevPlayer: PPlayer;
+ Name: string[31];
+ inbuf: string;
+ isme: boolean;
+ CurrTeam: LongWord;
+ TeamCount: LongWord;
+ Teams: array[0..3] of TTeam
+ end;
+
+function AddPlayer(sock: TSocket): PPlayer;
+procedure DeletePlayer(Player: PPlayer);
+function FindPlayerbySock(sock: TSocket): PPlayer;
+procedure SendAll(s: shortstring);
+procedure SendAllButOne(Player: PPlayer; s: shortstring);
+procedure SelectFirstCFGTeam;
+procedure SelectNextCFGTeam;
+function GetTeamCount: Longword;
+procedure ConfCurrTeam(s: shortstring);
+procedure SendConfig(player: PPlayer);
+
+var CurrCFGPlayer: PPlayer;
+
+implementation
+uses uServerMisc, uNet, SysUtils;
+var PlayersList: PPlayer = nil;
+
+function AddPlayer(sock: TSocket): PPlayer;
+begin
+New(Result);
+TryDo(Result <> nil, 'Error adding player!');
+FillChar(Result^, sizeof(TPlayer), 0);
+Result.socket:= sock;
+Result.TeamCount:= 2;
+if PlayersList = nil then begin PlayersList:= Result; result.isme:= true end
+ else begin
+ PlayersList.PrevPlayer:= Result;
+ Result.NextPlayer:= PlayersList;
+ PlayersList:= Result
+ end
+end;
+
+procedure DeletePlayer(Player: PPlayer);
+begin
+if Player = nil then OutError('Trying remove nil player!', false);
+if Player.NextPlayer <> nil then Player.NextPlayer.PrevPlayer:= Player.PrevPlayer;
+if Player.PrevPlayer <> nil then Player.PrevPlayer.NextPlayer:= Player.NextPlayer
+ else begin
+ PlayersList:= Player^.NextPlayer;
+ if PlayersList <> nil then PlayersList.PrevPlayer:= nil
+ end;
+Dispose(Player)
+end;
+
+function FindPlayerbySock(sock: TSocket): PPlayer;
+begin
+Result:= PlayersList;
+while (Result<>nil)and(Result.socket<>sock) do
+ Result:= Result.NextPlayer
+end;
+
+procedure SendAll(s: shortstring);
+var p: PPlayer;
+begin
+p:= PlayersList;
+while p <> nil do
+ begin
+ SendSock(p.socket, s);
+ p:= p.NextPlayer
+ end;
+end;
+
+procedure SendAllButOne(Player: PPlayer; s: shortstring);
+var p: PPlayer;
+begin
+p:= Player.NextPlayer;
+while p <> nil do
+ begin
+ SendSock(p.socket, s);
+ p:= p.NextPlayer
+ end;
+p:= PlayersList;
+while p <> Player do
+ begin
+ SendSock(p.socket, s);
+ p:= p.NextPlayer
+ end;
+end;
+
+function GetTeamCount: Longword;
+var p: PPlayer;
+begin
+p:= PlayersList;
+Result:= 0;
+while p <> nil do
+ begin
+ inc(Result, p.TeamCount);
+ p:= p.NextPlayer
+ end;
+end;
+
+procedure SelectFirstCFGTeam;
+begin
+CurrCFGPlayer:= PlayersList
+end;
+
+procedure SelectNextCFGTeam;
+begin
+if CurrCFGPlayer = nil then OutError('Trying select next on nil current', true);
+if Succ(CurrCFGPlayer.CurrTeam) < CurrCFGPlayer.TeamCount then inc(CurrCFGPlayer.CurrTeam)
+ else CurrCFGPlayer:= CurrCFGPlayer.NextPlayer
+end;
+
+procedure ConfCurrTeam(s: shortstring);
+begin
+if CurrCFGPlayer = nil then OutError('Trying select next on nil current', true);
+case s[1] of
+ 'h': with CurrCFGPlayer.Teams[CurrCFGPlayer.CurrTeam] do
+ begin
+ hhs[hhCount].X:= PLongWord(@s[2])^;
+ hhs[hhCount].Y:= PLongWord(@s[6])^;
+ inc(hhCount);
+ end;
+ end;
+end;
+
+procedure SendConfig(player: PPlayer);
+var p: PPlayer;
+ i, t: integer;
+begin
+p:= PlayersList;
+while p <> nil do
+ begin
+ for t:= 0 to Pred(player.TeamCount) do
+ begin
+ SendSock(player.socket, 'eaddteam');
+ if p = player then SendSock(player.socket, '@')
+ else SendSock(player.socket, 'erdriven');
+ for i:= 0 to Pred(player.Teams[t].hhCount) do
+ SendSock(player.socket, Format('eadd hh%d %d %d %d',[i, p.Teams[t].hhs[i].X, p.Teams[t].hhs[i].Y, 0]));
+ Sendsock(player.socket, Format('ecolor %d',[random($A0A0A0)+$5F5F5F]))
+ end;
+ p:= p.NextPlayer
+ end
+end;
+
+
+end.
--- a/hedgewars/uRandom.pas Mon Aug 22 21:38:06 2005 +0000
+++ b/hedgewars/uRandom.pas Tue Aug 23 16:17:53 2005 +0000
@@ -1,75 +1,75 @@
-(*
- * 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 uRandom;
-interface
-uses uSHA;
-
-procedure SetRandomParams(Seed: shortstring; FillBuf: shortstring);
-function GetRandom: real; overload;
-function GetRandom(m: LongWord): LongWord; overload;
-
-implementation
-var sc1, sc2: TSHA1Context;
- Fill: shortstring;
-
-procedure SetRandomParams(Seed: shortstring; FillBuf: shortstring);
-begin
-SHA1Init(sc1);
-SHA1Update(sc1, @Seed, Length(Seed)+1);
-Fill:= FillBuf
-end;
-
-function GetRandom: real;
-var dig: TSHA1Digest;
-begin
-SHA1Update(sc1, @Fill[1], Length(Fill));
-sc2:= sc1;
-dig:= SHA1Final(sc1);
-Result:= frac( dig.LongWords[0]*0.0000731563977
- + pi * dig.Words[6]
- + 0.0109070019*dig.Words[9]);
-sc1:= sc2
-end;
-
-function GetRandom(m: LongWord): LongWord;
-var dig: TSHA1Digest;
-begin
-SHA1Update(sc1, @Fill[1], Length(Fill));
-sc2:= sc1;
-dig:= SHA1Final(sc1);
-Result:= (((dig.LongWords[0] mod m) + (dig.LongWords[2] mod m)) mod m + (dig.LongWords[3] mod m)) mod m;
-sc1:= sc2
-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 uRandom;
+interface
+uses uSHA;
+
+procedure SetRandomParams(Seed: shortstring; FillBuf: shortstring);
+function GetRandom: real; overload;
+function GetRandom(m: LongWord): LongWord; overload;
+
+implementation
+var sc1, sc2: TSHA1Context;
+ Fill: shortstring;
+
+procedure SetRandomParams(Seed: shortstring; FillBuf: shortstring);
+begin
+SHA1Init(sc1);
+SHA1Update(sc1, @Seed, Length(Seed)+1);
+Fill:= FillBuf
+end;
+
+function GetRandom: real;
+var dig: TSHA1Digest;
+begin
+SHA1Update(sc1, @Fill[1], Length(Fill));
+sc2:= sc1;
+dig:= SHA1Final(sc1);
+Result:= frac( dig.LongWords[0]*0.0000731563977
+ + pi * dig.Words[6]
+ + 0.0109070019*dig.Words[9]);
+sc1:= sc2
+end;
+
+function GetRandom(m: LongWord): LongWord;
+var dig: TSHA1Digest;
+begin
+SHA1Update(sc1, @Fill[1], Length(Fill));
+sc2:= sc1;
+dig:= SHA1Final(sc1);
+Result:= (((dig.LongWords[0] mod m) + (dig.LongWords[2] mod m)) mod m + (dig.LongWords[3] mod m)) mod m;
+sc1:= sc2
+end;
+
+end.
--- a/hedgewars/uSHA.pas Mon Aug 22 21:38:06 2005 +0000
+++ b/hedgewars/uSHA.pas Tue Aug 23 16:17:53 2005 +0000
@@ -1,163 +1,163 @@
-(*
- * 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 uSHA;
-interface
-
-type TSHA1Context = packed record
- H: array[0..4] of LongWord;
- Length, CurrLength: Int64;
- Buf: array[0..63] of byte;
- end;
- TSHA1Digest = record
- case byte of
- 0: (LongWords: array[0.. 4] of LongWord);
- 1: ( Words: array[0.. 9] of Word);
- 2: ( Bytes: array[0..19] of Byte)
- end;
-
-procedure SHA1Init(var Context: TSHA1Context);
-procedure SHA1Update(var Context: TSHA1Context; Buf: Pointer; Length: LongWord);
-function SHA1Final(Context: TSHA1Context): TSHA1Digest;
-
-implementation
-
-function _bswap(X: LongWord): LongWord; assembler;
-asm
- bswap eax
-end;
-
-function rol(x: LongWord; y: Byte): LongWord; assembler;
-asm
- mov cl,dl
- rol eax,cl
-end;
-
-function Ft(t, b, c, d: LongWord): LongWord;
-begin
-case t of
- 0..19: Result := (b and c) or ((not b) and d);
- 20..39: Result := b xor c xor d;
- 40..59: Result := (b and c) or (b and d) or (c and d);
- else Result := b xor c xor d;
- end;
-end;
-
-function Kt(t: Byte): LongWord;
-begin
- case t of
- 0..19: Result := $5A827999;
- 20..39: Result := $6ED9EBA1;
- 40..59: Result := $8F1BBCDC;
- else
- Result := $CA62C1D6
- end;
-end;
-
-
-procedure SHA1Hash(var Context: TSHA1Context);
-var S: array[0..4 ] of LongWord;
- W: array[0..79] of LongWord;
- i, t: LongWord;
-begin
-move(Context.H, S, sizeof(S));
-for i:= 0 to 15 do
- W[i]:= _bswap(PLongWord(LongWord(@Context.Buf)+i*4)^);
-for i := 16 to 79 do
- W[i] := rol(W[i - 3] xor W[i - 8] xor W[i - 14] xor W[i - 16], 1);
-for i := 0 to 79 do
- begin
- t:= rol(S[0], 5) + Ft(i, S[1], S[2], S[3]) + S[4] + W[i] + Kt(i);
- S[4]:= S[3];
- S[3]:= S[2];
- S[2]:= rol(S[1], 30);
- S[1]:= S[0];
- S[0]:= t
- end;
-for i := 0 to 4 do
- Context.H[i]:= Context.H[i] + S[i]
-end;
-
-procedure SHA1Init(var Context: TSHA1Context);
-begin
- with Context do
- begin
- Length := 0;
- CurrLength:= 0;
- H[0]:= $67452301;
- H[1]:= $EFCDAB89;
- H[2]:= $98BADCFE;
- H[3]:= $10325476;
- H[4]:= $C3D2E1F0
- end
-end;
-
-procedure SHA1Update(var Context: TSHA1Context; Buf: Pointer; Length: LongWord);
-var i: integer;
-begin
-for i:= 1 to Length do
- begin
- Context.Buf[Context.CurrLength]:= PByte(Buf)^;
- inc(Context.CurrLength);
- inc(LongWord(Buf));
- if Context.CurrLength=64 then
- begin
- SHA1Hash(Context);
- inc(Context.Length, 512);
- Context.CurrLength:=0
- end
- end
-end;
-
-function SHA1Final(Context: TSHA1Context): TSHA1Digest;
-var i: LongWord;
-begin
-Context.Length:= Context.Length + Context.CurrLength shl 3;
-Context.Buf[Context.CurrLength]:= $80;
-inc(Context.CurrLength);
-if Context.CurrLength>56 then
- begin
- FillChar(Context.Buf[Context.CurrLength],64-Context.CurrLength,0);
- Context.CurrLength:= 64;
- SHA1Hash(Context);
- Context.CurrLength:=0
- end;
-FillChar(Context.Buf[Context.CurrLength],56-Context.CurrLength,0);
-for i:= 56 to 63 do
- Context.Buf[i] := (Context.Length shr ((63 - i) * 8)) and $FF;
-SHA1Hash(Context);
-move(Context.H, Result, sizeof(TSHA1Digest));
-FillChar(Context, sizeof(Context), 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 uSHA;
+interface
+
+type TSHA1Context = packed record
+ H: array[0..4] of LongWord;
+ Length, CurrLength: Int64;
+ Buf: array[0..63] of byte;
+ end;
+ TSHA1Digest = record
+ case byte of
+ 0: (LongWords: array[0.. 4] of LongWord);
+ 1: ( Words: array[0.. 9] of Word);
+ 2: ( Bytes: array[0..19] of Byte)
+ end;
+
+procedure SHA1Init(var Context: TSHA1Context);
+procedure SHA1Update(var Context: TSHA1Context; Buf: Pointer; Length: LongWord);
+function SHA1Final(Context: TSHA1Context): TSHA1Digest;
+
+implementation
+
+function _bswap(X: LongWord): LongWord; assembler;
+asm
+ bswap eax
+end;
+
+function rol(x: LongWord; y: Byte): LongWord; assembler;
+asm
+ mov cl,dl
+ rol eax,cl
+end;
+
+function Ft(t, b, c, d: LongWord): LongWord;
+begin
+case t of
+ 0..19: Result := (b and c) or ((not b) and d);
+ 20..39: Result := b xor c xor d;
+ 40..59: Result := (b and c) or (b and d) or (c and d);
+ else Result := b xor c xor d;
+ end;
+end;
+
+function Kt(t: Byte): LongWord;
+begin
+ case t of
+ 0..19: Result := $5A827999;
+ 20..39: Result := $6ED9EBA1;
+ 40..59: Result := $8F1BBCDC;
+ else
+ Result := $CA62C1D6
+ end;
+end;
+
+
+procedure SHA1Hash(var Context: TSHA1Context);
+var S: array[0..4 ] of LongWord;
+ W: array[0..79] of LongWord;
+ i, t: LongWord;
+begin
+move(Context.H, S, sizeof(S));
+for i:= 0 to 15 do
+ W[i]:= _bswap(PLongWord(LongWord(@Context.Buf)+i*4)^);
+for i := 16 to 79 do
+ W[i] := rol(W[i - 3] xor W[i - 8] xor W[i - 14] xor W[i - 16], 1);
+for i := 0 to 79 do
+ begin
+ t:= rol(S[0], 5) + Ft(i, S[1], S[2], S[3]) + S[4] + W[i] + Kt(i);
+ S[4]:= S[3];
+ S[3]:= S[2];
+ S[2]:= rol(S[1], 30);
+ S[1]:= S[0];
+ S[0]:= t
+ end;
+for i := 0 to 4 do
+ Context.H[i]:= Context.H[i] + S[i]
+end;
+
+procedure SHA1Init(var Context: TSHA1Context);
+begin
+ with Context do
+ begin
+ Length := 0;
+ CurrLength:= 0;
+ H[0]:= $67452301;
+ H[1]:= $EFCDAB89;
+ H[2]:= $98BADCFE;
+ H[3]:= $10325476;
+ H[4]:= $C3D2E1F0
+ end
+end;
+
+procedure SHA1Update(var Context: TSHA1Context; Buf: Pointer; Length: LongWord);
+var i: integer;
+begin
+for i:= 1 to Length do
+ begin
+ Context.Buf[Context.CurrLength]:= PByte(Buf)^;
+ inc(Context.CurrLength);
+ inc(LongWord(Buf));
+ if Context.CurrLength=64 then
+ begin
+ SHA1Hash(Context);
+ inc(Context.Length, 512);
+ Context.CurrLength:=0
+ end
+ end
+end;
+
+function SHA1Final(Context: TSHA1Context): TSHA1Digest;
+var i: LongWord;
+begin
+Context.Length:= Context.Length + Context.CurrLength shl 3;
+Context.Buf[Context.CurrLength]:= $80;
+inc(Context.CurrLength);
+if Context.CurrLength>56 then
+ begin
+ FillChar(Context.Buf[Context.CurrLength],64-Context.CurrLength,0);
+ Context.CurrLength:= 64;
+ SHA1Hash(Context);
+ Context.CurrLength:=0
+ end;
+FillChar(Context.Buf[Context.CurrLength],56-Context.CurrLength,0);
+for i:= 56 to 63 do
+ Context.Buf[i] := (Context.Length shr ((63 - i) * 8)) and $FF;
+SHA1Hash(Context);
+move(Context.H, Result, sizeof(TSHA1Digest));
+FillChar(Context, sizeof(Context), 0)
+end;
+
+end.
--- a/hedgewars/uServerMisc.pas Mon Aug 22 21:38:06 2005 +0000
+++ b/hedgewars/uServerMisc.pas 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.
- *)
-
-unit uServerMisc;
-interface
-uses Windows;
-const cAppName = 'hwnetserver';
- cAppTitle = 'hwnetserver';
- cProtVer = 1;
-
-procedure OutError(s: shortstring; isFatal: boolean);
-procedure TryDo(b: boolean; msg: shortstring);
-
-var hwndMain: HWND;
- isTerminated: boolean = false;
-
-implementation
-
-procedure OutError(s: shortstring; isFatal: boolean);
-begin
-Writeln(s);
-if isFatal then
- begin
- Writeln('Server will now be terminated');
- Readln;
- halt
- end;
-end;
-
-procedure TryDo(b: boolean; msg: shortstring);
-begin
-if not b then OutError(msg, true)
-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 uServerMisc;
+interface
+uses Windows;
+const cAppName = 'hwnetserver';
+ cAppTitle = 'hwnetserver';
+ cProtVer = 1;
+
+procedure OutError(s: shortstring; isFatal: boolean);
+procedure TryDo(b: boolean; msg: shortstring);
+
+var hwndMain: HWND;
+ isTerminated: boolean = false;
+
+implementation
+
+procedure OutError(s: shortstring; isFatal: boolean);
+begin
+Writeln(s);
+if isFatal then
+ begin
+ Writeln('Server will now be terminated');
+ Readln;
+ halt
+ end;
+end;
+
+procedure TryDo(b: boolean; msg: shortstring);
+begin
+if not b then OutError(msg, true)
+end;
+
+end.
--- a/hedgewars/uSound.pas Mon Aug 22 21:38:06 2005 +0000
+++ b/hedgewars/uSound.pas Tue Aug 23 16:17:53 2005 +0000
@@ -1,111 +1,111 @@
-(*
- * 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 uSound;
-interface
-uses SDLh, uConsts;
-{$INCLUDE options.inc}
-
-procedure InitSound;
-procedure ReleaseSound;
-procedure SoundLoad;
-procedure PlaySound(snd: TSound);
-procedure PlayMusic;
-procedure StopSound(snd: TSound);
-
-implementation
-uses uMisc, uConsole;
-var Mus: PMixMusic;
-
-procedure InitSound;
-begin
-if not isSoundEnabled then exit;
-WriteToConsole('Init sound...');
-isSoundEnabled:= Mix_OpenAudio(22050, $8010, 2, 512) = 0;
-if isSoundEnabled then WriteLnToConsole(msgOK)
- else WriteLnToConsole(msgFailed);
-Mix_VolumeMusic(48)
-end;
-
-procedure ReleaseSound;
-var i: TSound;
-begin
-for i:= Low(TSound) to High(TSound) do
- Mix_FreeChunk(Soundz[i].id);
-Mix_FreeMusic(Mus);
-Mix_CloseAudio
-end;
-
-procedure SoundLoad;
-var i: TSound;
- s: string;
-begin
-if not isSoundEnabled then exit;
-for i:= Low(TSound) to High(TSound) do
- begin
- s:= Pathz[ptSounds] + Soundz[i].FileName;
- WriteToConsole(msgLoading + s + ' ');
- Soundz[i].id:= Mix_LoadWAV_RW(SDL_RWFromFile(PChar(s), 'rb'), 1);
- TryDo(Soundz[i].id <> nil, msgFailed, true);
- WriteLnToConsole(msgOK);
- end;
-
-s:= 'Data/Music/kahvi140a_alexander_chereshnev-illusion.ogg';
-WriteToConsole(msgLoading + s + ' ');
-Mus:= Mix_LoadMUS(PChar(s));
-TryDo(Mus <> nil, msgFailed, false);
-WriteLnToConsole(msgOK)
-end;
-
-procedure PlaySound(snd: TSound);
-begin
-if not isSoundEnabled then exit;
-if Mix_Playing(ord(snd)) = 0 then
- Mix_PlayChannelTimed(ord(snd), Soundz[snd].id, 0, -1)
-end;
-
-procedure StopSound(snd: TSound);
-begin
-if not isSoundEnabled then exit;
-if Mix_Playing(ord(snd)) <> 0 then
- Mix_HaltChannel(ord(snd))
-end;
-
-procedure PlayMusic;
-begin
-if not isSoundEnabled then exit;
-if Mix_PlayingMusic = 0 then
- Mix_PlayMusic(Mus, -1)
-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 uSound;
+interface
+uses SDLh, uConsts;
+{$INCLUDE options.inc}
+
+procedure InitSound;
+procedure ReleaseSound;
+procedure SoundLoad;
+procedure PlaySound(snd: TSound);
+procedure PlayMusic;
+procedure StopSound(snd: TSound);
+
+implementation
+uses uMisc, uConsole;
+var Mus: PMixMusic;
+
+procedure InitSound;
+begin
+if not isSoundEnabled then exit;
+WriteToConsole('Init sound...');
+isSoundEnabled:= Mix_OpenAudio(22050, $8010, 2, 512) = 0;
+if isSoundEnabled then WriteLnToConsole(msgOK)
+ else WriteLnToConsole(msgFailed);
+Mix_VolumeMusic(48)
+end;
+
+procedure ReleaseSound;
+var i: TSound;
+begin
+for i:= Low(TSound) to High(TSound) do
+ Mix_FreeChunk(Soundz[i].id);
+Mix_FreeMusic(Mus);
+Mix_CloseAudio
+end;
+
+procedure SoundLoad;
+var i: TSound;
+ s: string;
+begin
+if not isSoundEnabled then exit;
+for i:= Low(TSound) to High(TSound) do
+ begin
+ s:= Pathz[ptSounds] + Soundz[i].FileName;
+ WriteToConsole(msgLoading + s + ' ');
+ Soundz[i].id:= Mix_LoadWAV_RW(SDL_RWFromFile(PChar(s), 'rb'), 1);
+ TryDo(Soundz[i].id <> nil, msgFailed, true);
+ WriteLnToConsole(msgOK);
+ end;
+
+s:= 'Data/Music/kahvi140a_alexander_chereshnev-illusion.ogg';
+WriteToConsole(msgLoading + s + ' ');
+Mus:= Mix_LoadMUS(PChar(s));
+TryDo(Mus <> nil, msgFailed, false);
+WriteLnToConsole(msgOK)
+end;
+
+procedure PlaySound(snd: TSound);
+begin
+if not isSoundEnabled then exit;
+if Mix_Playing(ord(snd)) = 0 then
+ Mix_PlayChannelTimed(ord(snd), Soundz[snd].id, 0, -1)
+end;
+
+procedure StopSound(snd: TSound);
+begin
+if not isSoundEnabled then exit;
+if Mix_Playing(ord(snd)) <> 0 then
+ Mix_HaltChannel(ord(snd))
+end;
+
+procedure PlayMusic;
+begin
+if not isSoundEnabled then exit;
+if Mix_PlayingMusic = 0 then
+ Mix_PlayMusic(Mus, -1)
+end;
+
+end.
--- a/hedgewars/uStore.pas Mon Aug 22 21:38:06 2005 +0000
+++ b/hedgewars/uStore.pas Tue Aug 23 16:17:53 2005 +0000
@@ -1,594 +1,594 @@
-(*
- * 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 uStore;
-interface
-uses uConsts, uTeams, SDLh;
-{$INCLUDE options.inc}
-
-type PRangeArray = ^TRangeArray;
- TRangeArray = array[byte] of record
- Left, Right: integer;
- end;
-
-procedure StoreInit;
-procedure StoreLoad;
-procedure StoreRelease;
-procedure DrawGear(Stuff : TStuff; X, Y: integer; Surface: PSDL_Surface);
-procedure DrawSpriteFromRect(r: TSDL_Rect; X, Y, Height, Position: integer; Surface: PSDL_Surface);
-procedure DrawSprite (Sprite: TSprite; X, Y, Position: integer; Surface: PSDL_Surface);
-procedure DrawLand (X, Y: integer; Surface: PSDL_Surface);
-procedure DXOutText(X, Y: Integer; Font: THWFont; s: string; Surface: PSDL_Surface);
-procedure DrawCaption(X, Y: integer; Rect: TSDL_Rect; Surface: PSDL_Surface; const fromTempSurf: boolean = false);
-procedure DrawHedgehog(X, Y: integer; Dir: integer; Pos, Step: LongWord; Surface: PSDL_Surface);
-procedure DrawExplosion(X, Y, Radius: integer);
-procedure DrawLineExplosions(ar: PRangeArray; Radius: Longword; y, dY: integer; Count: Byte);
-procedure RenderHealth(var Hedgehog: THedgehog);
-function RenderString(var s: shortstring; Color, Pos: integer): TSDL_Rect;
-procedure AddProgress;
-function LoadImage(filename: string): PSDL_Surface;
-
-var PixelFormat: PSDL_PixelFormat;
- SDLPrimSurface: PSDL_Surface;
-
-implementation
-uses uMisc, uIO, uConsole, uLand;
-
-var StoreSurface,
- TempSurface,
- HHSurface: PSDL_Surface;
-
-procedure DrawExplosion(X, Y, Radius: integer);
-var ty, tx: integer;
- p: integer;
-begin
-for ty:= max(-Radius, -y) to min(radius, 1023 - y) do
- for tx:= max(0, round(x-radius*sqrt(1-sqr(ty/radius)))) to min(2047, round(x+radius*sqrt(1-sqr(ty/radius)))) do
- Land[ty + y, tx]:= 0;
-
-if SDL_MustLock(LandSurface) then
- SDLTry(SDL_LockSurface(LandSurface) >= 0, true);
-
-p:= Longword(LandSurface.pixels);
-case LandSurface.format.BytesPerPixel of
- 1: ;// not supported
- 2: for ty:= max(-Radius, -y) to min(Radius, 1023 - y) do
- for tx:= max(0, round(x-radius*sqrt(1-sqr(ty/radius)))) to min(2047, round(x+radius*sqrt(1-sqr(ty/radius)))) do
- PWord(p + LandSurface.pitch*(y + ty) + tx * 2)^:= 0;
- 3: for ty:= max(-Radius, -y) to min(Radius, 1023 - y) do
- for tx:= max(0, round(x-radius*sqrt(1-sqr(ty/radius)))) to min(2047, round(x+radius*sqrt(1-sqr(ty/radius)))) do
- begin
- PByte(p + LandSurface.pitch*(y + ty) + tx * 3 + 0)^:= 0;
- PByte(p + LandSurface.pitch*(y + ty) + tx * 3 + 1)^:= 0;
- PByte(p + LandSurface.pitch*(y + ty) + tx * 3 + 2)^:= 0;
- end;
- 4: for ty:= max(-Radius, -y) to min(Radius, 1023 - y) do
- for tx:= max(0, round(x-radius*sqrt(1-sqr(ty/radius)))) to min(2047, round(x+radius*sqrt(1-sqr(ty/radius)))) do
- PLongword(p + LandSurface.pitch*(y + ty) + tx * 4)^:= 0;
- end;
-
-inc(Radius, 4);
-
-case LandSurface.format.BytesPerPixel of
- 1: ;// not supported
- 2: for ty:= max(-Radius, -y) to min(Radius, 1023 - y) do
- for tx:= max(0, round(x-radius*sqrt(1-sqr(ty/radius)))) to min(2047, round(x+radius*sqrt(1-sqr(ty/radius)))) do
- if PWord(p + LandSurface.pitch*(y + ty) + tx * 2)^ <> 0 then
- PWord(p + LandSurface.pitch*(y + ty) + tx * 2)^:= cExplosionBorderColor;
- 3: for ty:= max(-Radius, -y) to min(Radius, 1023 - y) do
- for tx:= max(0, round(x-radius*sqrt(1-sqr(ty/radius)))) to min(2047, round(x+radius*sqrt(1-sqr(ty/radius)))) do
- if (PByte(p + LandSurface.pitch*(y + ty) + tx * 3 + 0)^ <> 0)
- or (PByte(p + LandSurface.pitch*(y + ty) + tx * 3 + 1)^ <> 0)
- or (PByte(p + LandSurface.pitch*(y + ty) + tx * 3 + 2)^ <> 0)
- then begin
- PByte(p + LandSurface.pitch*(y + ty) + tx * 3 + 0)^:= cExplosionBorderColor and $FF;
- PByte(p + LandSurface.pitch*(y + ty) + tx * 3 + 1)^:= (cExplosionBorderColor shr 8) and $FF;
- PByte(p + LandSurface.pitch*(y + ty) + tx * 3 + 2)^:= (cExplosionBorderColor shr 16);
- end;
- 4: for ty:= max(-Radius, -y) to min(Radius, 1023 - y) do
- for tx:= max(0, round(x-radius*sqrt(1-sqr(ty/radius)))) to min(2047, round(x+radius*sqrt(1-sqr(ty/radius)))) do
- if PLongword(p + LandSurface.pitch*(y + ty) + tx * 4)^ <> 0 then
- PLongword(p + LandSurface.pitch*(y + ty) + tx * 4)^:= cExplosionBorderColor;
- end;
-
-if SDL_MustLock(LandSurface) then
- SDL_UnlockSurface(LandSurface);
-
-SDL_UpdateRect(LandSurface, X - Radius, Y - Radius, Radius * 2, Radius * 2)
-end;
-
-procedure DrawLineExplosions(ar: PRangeArray; Radius: Longword; y, dY: integer; Count: Byte);
-var tx, ty, i, p: integer;
-begin
-if SDL_MustLock(LandSurface) then
- SDL_LockSurface(LandSurface);
-
-p:= Longword(LandSurface.pixels);
-for i:= 0 to Pred(Count) do
- begin
- case LandSurface.format.BytesPerPixel of
- 1: ;
- 2: for ty:= max(-Radius, -y) to min(Radius, 1023 - y) do
- for tx:= max(0, round(ar[i].Left - radius*sqrt(1-sqr(ty/radius)))) to min(2047, round(ar[i].Right + radius*sqrt(1-sqr(ty/radius)))) do
- PWord(p + LandSurface.pitch*(y + ty) + tx * 2)^:= 0;
- 3: for ty:= max(-Radius, -y) to min(Radius, 1023 - y) do
- for tx:= max(0, round(ar[i].Left - radius*sqrt(1-sqr(ty/radius)))) to min(2047, round(ar[i].Right + radius*sqrt(1-sqr(ty/radius)))) do
- begin
- PByte(p + LandSurface.pitch*(y + ty) + tx * 3 + 0)^:= 0;
- PByte(p + LandSurface.pitch*(y + ty) + tx * 3 + 1)^:= 0;
- PByte(p + LandSurface.pitch*(y + ty) + tx * 3 + 2)^:= 0;
- end;
- 4: for ty:= max(-Radius, -y) to min(Radius, 1023 - y) do
- for tx:= max(0, round(ar[i].Left - radius*sqrt(1-sqr(ty/radius)))) to min(2047, round(ar[i].Right + radius*sqrt(1-sqr(ty/radius)))) do
- PLongword(p + LandSurface.pitch*(y + ty) + tx * 4)^:= 0;
- end;
- inc(y, dY)
- end;
-
-inc(Radius, 4);
-dec(y, Count*dY);
-
-for i:= 0 to Pred(Count) do
- begin
- case LandSurface.format.BytesPerPixel of
- 1: ;
- 2: for ty:= max(-Radius, -y) to min(Radius, 1023 - y) do
- for tx:= max(0, round(ar[i].Left - radius*sqrt(1-sqr(ty/radius)))) to min(2047, round(ar[i].Right + radius*sqrt(1-sqr(ty/radius)))) do
- if PWord(p + LandSurface.pitch*(y + ty) + tx * 2)^ <> 0 then
- PWord(p + LandSurface.pitch*(y + ty) + tx * 2)^:= cExplosionBorderColor;
- 3: for ty:= max(-Radius, -y) to min(Radius, 1023 - y) do
- for tx:= max(0, round(ar[i].Left - radius*sqrt(1-sqr(ty/radius)))) to min(2047, round(ar[i].Right + radius*sqrt(1-sqr(ty/radius)))) do
- if (PByte(p + LandSurface.pitch*(y + ty) + tx * 3 + 0)^ <> 0)
- or (PByte(p + LandSurface.pitch*(y + ty) + tx * 3 + 1)^ <> 0)
- or (PByte(p + LandSurface.pitch*(y + ty) + tx * 3 + 2)^ <> 0)
- then begin
- PByte(p + LandSurface.pitch*(y + ty) + tx * 3 + 0)^:= cExplosionBorderColor and $FF;
- PByte(p + LandSurface.pitch*(y + ty) + tx * 3 + 1)^:= (cExplosionBorderColor shr 8) and $FF;
- PByte(p + LandSurface.pitch*(y + ty) + tx * 3 + 2)^:= (cExplosionBorderColor shr 16);
- end;
- 4: for ty:= max(-Radius, -y) to min(Radius, 1023 - y) do
- for tx:= max(0, round(ar[i].Left - radius*sqrt(1-sqr(ty/radius)))) to min(2047, round(ar[i].Right + radius*sqrt(1-sqr(ty/radius)))) do
- if PLongword(p + LandSurface.pitch*(y + ty) + tx * 4)^ <> 0 then
- PLongword(p + LandSurface.pitch*(y + ty) + tx * 4)^:= cExplosionBorderColor;
- end;
- inc(y, dY)
- end;
-
-if SDL_MustLock(LandSurface) then
- SDL_UnlockSurface(LandSurface);
-end;
-
-procedure StoreInit;
-begin
-StoreSurface := SDL_CreateRGBSurface(SDL_HWSURFACE, 576, 1024, cBits, PixelFormat.RMask, PixelFormat.GMask, PixelFormat.BMask, 0);
-TryDo( StoreSurface <> nil, errmsgCreateSurface + ': store' , true);
-
-TempSurface := SDL_CreateRGBSurface(SDL_HWSURFACE, 724, 320, cBits, PixelFormat.RMask, PixelFormat.GMask, PixelFormat.BMask, 0);
-TryDo( TempSurface <> nil, errmsgCreateSurface + ': temp' , true);
-
-TryDo(SDL_SetColorKey( StoreSurface, SDL_SRCCOLORKEY or SDL_RLEACCEL, 0) = 0, errmsgTransparentSet, true);
-//TryDo(SDL_SetColorKey(SpriteSurface, SDL_SRCCOLORKEY or SDL_RLEACCEL, 0) = 0, errmsgTransparentSet, true);
-TryDo(SDL_SetColorKey( TempSurface, SDL_SRCCOLORKEY or SDL_RLEACCEL, 0) = 0, errmsgTransparentSet, true);
-end;
-
-procedure LoadToSurface(Filename: String; Surface: PSDL_Surface; X, Y: integer);
-var tmpsurf: PSDL_Surface;
- rr: TSDL_Rect;
-begin
- tmpsurf:= LoadImage(Filename);
- rr.x:= X;
- rr.y:= Y;
- SDL_UpperBlit(tmpsurf, nil, Surface, @rr);
- SDL_FreeSurface(tmpsurf);
-end;
-
-function WriteInRoundRect(Surface: PSDL_Surface; X, Y: integer; Color: LongWord; Font: THWFont; s: string): TSDL_Rect;
-var w, h: integer;
- tmpsurf: PSDL_Surface;
- clr: TSDL_Color;
-begin
-TTF_SizeText(Fontz[Font].Handle, PChar(s), w, h);
-Result.x:= X;
-Result.y:= Y;
-Result.w:= w + 6;
-Result.h:= h + 6;
-SDL_FillRect(Surface, @Result, 0);
-Result.w:= 1;
-Result.y:= Y + 1;
-Result.h:= h + 4;
-SDL_FillRect(Surface, @Result, cWhiteColor);
-Result.x:= X + w + 5;
-SDL_FillRect(Surface, @Result, cWhiteColor);
-Result.x:= X + 1;
-Result.w:= w + 4;
-Result.y:= Y;
-Result.h:= 1;
-SDL_FillRect(Surface, @Result, cWhiteColor);
-Result.y:= Y + h + 5;
-SDL_FillRect(Surface, @Result, cWhiteColor);
-Result.x:= X + 1;
-Result.y:= Y + 1;
-Result.h:= h + 4;
-SDL_FillRect(Surface, @Result, cColorNearBlack);
-SDL_GetRGB(Color, Surface.format, @clr.r, @clr.g, @clr.b);
-tmpsurf:= TTF_RenderText_Blended(Fontz[Font].Handle, PChar(s), clr);
-Result.x:= X + 3;
-Result.y:= Y + 3;
-SDL_UpperBlit(tmpsurf, nil, Surface, @Result);
-SDL_FreeSurface(tmpsurf);
-Result.x:= X;
-Result.y:= Y;
-Result.w:= w + 6;
-Result.h:= h + 6
-end;
-
-procedure StoreLoad;
-var i: TStuff;
- ii: TSprite;
- fi: THWFont;
- s: string;
- tmpsurf: PSDL_Surface;
-
- procedure WriteNames(Font: THWFont);
- var Team: PTeam;
- i: integer;
- r: TSDL_Rect;
- begin
- r.x:= 0;
- r.y:= 272;
- Team:= TeamsList;
- while Team<>nil do
- begin
- r.w:= 1968;
- r:= WriteInRoundRect(StoreSurface, r.x, r.y, Team.Color, Font, Team.TeamName);
- Team.NameRect:= r;
- inc(r.y, r.h);
- for i:= 0 to 7 do
- if Team.Hedgehogs[i].Gear<>nil then
- begin
- r:= WriteInRoundRect(StoreSurface, r.x, r.y, Team.Color, Font, Team.Hedgehogs[i].Name);
- Team.Hedgehogs[i].NameRect:= r;
- inc(r.y, r.h)
- end;
- Team:= Team.Next
- end;
- end;
-
- procedure MakeCrossHairs;
- var Team: PTeam;
- r: TSDL_Rect;
- tmpsurf: PSDL_Surface;
- s: string;
- TransColor: Longword;
- begin
- r.x:= 0;
- r.y:= 256;
- r.w:= 16;
- r.h:= 16;
- s:= Pathz[ptGraphics] + cCHFileName;
- WriteToConsole(msgLoading + s + ' ');
- tmpsurf:= IMG_Load(PChar(s));
- TryDo(tmpsurf <> nil, msgFailed, true);
- WriteLnToConsole(msgOK);
- TransColor:= SDL_MapRGB(tmpsurf.format, $FF, $FF, $FF);
- TryDo(SDL_SetColorKey(tmpsurf, SDL_SRCCOLORKEY, TransColor) = 0, errmsgTransparentSet, true);
-
- Team:= TeamsList;
- while Team<>nil do
- begin
- SDL_FillRect(StoreSurface, @r, Team.Color);
- SDL_UpperBlit(tmpsurf, nil, StoreSurface, @r);
- Team.CrossHairRect:= r;
- inc(r.x, 16);
- Team:= Team.Next
- end;
-
- SDL_FreeSurface(tmpsurf)
- end;
-
- procedure InitHealth;
- var p: PTeam;
- i, t: integer;
- begin
- p:= TeamsList;
- t:= 0;
- while p <> nil do
- begin
- for i:= 0 to cMaxHHIndex do
- if p.Hedgehogs[i].Gear <> nil then
- begin
- p.Hedgehogs[i].HealthRect.y:= t;
- RenderHealth(p.Hedgehogs[i]);
- inc(t, p.Hedgehogs[i].HealthRect.h)
- end;
- p:= p.Next
- end
- end;
-
- procedure LoadGraves;
- var p: PTeam;
- l: integer;
- begin
- p:= TeamsList;
- l:= 512;
- while p <> nil do
- begin
- dec(l, 32);
- if p.GraveName = '' then p.GraveName:= 'Simple';
- LoadToSurface(Pathz[ptGraves] + p.GraveName + '.png', StoreSurface, l, 512);
- p.GraveRect.x:= l;
- p.GraveRect.y:= 512;
- p.GraveRect.w:= 32;
- p.GraveRect.h:= 256;
- p:= p.Next
- end
- end;
-
- procedure GetSkyColor;
- var p: Longword;
- begin
- if SDL_MustLock(StoreSurface) then
- SDLTry(SDL_LockSurface(StoreSurface) >= 0, true);
- p:= Longword(StoreSurface.pixels) + Word(StuffPoz[sSky].x) * StoreSurface.format.BytesPerPixel;
- case StoreSurface.format.BytesPerPixel of
- 1: cSkyColor:= PByte(p)^;
- 2: cSkyColor:= PWord(p)^;
- 3: cSkyColor:= (PByte(p)^) or (PByte(p + 1)^ shl 8) or (PByte(p + 2)^ shl 16);
- 4: cSkyColor:= PLongword(p)^;
- end;
- if SDL_MustLock(StoreSurface) then
- SDL_UnlockSurface(StoreSurface)
- end;
-
- procedure GetExplosionBorderColor;
- var f: textfile;
- c: integer;
- begin
- s:= Pathz[ptThemeCurrent] + cThemeCFGFilename;
- WriteToConsole(msgLoading + s + ' ');
- AssignFile(f, s);
- {$I-}
- Reset(f);
- Readln(f, s);
- Closefile(f);
- {$I+}
- TryDo(IOResult = 0, msgFailed, true);
- WriteLnToConsole(msgOK);
- val(s, cExplosionBorderColor, c);
- if cFullScreen then
- cExplosionBorderColor:= SDL_MapRGB(PixelFormat, (cExplosionBorderColor shr 16) and $FF,
- (cExplosionBorderColor shr 8) and $FF,
- cExplosionBorderColor and $FF)
- else
- cExplosionBorderColor:= SDL_MapRGB(LandSurface.format, (cExplosionBorderColor shr 16) and $FF,
- (cExplosionBorderColor shr 8) and $FF,
- cExplosionBorderColor and $FF)
- end;
-
-begin
-for fi:= Low(THWFont) to High(THWFont) do
- with Fontz[fi] do
- begin
- s:= Pathz[ptFonts] + Name;
- WriteToConsole(msgLoading + s + ' ');
- Handle:= TTF_OpenFont(PChar(s), Height);
- TryDo(Handle <> nil, msgFailed, true);
- WriteLnToConsole(msgOK)
- end;
-AddProgress;
-s:= Pathz[ptMapCurrent] + cLandFileName;
-WriteToConsole(msgLoading + s + ' '); // загружаем текущее поле
-//tmpsurf:= IMG_Load(PChar(s));
-tmpsurf:= LandSurface;
-TryDo(tmpsurf <> nil, msgFailed, true);
-if cFullScreen then
- begin
- LandSurface:= SDL_DisplayFormat(tmpsurf);
- SDL_FreeSurface(tmpsurf);
- end else LandSurface:= tmpsurf;
-TryDo(SDL_SetColorKey(LandSurface, SDL_SRCCOLORKEY or SDL_RLEACCEL, 0) = 0, errmsgTransparentSet, true);
-WriteLnToConsole(msgOK);
-
-GetExplosionBorderColor;
-
-AddProgress;
-for i:= Low(TStuff) to High(TStuff) do
- LoadToSurface(Pathz[StuffLoadData[i].Path] + StuffLoadData[i].FileName, StoreSurface, StuffPoz[i].x, StuffPoz[i].y);
-
-AddProgress;
-WriteNames(fnt16);
-MakeCrosshairs;
-LoadGraves;
-
-GetSkyColor;
-
-AddProgress;
-for ii:= Low(TSprite) to High(TSprite) do
- with SpritesData[ii] do
- begin
- Surface:= LoadImage(Pathz[Path] + FileName);
- TryDo(SDL_SetColorKey(Surface, SDL_SRCCOLORKEY or SDL_RLEACCEL, 0) = 0, errmsgTransparentSet, true)
- end;
-
-AddProgress;
-tmpsurf:= LoadImage(Pathz[ptGraphics] + cHHFileName);
-HHSurface:= SDL_DisplayFormat(tmpsurf);
-SDL_FreeSurface(tmpsurf);
-TryDo(SDL_SetColorKey(HHSurface, SDL_SRCCOLORKEY or SDL_RLEACCEL, 0) = 0, errmsgTransparentSet, true);
-
-InitHealth;
-
-{$IFDEF DUMP}
-SDL_SaveBMP_RW(LandSurface, SDL_RWFromFile('LandSurface.bmp', 'wb'), 1);
-SDL_SaveBMP_RW(StoreSurface, SDL_RWFromFile('StoreSurface.bmp', 'wb'), 1);
-SDL_SaveBMP_RW(TempSurface, SDL_RWFromFile('TempSurface.bmp', 'wb'), 1);
-{$ENDIF}
-end;
-
-procedure DrawFromRect(X, Y: integer; r: PSDL_Rect; SourceSurface, DestSurface: PSDL_Surface);
-var rr: TSDL_Rect;
-begin
-rr.x:= X;
-rr.y:= Y;
-rr.w:= r.w;
-rr.h:= r.h;
-if SDL_UpperBlit(SourceSurface, r, DestSurface, @rr) < 0 then
- begin
- Writeln('Blit: ', SDL_GetError);
- exit
- end;
-end;
-
-procedure DrawGear(Stuff: TStuff; X, Y: integer; Surface: PSDL_Surface);
-begin
-DrawFromRect(X, Y, @StuffPoz[Stuff], StoreSurface, Surface)
-end;
-
-procedure DrawSpriteFromRect(r: TSDL_Rect; X, Y, Height, Position: integer; Surface: PSDL_Surface);
-begin
-r.y:= r.y + Height * Position;
-r.h:= Height;
-DrawFromRect(X, Y, @r, StoreSurface, Surface)
-end;
-
-procedure DrawSprite(Sprite: TSprite; X, Y, Position: integer; Surface: PSDL_Surface);
-var r: TSDL_Rect;
-begin
-r.x:= 0;
-r.w:= SpritesData[Sprite].Width;
-r.y:= Position * SpritesData[Sprite].Height;
-r.h:= SpritesData[Sprite].Height;
-DrawFromRect(X, Y, @r, SpritesData[Sprite].Surface, Surface)
-end;
-
-procedure DXOutText(X, Y: Integer; Font: THWFont; s: string; Surface: PSDL_Surface);
-var clr: TSDL_Color;
- tmpsurf: PSDL_Surface;
- r: TSDL_Rect;
-begin
-r.x:= X;
-r.y:= Y;
-SDL_GetRGB(cWhiteColor, PixelFormat, @clr.r, @clr.g, @clr.b);
-tmpsurf:= TTF_RenderText_Solid(Fontz[Font].Handle, PChar(s), clr);
-SDL_UpperBlit(tmpsurf, nil, Surface, @r);
-SDL_FreeSurface(tmpsurf)
-end;
-
-procedure DrawLand(X, Y: integer; Surface: PSDL_Surface);
-const r: TSDL_Rect = (x: 0; y: 0; w: 2048; h: 1024);
-begin
-DrawFromRect(X, Y, @r, LandSurface, Surface)
-end;
-
-procedure DrawCaption(X, Y: integer; Rect: TSDL_Rect; Surface: PSDL_Surface; const fromTempSurf: boolean = false);
-begin
-if fromTempSurf then DrawFromRect(X - (Rect.w) div 2, Y, @Rect, TempSurface, Surface)
- else DrawFromRect(X - (Rect.w) div 2, Y, @Rect, StoreSurface, Surface)
-end;
-
-procedure DrawHedgehog(X, Y: integer; Dir: integer; Pos, Step: LongWord; Surface: PSDL_Surface);
-var r: TSDL_Rect;
-begin
-r.x:= Step * 32;
-r.y:= Pos * 32;
-if Dir = -1 then r.x:= cHHSurfaceWidth - 32 - r.x;
-r.w:= 32;
-r.h:= 32;
-DrawFromRect(X, Y, @r, HHSurface, Surface)
-end;
-
-procedure StoreRelease;
-var ii: TSprite;
-begin
-for ii:= Low(TSprite) to High(TSprite) do
- SDL_FreeSurface(SpritesData[ii].Surface);
-SDL_FreeSurface( HHSurface );
-SDL_FreeSurface(TempSurface );
-SDL_FreeSurface(LandSurface );
-SDL_FreeSurface(StoreSurface )
-end;
-
-procedure RenderHealth(var Hedgehog: THedgehog);
-var s: string;
-begin
-str(Hedgehog.Gear.Health, s);
-Hedgehog.HealthRect:= WriteInRoundRect(TempSurface, Hedgehog.HealthRect.x, Hedgehog.HealthRect.y, Hedgehog.Team.Color, fnt16, s);
-if Hedgehog.Gear.Damage > 0 then
- begin
- str(Hedgehog.Gear.Damage, s);
- Hedgehog.HealthTagRect:= WriteInRoundRect(TempSurface, Hedgehog.HealthRect.x + Hedgehog.HealthRect.w, Hedgehog.HealthRect.y, Hedgehog.Team.Color, fnt16, s)
- end;
-end;
-
-function RenderString(var s: shortstring; Color, Pos: integer): TSDL_Rect;
-begin
-Result:= WriteInRoundRect(TempSurface, 64, Pos * Fontz[fntBig].Height, Color, fntBig, s);
-end;
-
-procedure AddProgress;
-const Step: Longword = 0;
- ProgrSurf: PSDL_Surface = nil;
- MaxCalls = 10; // MaxCalls should be the count of calls to AddProgress to prevent memory leakage
-var r: TSDL_Rect;
-begin
-if Step = 0 then
- begin
- WriteToConsole(msgLoading + 'progress sprite... ');
- ProgrSurf:= IMG_Load(PChar(string('Data\Graphics\BigDigits.png')));
- SDLTry(ProgrSurf <> nil, true);
- WriteLnToConsole(msgOK)
- end;
-SDL_FillRect(SDLPrimSurface, nil, 0);
-r.x:= 0;
-r.w:= 32;
-r.h:= 32;
-r.y:= Step * 32;
-DrawFromRect(cScreenWidth div 2 - 16, cScreenHeight div 2 - 16, @r, ProgrSurf, SDLPrimSurface);
-SDL_Flip(SDLPrimSurface);
-inc(Step);
-if Step = MaxCalls then
- begin
- WriteLnToConsole('Freeing progress surface... ');
- SDL_FreeSurface(ProgrSurf)
- end;
-end;
-
-function LoadImage(filename: string): PSDL_Surface;
-begin
-WriteToConsole(msgLoading + filename + '... ');
-Result:= IMG_Load(PChar(filename));
-TryDo(Result <> nil, msgFailed, true);
-WriteLnToConsole(msgOK)
-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 uStore;
+interface
+uses uConsts, uTeams, SDLh;
+{$INCLUDE options.inc}
+
+type PRangeArray = ^TRangeArray;
+ TRangeArray = array[byte] of record
+ Left, Right: integer;
+ end;
+
+procedure StoreInit;
+procedure StoreLoad;
+procedure StoreRelease;
+procedure DrawGear(Stuff : TStuff; X, Y: integer; Surface: PSDL_Surface);
+procedure DrawSpriteFromRect(r: TSDL_Rect; X, Y, Height, Position: integer; Surface: PSDL_Surface);
+procedure DrawSprite (Sprite: TSprite; X, Y, Position: integer; Surface: PSDL_Surface);
+procedure DrawLand (X, Y: integer; Surface: PSDL_Surface);
+procedure DXOutText(X, Y: Integer; Font: THWFont; s: string; Surface: PSDL_Surface);
+procedure DrawCaption(X, Y: integer; Rect: TSDL_Rect; Surface: PSDL_Surface; const fromTempSurf: boolean = false);
+procedure DrawHedgehog(X, Y: integer; Dir: integer; Pos, Step: LongWord; Surface: PSDL_Surface);
+procedure DrawExplosion(X, Y, Radius: integer);
+procedure DrawLineExplosions(ar: PRangeArray; Radius: Longword; y, dY: integer; Count: Byte);
+procedure RenderHealth(var Hedgehog: THedgehog);
+function RenderString(var s: shortstring; Color, Pos: integer): TSDL_Rect;
+procedure AddProgress;
+function LoadImage(filename: string): PSDL_Surface;
+
+var PixelFormat: PSDL_PixelFormat;
+ SDLPrimSurface: PSDL_Surface;
+
+implementation
+uses uMisc, uIO, uConsole, uLand;
+
+var StoreSurface,
+ TempSurface,
+ HHSurface: PSDL_Surface;
+
+procedure DrawExplosion(X, Y, Radius: integer);
+var ty, tx: integer;
+ p: integer;
+begin
+for ty:= max(-Radius, -y) to min(radius, 1023 - y) do
+ for tx:= max(0, round(x-radius*sqrt(1-sqr(ty/radius)))) to min(2047, round(x+radius*sqrt(1-sqr(ty/radius)))) do
+ Land[ty + y, tx]:= 0;
+
+if SDL_MustLock(LandSurface) then
+ SDLTry(SDL_LockSurface(LandSurface) >= 0, true);
+
+p:= Longword(LandSurface.pixels);
+case LandSurface.format.BytesPerPixel of
+ 1: ;// not supported
+ 2: for ty:= max(-Radius, -y) to min(Radius, 1023 - y) do
+ for tx:= max(0, round(x-radius*sqrt(1-sqr(ty/radius)))) to min(2047, round(x+radius*sqrt(1-sqr(ty/radius)))) do
+ PWord(p + LandSurface.pitch*(y + ty) + tx * 2)^:= 0;
+ 3: for ty:= max(-Radius, -y) to min(Radius, 1023 - y) do
+ for tx:= max(0, round(x-radius*sqrt(1-sqr(ty/radius)))) to min(2047, round(x+radius*sqrt(1-sqr(ty/radius)))) do
+ begin
+ PByte(p + LandSurface.pitch*(y + ty) + tx * 3 + 0)^:= 0;
+ PByte(p + LandSurface.pitch*(y + ty) + tx * 3 + 1)^:= 0;
+ PByte(p + LandSurface.pitch*(y + ty) + tx * 3 + 2)^:= 0;
+ end;
+ 4: for ty:= max(-Radius, -y) to min(Radius, 1023 - y) do
+ for tx:= max(0, round(x-radius*sqrt(1-sqr(ty/radius)))) to min(2047, round(x+radius*sqrt(1-sqr(ty/radius)))) do
+ PLongword(p + LandSurface.pitch*(y + ty) + tx * 4)^:= 0;
+ end;
+
+inc(Radius, 4);
+
+case LandSurface.format.BytesPerPixel of
+ 1: ;// not supported
+ 2: for ty:= max(-Radius, -y) to min(Radius, 1023 - y) do
+ for tx:= max(0, round(x-radius*sqrt(1-sqr(ty/radius)))) to min(2047, round(x+radius*sqrt(1-sqr(ty/radius)))) do
+ if PWord(p + LandSurface.pitch*(y + ty) + tx * 2)^ <> 0 then
+ PWord(p + LandSurface.pitch*(y + ty) + tx * 2)^:= cExplosionBorderColor;
+ 3: for ty:= max(-Radius, -y) to min(Radius, 1023 - y) do
+ for tx:= max(0, round(x-radius*sqrt(1-sqr(ty/radius)))) to min(2047, round(x+radius*sqrt(1-sqr(ty/radius)))) do
+ if (PByte(p + LandSurface.pitch*(y + ty) + tx * 3 + 0)^ <> 0)
+ or (PByte(p + LandSurface.pitch*(y + ty) + tx * 3 + 1)^ <> 0)
+ or (PByte(p + LandSurface.pitch*(y + ty) + tx * 3 + 2)^ <> 0)
+ then begin
+ PByte(p + LandSurface.pitch*(y + ty) + tx * 3 + 0)^:= cExplosionBorderColor and $FF;
+ PByte(p + LandSurface.pitch*(y + ty) + tx * 3 + 1)^:= (cExplosionBorderColor shr 8) and $FF;
+ PByte(p + LandSurface.pitch*(y + ty) + tx * 3 + 2)^:= (cExplosionBorderColor shr 16);
+ end;
+ 4: for ty:= max(-Radius, -y) to min(Radius, 1023 - y) do
+ for tx:= max(0, round(x-radius*sqrt(1-sqr(ty/radius)))) to min(2047, round(x+radius*sqrt(1-sqr(ty/radius)))) do
+ if PLongword(p + LandSurface.pitch*(y + ty) + tx * 4)^ <> 0 then
+ PLongword(p + LandSurface.pitch*(y + ty) + tx * 4)^:= cExplosionBorderColor;
+ end;
+
+if SDL_MustLock(LandSurface) then
+ SDL_UnlockSurface(LandSurface);
+
+SDL_UpdateRect(LandSurface, X - Radius, Y - Radius, Radius * 2, Radius * 2)
+end;
+
+procedure DrawLineExplosions(ar: PRangeArray; Radius: Longword; y, dY: integer; Count: Byte);
+var tx, ty, i, p: integer;
+begin
+if SDL_MustLock(LandSurface) then
+ SDL_LockSurface(LandSurface);
+
+p:= Longword(LandSurface.pixels);
+for i:= 0 to Pred(Count) do
+ begin
+ case LandSurface.format.BytesPerPixel of
+ 1: ;
+ 2: for ty:= max(-Radius, -y) to min(Radius, 1023 - y) do
+ for tx:= max(0, round(ar[i].Left - radius*sqrt(1-sqr(ty/radius)))) to min(2047, round(ar[i].Right + radius*sqrt(1-sqr(ty/radius)))) do
+ PWord(p + LandSurface.pitch*(y + ty) + tx * 2)^:= 0;
+ 3: for ty:= max(-Radius, -y) to min(Radius, 1023 - y) do
+ for tx:= max(0, round(ar[i].Left - radius*sqrt(1-sqr(ty/radius)))) to min(2047, round(ar[i].Right + radius*sqrt(1-sqr(ty/radius)))) do
+ begin
+ PByte(p + LandSurface.pitch*(y + ty) + tx * 3 + 0)^:= 0;
+ PByte(p + LandSurface.pitch*(y + ty) + tx * 3 + 1)^:= 0;
+ PByte(p + LandSurface.pitch*(y + ty) + tx * 3 + 2)^:= 0;
+ end;
+ 4: for ty:= max(-Radius, -y) to min(Radius, 1023 - y) do
+ for tx:= max(0, round(ar[i].Left - radius*sqrt(1-sqr(ty/radius)))) to min(2047, round(ar[i].Right + radius*sqrt(1-sqr(ty/radius)))) do
+ PLongword(p + LandSurface.pitch*(y + ty) + tx * 4)^:= 0;
+ end;
+ inc(y, dY)
+ end;
+
+inc(Radius, 4);
+dec(y, Count*dY);
+
+for i:= 0 to Pred(Count) do
+ begin
+ case LandSurface.format.BytesPerPixel of
+ 1: ;
+ 2: for ty:= max(-Radius, -y) to min(Radius, 1023 - y) do
+ for tx:= max(0, round(ar[i].Left - radius*sqrt(1-sqr(ty/radius)))) to min(2047, round(ar[i].Right + radius*sqrt(1-sqr(ty/radius)))) do
+ if PWord(p + LandSurface.pitch*(y + ty) + tx * 2)^ <> 0 then
+ PWord(p + LandSurface.pitch*(y + ty) + tx * 2)^:= cExplosionBorderColor;
+ 3: for ty:= max(-Radius, -y) to min(Radius, 1023 - y) do
+ for tx:= max(0, round(ar[i].Left - radius*sqrt(1-sqr(ty/radius)))) to min(2047, round(ar[i].Right + radius*sqrt(1-sqr(ty/radius)))) do
+ if (PByte(p + LandSurface.pitch*(y + ty) + tx * 3 + 0)^ <> 0)
+ or (PByte(p + LandSurface.pitch*(y + ty) + tx * 3 + 1)^ <> 0)
+ or (PByte(p + LandSurface.pitch*(y + ty) + tx * 3 + 2)^ <> 0)
+ then begin
+ PByte(p + LandSurface.pitch*(y + ty) + tx * 3 + 0)^:= cExplosionBorderColor and $FF;
+ PByte(p + LandSurface.pitch*(y + ty) + tx * 3 + 1)^:= (cExplosionBorderColor shr 8) and $FF;
+ PByte(p + LandSurface.pitch*(y + ty) + tx * 3 + 2)^:= (cExplosionBorderColor shr 16);
+ end;
+ 4: for ty:= max(-Radius, -y) to min(Radius, 1023 - y) do
+ for tx:= max(0, round(ar[i].Left - radius*sqrt(1-sqr(ty/radius)))) to min(2047, round(ar[i].Right + radius*sqrt(1-sqr(ty/radius)))) do
+ if PLongword(p + LandSurface.pitch*(y + ty) + tx * 4)^ <> 0 then
+ PLongword(p + LandSurface.pitch*(y + ty) + tx * 4)^:= cExplosionBorderColor;
+ end;
+ inc(y, dY)
+ end;
+
+if SDL_MustLock(LandSurface) then
+ SDL_UnlockSurface(LandSurface);
+end;
+
+procedure StoreInit;
+begin
+StoreSurface := SDL_CreateRGBSurface(SDL_HWSURFACE, 576, 1024, cBits, PixelFormat.RMask, PixelFormat.GMask, PixelFormat.BMask, 0);
+TryDo( StoreSurface <> nil, errmsgCreateSurface + ': store' , true);
+
+TempSurface := SDL_CreateRGBSurface(SDL_HWSURFACE, 724, 320, cBits, PixelFormat.RMask, PixelFormat.GMask, PixelFormat.BMask, 0);
+TryDo( TempSurface <> nil, errmsgCreateSurface + ': temp' , true);
+
+TryDo(SDL_SetColorKey( StoreSurface, SDL_SRCCOLORKEY or SDL_RLEACCEL, 0) = 0, errmsgTransparentSet, true);
+//TryDo(SDL_SetColorKey(SpriteSurface, SDL_SRCCOLORKEY or SDL_RLEACCEL, 0) = 0, errmsgTransparentSet, true);
+TryDo(SDL_SetColorKey( TempSurface, SDL_SRCCOLORKEY or SDL_RLEACCEL, 0) = 0, errmsgTransparentSet, true);
+end;
+
+procedure LoadToSurface(Filename: String; Surface: PSDL_Surface; X, Y: integer);
+var tmpsurf: PSDL_Surface;
+ rr: TSDL_Rect;
+begin
+ tmpsurf:= LoadImage(Filename);
+ rr.x:= X;
+ rr.y:= Y;
+ SDL_UpperBlit(tmpsurf, nil, Surface, @rr);
+ SDL_FreeSurface(tmpsurf);
+end;
+
+function WriteInRoundRect(Surface: PSDL_Surface; X, Y: integer; Color: LongWord; Font: THWFont; s: string): TSDL_Rect;
+var w, h: integer;
+ tmpsurf: PSDL_Surface;
+ clr: TSDL_Color;
+begin
+TTF_SizeText(Fontz[Font].Handle, PChar(s), w, h);
+Result.x:= X;
+Result.y:= Y;
+Result.w:= w + 6;
+Result.h:= h + 6;
+SDL_FillRect(Surface, @Result, 0);
+Result.w:= 1;
+Result.y:= Y + 1;
+Result.h:= h + 4;
+SDL_FillRect(Surface, @Result, cWhiteColor);
+Result.x:= X + w + 5;
+SDL_FillRect(Surface, @Result, cWhiteColor);
+Result.x:= X + 1;
+Result.w:= w + 4;
+Result.y:= Y;
+Result.h:= 1;
+SDL_FillRect(Surface, @Result, cWhiteColor);
+Result.y:= Y + h + 5;
+SDL_FillRect(Surface, @Result, cWhiteColor);
+Result.x:= X + 1;
+Result.y:= Y + 1;
+Result.h:= h + 4;
+SDL_FillRect(Surface, @Result, cColorNearBlack);
+SDL_GetRGB(Color, Surface.format, @clr.r, @clr.g, @clr.b);
+tmpsurf:= TTF_RenderText_Blended(Fontz[Font].Handle, PChar(s), clr);
+Result.x:= X + 3;
+Result.y:= Y + 3;
+SDL_UpperBlit(tmpsurf, nil, Surface, @Result);
+SDL_FreeSurface(tmpsurf);
+Result.x:= X;
+Result.y:= Y;
+Result.w:= w + 6;
+Result.h:= h + 6
+end;
+
+procedure StoreLoad;
+var i: TStuff;
+ ii: TSprite;
+ fi: THWFont;
+ s: string;
+ tmpsurf: PSDL_Surface;
+
+ procedure WriteNames(Font: THWFont);
+ var Team: PTeam;
+ i: integer;
+ r: TSDL_Rect;
+ begin
+ r.x:= 0;
+ r.y:= 272;
+ Team:= TeamsList;
+ while Team<>nil do
+ begin
+ r.w:= 1968;
+ r:= WriteInRoundRect(StoreSurface, r.x, r.y, Team.Color, Font, Team.TeamName);
+ Team.NameRect:= r;
+ inc(r.y, r.h);
+ for i:= 0 to 7 do
+ if Team.Hedgehogs[i].Gear<>nil then
+ begin
+ r:= WriteInRoundRect(StoreSurface, r.x, r.y, Team.Color, Font, Team.Hedgehogs[i].Name);
+ Team.Hedgehogs[i].NameRect:= r;
+ inc(r.y, r.h)
+ end;
+ Team:= Team.Next
+ end;
+ end;
+
+ procedure MakeCrossHairs;
+ var Team: PTeam;
+ r: TSDL_Rect;
+ tmpsurf: PSDL_Surface;
+ s: string;
+ TransColor: Longword;
+ begin
+ r.x:= 0;
+ r.y:= 256;
+ r.w:= 16;
+ r.h:= 16;
+ s:= Pathz[ptGraphics] + cCHFileName;
+ WriteToConsole(msgLoading + s + ' ');
+ tmpsurf:= IMG_Load(PChar(s));
+ TryDo(tmpsurf <> nil, msgFailed, true);
+ WriteLnToConsole(msgOK);
+ TransColor:= SDL_MapRGB(tmpsurf.format, $FF, $FF, $FF);
+ TryDo(SDL_SetColorKey(tmpsurf, SDL_SRCCOLORKEY, TransColor) = 0, errmsgTransparentSet, true);
+
+ Team:= TeamsList;
+ while Team<>nil do
+ begin
+ SDL_FillRect(StoreSurface, @r, Team.Color);
+ SDL_UpperBlit(tmpsurf, nil, StoreSurface, @r);
+ Team.CrossHairRect:= r;
+ inc(r.x, 16);
+ Team:= Team.Next
+ end;
+
+ SDL_FreeSurface(tmpsurf)
+ end;
+
+ procedure InitHealth;
+ var p: PTeam;
+ i, t: integer;
+ begin
+ p:= TeamsList;
+ t:= 0;
+ while p <> nil do
+ begin
+ for i:= 0 to cMaxHHIndex do
+ if p.Hedgehogs[i].Gear <> nil then
+ begin
+ p.Hedgehogs[i].HealthRect.y:= t;
+ RenderHealth(p.Hedgehogs[i]);
+ inc(t, p.Hedgehogs[i].HealthRect.h)
+ end;
+ p:= p.Next
+ end
+ end;
+
+ procedure LoadGraves;
+ var p: PTeam;
+ l: integer;
+ begin
+ p:= TeamsList;
+ l:= 512;
+ while p <> nil do
+ begin
+ dec(l, 32);
+ if p.GraveName = '' then p.GraveName:= 'Simple';
+ LoadToSurface(Pathz[ptGraves] + p.GraveName + '.png', StoreSurface, l, 512);
+ p.GraveRect.x:= l;
+ p.GraveRect.y:= 512;
+ p.GraveRect.w:= 32;
+ p.GraveRect.h:= 256;
+ p:= p.Next
+ end
+ end;
+
+ procedure GetSkyColor;
+ var p: Longword;
+ begin
+ if SDL_MustLock(StoreSurface) then
+ SDLTry(SDL_LockSurface(StoreSurface) >= 0, true);
+ p:= Longword(StoreSurface.pixels) + Word(StuffPoz[sSky].x) * StoreSurface.format.BytesPerPixel;
+ case StoreSurface.format.BytesPerPixel of
+ 1: cSkyColor:= PByte(p)^;
+ 2: cSkyColor:= PWord(p)^;
+ 3: cSkyColor:= (PByte(p)^) or (PByte(p + 1)^ shl 8) or (PByte(p + 2)^ shl 16);
+ 4: cSkyColor:= PLongword(p)^;
+ end;
+ if SDL_MustLock(StoreSurface) then
+ SDL_UnlockSurface(StoreSurface)
+ end;
+
+ procedure GetExplosionBorderColor;
+ var f: textfile;
+ c: integer;
+ begin
+ s:= Pathz[ptThemeCurrent] + cThemeCFGFilename;
+ WriteToConsole(msgLoading + s + ' ');
+ AssignFile(f, s);
+ {$I-}
+ Reset(f);
+ Readln(f, s);
+ Closefile(f);
+ {$I+}
+ TryDo(IOResult = 0, msgFailed, true);
+ WriteLnToConsole(msgOK);
+ val(s, cExplosionBorderColor, c);
+ if cFullScreen then
+ cExplosionBorderColor:= SDL_MapRGB(PixelFormat, (cExplosionBorderColor shr 16) and $FF,
+ (cExplosionBorderColor shr 8) and $FF,
+ cExplosionBorderColor and $FF)
+ else
+ cExplosionBorderColor:= SDL_MapRGB(LandSurface.format, (cExplosionBorderColor shr 16) and $FF,
+ (cExplosionBorderColor shr 8) and $FF,
+ cExplosionBorderColor and $FF)
+ end;
+
+begin
+for fi:= Low(THWFont) to High(THWFont) do
+ with Fontz[fi] do
+ begin
+ s:= Pathz[ptFonts] + Name;
+ WriteToConsole(msgLoading + s + ' ');
+ Handle:= TTF_OpenFont(PChar(s), Height);
+ TryDo(Handle <> nil, msgFailed, true);
+ WriteLnToConsole(msgOK)
+ end;
+AddProgress;
+s:= Pathz[ptMapCurrent] + cLandFileName;
+WriteToConsole(msgLoading + s + ' '); // загружаем текущее поле
+//tmpsurf:= IMG_Load(PChar(s));
+tmpsurf:= LandSurface;
+TryDo(tmpsurf <> nil, msgFailed, true);
+if cFullScreen then
+ begin
+ LandSurface:= SDL_DisplayFormat(tmpsurf);
+ SDL_FreeSurface(tmpsurf);
+ end else LandSurface:= tmpsurf;
+TryDo(SDL_SetColorKey(LandSurface, SDL_SRCCOLORKEY or SDL_RLEACCEL, 0) = 0, errmsgTransparentSet, true);
+WriteLnToConsole(msgOK);
+
+GetExplosionBorderColor;
+
+AddProgress;
+for i:= Low(TStuff) to High(TStuff) do
+ LoadToSurface(Pathz[StuffLoadData[i].Path] + StuffLoadData[i].FileName, StoreSurface, StuffPoz[i].x, StuffPoz[i].y);
+
+AddProgress;
+WriteNames(fnt16);
+MakeCrosshairs;
+LoadGraves;
+
+GetSkyColor;
+
+AddProgress;
+for ii:= Low(TSprite) to High(TSprite) do
+ with SpritesData[ii] do
+ begin
+ Surface:= LoadImage(Pathz[Path] + FileName);
+ TryDo(SDL_SetColorKey(Surface, SDL_SRCCOLORKEY or SDL_RLEACCEL, 0) = 0, errmsgTransparentSet, true)
+ end;
+
+AddProgress;
+tmpsurf:= LoadImage(Pathz[ptGraphics] + cHHFileName);
+HHSurface:= SDL_DisplayFormat(tmpsurf);
+SDL_FreeSurface(tmpsurf);
+TryDo(SDL_SetColorKey(HHSurface, SDL_SRCCOLORKEY or SDL_RLEACCEL, 0) = 0, errmsgTransparentSet, true);
+
+InitHealth;
+
+{$IFDEF DUMP}
+SDL_SaveBMP_RW(LandSurface, SDL_RWFromFile('LandSurface.bmp', 'wb'), 1);
+SDL_SaveBMP_RW(StoreSurface, SDL_RWFromFile('StoreSurface.bmp', 'wb'), 1);
+SDL_SaveBMP_RW(TempSurface, SDL_RWFromFile('TempSurface.bmp', 'wb'), 1);
+{$ENDIF}
+end;
+
+procedure DrawFromRect(X, Y: integer; r: PSDL_Rect; SourceSurface, DestSurface: PSDL_Surface);
+var rr: TSDL_Rect;
+begin
+rr.x:= X;
+rr.y:= Y;
+rr.w:= r.w;
+rr.h:= r.h;
+if SDL_UpperBlit(SourceSurface, r, DestSurface, @rr) < 0 then
+ begin
+ Writeln('Blit: ', SDL_GetError);
+ exit
+ end;
+end;
+
+procedure DrawGear(Stuff: TStuff; X, Y: integer; Surface: PSDL_Surface);
+begin
+DrawFromRect(X, Y, @StuffPoz[Stuff], StoreSurface, Surface)
+end;
+
+procedure DrawSpriteFromRect(r: TSDL_Rect; X, Y, Height, Position: integer; Surface: PSDL_Surface);
+begin
+r.y:= r.y + Height * Position;
+r.h:= Height;
+DrawFromRect(X, Y, @r, StoreSurface, Surface)
+end;
+
+procedure DrawSprite(Sprite: TSprite; X, Y, Position: integer; Surface: PSDL_Surface);
+var r: TSDL_Rect;
+begin
+r.x:= 0;
+r.w:= SpritesData[Sprite].Width;
+r.y:= Position * SpritesData[Sprite].Height;
+r.h:= SpritesData[Sprite].Height;
+DrawFromRect(X, Y, @r, SpritesData[Sprite].Surface, Surface)
+end;
+
+procedure DXOutText(X, Y: Integer; Font: THWFont; s: string; Surface: PSDL_Surface);
+var clr: TSDL_Color;
+ tmpsurf: PSDL_Surface;
+ r: TSDL_Rect;
+begin
+r.x:= X;
+r.y:= Y;
+SDL_GetRGB(cWhiteColor, PixelFormat, @clr.r, @clr.g, @clr.b);
+tmpsurf:= TTF_RenderText_Solid(Fontz[Font].Handle, PChar(s), clr);
+SDL_UpperBlit(tmpsurf, nil, Surface, @r);
+SDL_FreeSurface(tmpsurf)
+end;
+
+procedure DrawLand(X, Y: integer; Surface: PSDL_Surface);
+const r: TSDL_Rect = (x: 0; y: 0; w: 2048; h: 1024);
+begin
+DrawFromRect(X, Y, @r, LandSurface, Surface)
+end;
+
+procedure DrawCaption(X, Y: integer; Rect: TSDL_Rect; Surface: PSDL_Surface; const fromTempSurf: boolean = false);
+begin
+if fromTempSurf then DrawFromRect(X - (Rect.w) div 2, Y, @Rect, TempSurface, Surface)
+ else DrawFromRect(X - (Rect.w) div 2, Y, @Rect, StoreSurface, Surface)
+end;
+
+procedure DrawHedgehog(X, Y: integer; Dir: integer; Pos, Step: LongWord; Surface: PSDL_Surface);
+var r: TSDL_Rect;
+begin
+r.x:= Step * 32;
+r.y:= Pos * 32;
+if Dir = -1 then r.x:= cHHSurfaceWidth - 32 - r.x;
+r.w:= 32;
+r.h:= 32;
+DrawFromRect(X, Y, @r, HHSurface, Surface)
+end;
+
+procedure StoreRelease;
+var ii: TSprite;
+begin
+for ii:= Low(TSprite) to High(TSprite) do
+ SDL_FreeSurface(SpritesData[ii].Surface);
+SDL_FreeSurface( HHSurface );
+SDL_FreeSurface(TempSurface );
+SDL_FreeSurface(LandSurface );
+SDL_FreeSurface(StoreSurface )
+end;
+
+procedure RenderHealth(var Hedgehog: THedgehog);
+var s: string;
+begin
+str(Hedgehog.Gear.Health, s);
+Hedgehog.HealthRect:= WriteInRoundRect(TempSurface, Hedgehog.HealthRect.x, Hedgehog.HealthRect.y, Hedgehog.Team.Color, fnt16, s);
+if Hedgehog.Gear.Damage > 0 then
+ begin
+ str(Hedgehog.Gear.Damage, s);
+ Hedgehog.HealthTagRect:= WriteInRoundRect(TempSurface, Hedgehog.HealthRect.x + Hedgehog.HealthRect.w, Hedgehog.HealthRect.y, Hedgehog.Team.Color, fnt16, s)
+ end;
+end;
+
+function RenderString(var s: shortstring; Color, Pos: integer): TSDL_Rect;
+begin
+Result:= WriteInRoundRect(TempSurface, 64, Pos * Fontz[fntBig].Height, Color, fntBig, s);
+end;
+
+procedure AddProgress;
+const Step: Longword = 0;
+ ProgrSurf: PSDL_Surface = nil;
+ MaxCalls = 10; // MaxCalls should be the count of calls to AddProgress to prevent memory leakage
+var r: TSDL_Rect;
+begin
+if Step = 0 then
+ begin
+ WriteToConsole(msgLoading + 'progress sprite... ');
+ ProgrSurf:= IMG_Load(PChar(string('Data/Graphics/BigDigits.png')));
+ SDLTry(ProgrSurf <> nil, true);
+ WriteLnToConsole(msgOK)
+ end;
+SDL_FillRect(SDLPrimSurface, nil, 0);
+r.x:= 0;
+r.w:= 32;
+r.h:= 32;
+r.y:= Step * 32;
+DrawFromRect(cScreenWidth div 2 - 16, cScreenHeight div 2 - 16, @r, ProgrSurf, SDLPrimSurface);
+SDL_Flip(SDLPrimSurface);
+inc(Step);
+if Step = MaxCalls then
+ begin
+ WriteLnToConsole('Freeing progress surface... ');
+ SDL_FreeSurface(ProgrSurf)
+ end;
+end;
+
+function LoadImage(filename: string): PSDL_Surface;
+begin
+WriteToConsole(msgLoading + filename + '... ');
+Result:= IMG_Load(PChar(filename));
+TryDo(Result <> nil, msgFailed, true);
+WriteLnToConsole(msgOK)
+end;
+
+end.
--- a/hedgewars/uTeams.pas Mon Aug 22 21:38:06 2005 +0000
+++ b/hedgewars/uTeams.pas Tue Aug 23 16:17:53 2005 +0000
@@ -1,268 +1,277 @@
-(*
- * 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 uTeams;
-interface
-uses SDLh, uConsts, uKeys, uGears, uRandom;
-{$INCLUDE options.inc}
-type PHedgehog = ^THedgehog;
- PTeam = ^TTeam;
- PHHAmmo = ^THHAmmo;
- THedgehog = record
- Name: string[15];
- Gear: PGear;
- NameRect, HealthRect, HealthTagRect: TSDL_Rect;
- Ammo: PHHAmmo;
- CurSlot, CurAmmo: LongWord;
- AltSlot, AltAmmo: LongWord;
- Team: PTeam;
- AttacksNum: Longword;
- visStepPos: LongWord;
- BotLevel : LongWord; // 0 - человек
- end;
- THHAmmo = array[0..cMaxSlot, 0..cMaxSlotAmmo] of TAmmo;
- TTeam = record
- Next: PTeam;
- Color: Cardinal;
- TeamName: string[15];
- ExtDriven: boolean;
- Aliases: array[0..cKeyMaxIndex] of shortstring;
- Hedgehogs: array[0..cMaxHHIndex] of THedgehog;
- Ammos: array[0..cMaxHHIndex] of THHAmmo;
- CurrHedgehog: integer;
- NameRect, CrossHairRect, GraveRect: TSDL_Rect;
- GraveName: string;
- FortName: string;
- AttackBar: LongWord;
- end;
-
-var CurrentTeam: PTeam = nil;
- TeamsList: PTeam = nil;
-
-function AddTeam: PTeam;
-procedure ApplyAmmoChanges(Hedgehog: PHedgehog);
-procedure SwitchHedgehog;
-procedure InitTeams;
-procedure OnUsedAmmo(Ammo: PHHAmmo);
-
-implementation
-uses uMisc, uStore, uWorld, uIO, uAIActions;
-
-procedure FreeTeamsList; forward;
-
-procedure SwitchHedgehog;
-var tteam: PTeam;
- th: integer;
-begin
-FreeActionsList;
-TargetPoint.X:= NoPointX;
-if CurrentTeam = nil then OutError('nil Team', true);
-tteam:= CurrentTeam;
-with CurrentTeam.Hedgehogs[CurrentTeam.CurrHedgehog] do
- if Gear <> nil then Gear.Message:= 0;
-
-repeat
- CurrentTeam:= CurrentTeam.Next;
- if CurrentTeam = nil then CurrentTeam:= TeamsList;
- th:= CurrentTeam.CurrHedgehog;
- repeat
- CurrentTeam.CurrHedgehog:= Succ(CurrentTeam.CurrHedgehog) mod cMaxHHIndex;
- until (CurrentTeam.Hedgehogs[CurrentTeam.CurrHedgehog].Gear <> nil) or (CurrentTeam.CurrHedgehog = th)
-until (CurrentTeam.Hedgehogs[CurrentTeam.CurrHedgehog].Gear <> nil) or (CurrentTeam = tteam);
-
-if (CurrentTeam = tteam) then
- begin
- if GameType = gmtDemo then
- begin
- SendIPC('q');
- GameState:= gsExit;
- exit
- end else OutError('There''s only one team on map!', true);
- end;
-with CurrentTeam.Hedgehogs[CurrentTeam.CurrHedgehog] do
- begin
- AttacksNum:= 0;
- with Gear^ do
- begin
- State:= State or gstHHDriven;
- Active:= true
- end;
- FollowGear:= Gear
- end;
-ResetKbd;
-cWindSpeed:= (GetRandom * 2 - 1) * cMaxWindSpeed;
-{$IFDEF DEBUGFILE}AddFileLog('Wind = '+FloatToStr(cWindSpeed));{$ENDIF}
-ApplyAmmoChanges(@CurrentTeam.Hedgehogs[CurrentTeam.CurrHedgehog]);
-TurnTimeLeft:= cHedgehogTurnTime
-end;
-
-procedure SetFirstTurnHedgehog;
-var i: integer;
-begin
-if CurrentTeam=nil then OutError('nil Team (SetFirstTurnHedgehog)', true);
-i:= 0;
-while (i<cMaxHHIndex)and(CurrentTeam.Hedgehogs[i].Gear=nil) do inc(i);
-if CurrentTeam.Hedgehogs[i].Gear = nil then OutError(errmsgIncorrectUse + ' (sfth)', true);
-CurrentTeam.CurrHedgehog:= i;
-end;
-
-function AddTeam: PTeam;
-begin
-try
- New(Result);
-except Result:= nil; OutError(errmsgDynamicVar, true) end;
-FillChar(Result^, sizeof(TTeam), 0);
-Result.AttackBar:= 1;
-if TeamsList = nil then TeamsList:= Result
- else begin
- Result.Next:= TeamsList;
- TeamsList:= Result
- end;
-CurrentTeam:= Result
-end;
-
-procedure FreeTeamsList;
-var t, tt: PTeam;
-begin
-tt:= TeamsList;
-TeamsList:= nil;
-while tt<>nil do
- begin
- t:= tt;
- tt:= tt.Next;
- try
- Dispose(t)
- except OutError(errmsgDynamicVar) end;
- end;
-end;
-
-procedure InitTeams;
-var p: PTeam;
- i: integer;
-begin
-p:= TeamsList;
-while p <> nil do
- begin
- for i:= 0 to cMaxHHIndex do
- if p.Hedgehogs[i].Gear <> nil then
- begin
- p.Ammos[i][0, 0]:= Ammoz[amGrenade].Ammo;
- p.Ammos[i][0, 1]:= Ammoz[amUFO].Ammo;
- p.Ammos[i][1, 0]:= Ammoz[amBazooka].Ammo;
- p.Ammos[i][2, 0]:= Ammoz[amShotgun].Ammo;
- p.Ammos[i][3, 0]:= Ammoz[amPickHammer].Ammo;
- p.Ammos[i][3, 1]:= Ammoz[amRope].Ammo;
- p.Ammos[i][4, 0]:= Ammoz[amSkip].Ammo;
- p.Hedgehogs[i].Gear.Health:= 100;
- p.Hedgehogs[i].Ammo:= @p.Ammos[0]
- {0 - общее на всех оружие, i - у каждого своё
- можно группировать ёжиков, чтобы у каждой группы было своё оружие}
- end;
- p:= p.Next
- end;
-SetFirstTurnHedgehog;
-end;
-
-procedure ApplyAmmoChanges(Hedgehog: PHedgehog);
-var s: shortstring;
-begin
-with Hedgehog^ do
- begin
- if Ammo[CurSlot, CurAmmo].Count = 0 then
- begin
- CurAmmo:= 0;
- while (CurAmmo <= cMaxSlotAmmo) and (Ammo[CurSlot, CurAmmo].Count = 0) do inc(CurAmmo)
- end;
-
-with Ammo[CurSlot, CurAmmo] do
- begin
- s:= Ammoz[AmmoType].Name;
- if Count <> AMMO_INFINITE then
- s:= s + ' (' + IntToStr(Count) + ')';
- if (Propz and ammoprop_Timerable) <> 0 then
- s:= s + ', ' + inttostr(Timer div 1000) + ' sec';
- AddCaption(s, Team.Color, capgrpAmmoinfo);
- if (Propz and ammoprop_NeedTarget) <> 0
- then begin
- Gear.State:= Gear.State or gstHHChooseTarget;
- isCursorVisible:= true
- end else begin
- Gear.State:= Gear.State and not gstHHChooseTarget;
- AdjustMPoint;
- isCursorVisible:= false
- end
- end
- end
-end;
-
-procedure PackAmmo(Ammo: PHHAmmo; Slot: integer);
-var ami: integer;
- b: boolean;
-begin
- repeat
- b:= false;
- ami:= 0;
- while (not b) and (ami < cMaxSlotAmmo) do
- if (Ammo[slot, ami].Count = 0)
- and (Ammo[slot, ami + 1].Count > 0) then b:= true
- else inc(ami);
- if b then // есть пустое место
- begin
- Ammo[slot, ami]:= Ammo[slot, ami + 1]
- end
- until not b;
-end;
-
-procedure OnUsedAmmo(Ammo: PHHAmmo);
-var s, a: Longword;
-begin
-with CurrentTeam.Hedgehogs[CurrentTeam.CurrHedgehog] do
- begin
- if CurAmmoGear = nil then begin s:= CurSlot; a:= CurAmmo end
- else begin s:= AltSlot; a:= AltAmmo end;
- with Ammo[s, a] do
- if Count <> AMMO_INFINITE then
- begin
- dec(Count);
- if Count = 0 then PackAmmo(Ammo, CurSlot)
- end
- end
-end;
-
-initialization
-
-finalization
-
-FreeTeamsList
-
-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 uTeams;
+interface
+uses SDLh, uConsts, uKeys, uGears, uRandom;
+{$INCLUDE options.inc}
+type PHedgehog = ^THedgehog;
+ PTeam = ^TTeam;
+ PHHAmmo = ^THHAmmo;
+ THedgehog = record
+ Name: string[15];
+ Gear: PGear;
+ NameRect, HealthRect, HealthTagRect: TSDL_Rect;
+ Ammo: PHHAmmo;
+ CurSlot, CurAmmo: LongWord;
+ AltSlot, AltAmmo: LongWord;
+ Team: PTeam;
+ AttacksNum: Longword;
+ visStepPos: LongWord;
+ BotLevel : LongWord; // 0 - человек
+ end;
+ THHAmmo = array[0..cMaxSlot, 0..cMaxSlotAmmo] of TAmmo;
+ TTeam = record
+ Next: PTeam;
+ Color: Cardinal;
+ TeamName: string[15];
+ ExtDriven: boolean;
+ Aliases: array[0..cKeyMaxIndex] of shortstring;
+ Hedgehogs: array[0..cMaxHHIndex] of THedgehog;
+ Ammos: array[0..cMaxHHIndex] of THHAmmo;
+ CurrHedgehog: integer;
+ NameRect, CrossHairRect, GraveRect: TSDL_Rect;
+ GraveName: string;
+ FortName: string;
+ AttackBar: LongWord;
+ end;
+
+var CurrentTeam: PTeam = nil;
+ TeamsList: PTeam = nil;
+
+function AddTeam: PTeam;
+procedure ApplyAmmoChanges(Hedgehog: PHedgehog);
+procedure SwitchHedgehog;
+procedure InitTeams;
+procedure OnUsedAmmo(Ammo: PHHAmmo);
+function TeamSize(p: PTeam): Longword;
+
+implementation
+uses uMisc, uStore, uWorld, uIO, uAIActions;
+
+procedure FreeTeamsList; forward;
+
+procedure SwitchHedgehog;
+var tteam: PTeam;
+ th: integer;
+begin
+FreeActionsList;
+TargetPoint.X:= NoPointX;
+if CurrentTeam = nil then OutError('nil Team', true);
+tteam:= CurrentTeam;
+with CurrentTeam.Hedgehogs[CurrentTeam.CurrHedgehog] do
+ if Gear <> nil then Gear.Message:= 0;
+
+repeat
+ CurrentTeam:= CurrentTeam.Next;
+ if CurrentTeam = nil then CurrentTeam:= TeamsList;
+ th:= CurrentTeam.CurrHedgehog;
+ repeat
+ CurrentTeam.CurrHedgehog:= Succ(CurrentTeam.CurrHedgehog) mod cMaxHHIndex;
+ until (CurrentTeam.Hedgehogs[CurrentTeam.CurrHedgehog].Gear <> nil) or (CurrentTeam.CurrHedgehog = th)
+until (CurrentTeam.Hedgehogs[CurrentTeam.CurrHedgehog].Gear <> nil) or (CurrentTeam = tteam);
+
+if (CurrentTeam = tteam) then
+ begin
+ if GameType = gmtDemo then
+ begin
+ SendIPC('q');
+ GameState:= gsExit;
+ exit
+ end else OutError('There''s only one team on map!', true);
+ end;
+with CurrentTeam.Hedgehogs[CurrentTeam.CurrHedgehog] do
+ begin
+ AttacksNum:= 0;
+ with Gear^ do
+ begin
+ State:= State or gstHHDriven;
+ Active:= true
+ end;
+ FollowGear:= Gear
+ end;
+ResetKbd;
+cWindSpeed:= (GetRandom * 2 - 1) * cMaxWindSpeed;
+{$IFDEF DEBUGFILE}AddFileLog('Wind = '+FloatToStr(cWindSpeed));{$ENDIF}
+ApplyAmmoChanges(@CurrentTeam.Hedgehogs[CurrentTeam.CurrHedgehog]);
+TurnTimeLeft:= cHedgehogTurnTime
+end;
+
+procedure SetFirstTurnHedgehog;
+var i: integer;
+begin
+if CurrentTeam=nil then OutError('nil Team (SetFirstTurnHedgehog)', true);
+i:= 0;
+while (i<cMaxHHIndex)and(CurrentTeam.Hedgehogs[i].Gear=nil) do inc(i);
+if CurrentTeam.Hedgehogs[i].Gear = nil then OutError(errmsgIncorrectUse + ' (sfth)', true);
+CurrentTeam.CurrHedgehog:= i;
+end;
+
+function AddTeam: PTeam;
+begin
+try
+ New(Result);
+except Result:= nil; OutError(errmsgDynamicVar, true) end;
+FillChar(Result^, sizeof(TTeam), 0);
+Result.AttackBar:= 1;
+if TeamsList = nil then TeamsList:= Result
+ else begin
+ Result.Next:= TeamsList;
+ TeamsList:= Result
+ end;
+CurrentTeam:= Result
+end;
+
+procedure FreeTeamsList;
+var t, tt: PTeam;
+begin
+tt:= TeamsList;
+TeamsList:= nil;
+while tt<>nil do
+ begin
+ t:= tt;
+ tt:= tt.Next;
+ try
+ Dispose(t)
+ except OutError(errmsgDynamicVar) end;
+ end;
+end;
+
+procedure InitTeams;
+var p: PTeam;
+ i: integer;
+begin
+p:= TeamsList;
+while p <> nil do
+ begin
+ for i:= 0 to cMaxHHIndex do
+ if p.Hedgehogs[i].Gear <> nil then
+ begin
+ p.Ammos[i][0, 0]:= Ammoz[amGrenade].Ammo;
+ p.Ammos[i][0, 1]:= Ammoz[amUFO].Ammo;
+ p.Ammos[i][1, 0]:= Ammoz[amBazooka].Ammo;
+ p.Ammos[i][2, 0]:= Ammoz[amShotgun].Ammo;
+ p.Ammos[i][3, 0]:= Ammoz[amPickHammer].Ammo;
+ p.Ammos[i][3, 1]:= Ammoz[amRope].Ammo;
+ p.Ammos[i][4, 0]:= Ammoz[amSkip].Ammo;
+ p.Hedgehogs[i].Gear.Health:= 100;
+ p.Hedgehogs[i].Ammo:= @p.Ammos[0]
+ {0 - общее на всех оружие, i - у каждого своё
+ можно группировать ёжиков, чтобы у каждой группы было своё оружие}
+ end;
+ p:= p.Next
+ end;
+SetFirstTurnHedgehog;
+end;
+
+procedure ApplyAmmoChanges(Hedgehog: PHedgehog);
+var s: shortstring;
+begin
+with Hedgehog^ do
+ begin
+ if Ammo[CurSlot, CurAmmo].Count = 0 then
+ begin
+ CurAmmo:= 0;
+ while (CurAmmo <= cMaxSlotAmmo) and (Ammo[CurSlot, CurAmmo].Count = 0) do inc(CurAmmo)
+ end;
+
+with Ammo[CurSlot, CurAmmo] do
+ begin
+ s:= Ammoz[AmmoType].Name;
+ if Count <> AMMO_INFINITE then
+ s:= s + ' (' + IntToStr(Count) + ')';
+ if (Propz and ammoprop_Timerable) <> 0 then
+ s:= s + ', ' + inttostr(Timer div 1000) + ' sec';
+ AddCaption(s, Team.Color, capgrpAmmoinfo);
+ if (Propz and ammoprop_NeedTarget) <> 0
+ then begin
+ Gear.State:= Gear.State or gstHHChooseTarget;
+ isCursorVisible:= true
+ end else begin
+ Gear.State:= Gear.State and not gstHHChooseTarget;
+ AdjustMPoint;
+ isCursorVisible:= false
+ end
+ end
+ end
+end;
+
+procedure PackAmmo(Ammo: PHHAmmo; Slot: integer);
+var ami: integer;
+ b: boolean;
+begin
+ repeat
+ b:= false;
+ ami:= 0;
+ while (not b) and (ami < cMaxSlotAmmo) do
+ if (Ammo[slot, ami].Count = 0)
+ and (Ammo[slot, ami + 1].Count > 0) then b:= true
+ else inc(ami);
+ if b then // есть пустое место
+ begin
+ Ammo[slot, ami]:= Ammo[slot, ami + 1]
+ end
+ until not b;
+end;
+
+procedure OnUsedAmmo(Ammo: PHHAmmo);
+var s, a: Longword;
+begin
+with CurrentTeam.Hedgehogs[CurrentTeam.CurrHedgehog] do
+ begin
+ if CurAmmoGear = nil then begin s:= CurSlot; a:= CurAmmo end
+ else begin s:= AltSlot; a:= AltAmmo end;
+ with Ammo[s, a] do
+ if Count <> AMMO_INFINITE then
+ begin
+ dec(Count);
+ if Count = 0 then PackAmmo(Ammo, CurSlot)
+ end
+ end
+end;
+
+function TeamSize(p: PTeam): Longword;
+var i: Longword;
+begin
+Result:= 0;
+for i:= 0 to cMaxHHIndex do
+ if p.Hedgehogs[i].Gear <> nil then inc(Result)
+end;
+
+initialization
+
+finalization
+
+FreeTeamsList
+
+end.
--- a/hedgewars/uWorld.pas Mon Aug 22 21:38:06 2005 +0000
+++ b/hedgewars/uWorld.pas Tue Aug 23 16:17:53 2005 +0000
@@ -1,338 +1,338 @@
-(*
- * 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 uWorld;
-interface
-uses SDLh, uGears;
-{$INCLUDE options.inc}
-const WorldDx: integer = -512;
- WorldDy: integer = -256;
-
-procedure InitWorld;
-procedure DrawWorld(Lag: integer; Surface: PSDL_Surface);
-procedure AddCaption(s: shortstring; Color, Group: LongWord);
-procedure MoveWorld;
-procedure AdjustMPoint;
-
-{$IFDEF COUNTTICKS}
-var cntTicks: LongWord;
-{$ENDIF}
-var FollowGear: PGear = nil;
-
-implementation
-uses uStore, uMisc, uConsts, uTeams, uIO;
-const RealTicks: Longword = 0;
- Frames: Longword = 0;
- FPS: Longword = 0;
- CountTicks: Longword = 0;
- prevPoint: TPoint = (X: 0; Y: 0);
-
-type TCaptionStr = record
- r: TSDL_Rect;
- StorePos,
- Group,
- EndTime: LongWord;
- end;
-
-var cWaterSprCount: integer;
- Captions: array[0..Pred(cMaxCaptions)] of TCaptionStr;
-
-procedure InitWorld;
-begin
-cLandYShift:= cWaterLine + 64;
-cWaterSprCount:= 1 + cScreenWidth div (SpritesData[sprWater].Width)
-end;
-
-procedure DrawWorld(Lag: integer; Surface: PSDL_Surface);
-var i, t: integer;
- r: TSDL_Rect;
- team: PTeam;
-begin
-// синее небо
-inc(RealTicks, Lag);
-r.h:= WorldDy;
-if r.h > 0 then
- begin
- if r.h > cScreenHeight then r.h:= cScreenHeight;
- r.x:= 0;
- r.y:= 0;
- r.w:= cScreenWidth;
- SDL_FillRect(Surface, @r, cSkyColor)
- end;
-// задний фон
-for i:= 0 to (cScreenWidth shr 6) do
- DrawGear(sSky, i*64, WorldDy, Surface);
-
-for i:= -1 to 3 do // горизонт
- DrawGear(sHorizont, i * 512 + (((WorldDx * 3) div 5) and $1FF), cWaterLine - 256 + WorldDy, Surface);
-
-// волны
-{$WARNINGS OFF}
-for i:= -1 to cWaterSprCount do DrawSprite(sprWater, i * 256 + ((WorldDx + (RealTicks shr 6) ) and $FF), cWaterLine + WorldDy - 40, (((GameTicks shr 7) + 2) mod 12), Surface);
-for i:= -1 to cWaterSprCount do DrawSprite(sprWater, i * 256 + ((WorldDx - (RealTicks shr 6) + 192) and $FF), cWaterLine + WorldDy - 30, (((GameTicks shr 7) + 8) mod 12), Surface);
-{$WARNINGS ON}
-
-// поле
-DrawLand(WorldDx, WorldDy, Surface);
-// вода
-r.y:= WorldDy + cWaterLine + 32;
-if r.y < cScreenHeight then
- begin
- r.h:= cScreenHeight - r.y;
- r.x:= 0;
- r.w:= cScreenWidth;
- SDL_FillRect(Surface, @r, cWaterColor)
- end;
-
-DrawGears(Surface);
-
-team:= TeamsList;
-while team<>nil do
- begin
- for i:= 0 to 7 do
- with team.Hedgehogs[i] do
- if Gear<>nil then
- if Gear.State = 0 then
- begin // ёжик не находится под управлением
- DrawCaption( round(Gear.X) + WorldDx,
- round(Gear.Y) - cHHHalfHeight - 30 + WorldDy,
- HealthRect, Surface, true);
- DrawCaption( round(Gear.X) + WorldDx,
- round(Gear.Y) - cHHHalfHeight - 54 + WorldDy,
- NameRect, Surface);
-// DrawCaption( round(Gear.X) + WorldDx,
-// round(Gear.Y) - Gear.HalfHeight - 60 + WorldDy,
-// Team.NameRect, Surface);
- end else // ёжик, которым счас управляем
- begin
- if (Gear.State and (gstMoving or gstAttacked or gstDrowning or gstFalling))=0 then // рисуем прицел и, если бот думает, знак вопроса
- if (Gear.State and gstHHThinking) <> 0 then
- DrawGear(sQuestion, Round(Gear.X) - 10 + WorldDx, Round(Gear.Y) - cHHHalfHeight - 34 + WorldDy, Surface)
- else
- DrawCaption(Round(Gear.X + Sign(Gear.dX) * Sin(Gear.Angle*pi/cMaxAngle)*60) + WorldDx,
- Round(Gear.Y - Cos(Gear.Angle*pi/cMaxAngle)*60) + WorldDy - 5,
- Team.CrossHairRect, Surface)
- end;
- team:= team.Next
- end;
-
-// волны
-{$WARNINGS OFF}
-for i:= -1 to cWaterSprCount do DrawSprite(sprWater, i * 256 + ((WorldDx + (RealTicks shr 6) + 64) and $FF), cWaterLine + WorldDy - 20, (((GameTicks shr 7) + 4 ) mod 12), Surface);
-for i:= -1 to cWaterSprCount do DrawSprite(sprWater, i * 256 + ((WorldDx - (RealTicks shr 6) + 128) and $FF), cWaterLine + WorldDy - 10, (((GameTicks shr 7) + 10) mod 12), Surface);
-for i:= -1 to cWaterSprCount do DrawSprite(sprWater, i * 256 + ((WorldDx + (RealTicks shr 6) ) and $FF), cWaterLine + WorldDy , (((GameTicks shr 7) + 6 ) mod 12), Surface);
-{$WARNINGS ON}
-
-if TurnTimeLeft <> 0 then
- begin
- i:= Succ(Pred(TurnTimeLeft) div 1000);
- if i>99 then t:= 112
- else if i>9 then t:= 96
- else t:= 80;
- DrawSprite(sprFrame, t, cScreenHeight - 48, 1, Surface);
- while i > 0 do
- begin
- dec(t, 32);
- DrawSprite(sprBigDigit, t, cScreenHeight - 48, i mod 10, Surface);
- i:= i div 10
- end;
- DrawSprite(sprFrame, t - 4, cScreenHeight - 48, 0, Surface);
- end;
-if CurrentTeam <> nil then
- case AttackBar of
- 1: begin
- r:= StuffPoz[sPowerBar];
- {$WARNINGS OFF}
- r.w:= (CurrentTeam.Hedgehogs[CurrentTeam.CurrHedgehog].Gear.Power * 256) div cPowerDivisor;
- {$WARNINGS ON}
- DrawSpriteFromRect(r, cScreenWidth - 272, cScreenHeight - 48, 16, 0, Surface);
- end;
- end;
-
-// Указатель на цель
-if TargetPoint.X <> NoPointX then DrawSprite(sprTargetP, TargetPoint.X + WorldDx - 16, TargetPoint.Y + WorldDy - 16, 0, Surface);
-
-// Captions
-i:= 0;
-while (i < cMaxCaptions) do
- begin
- with Captions[i] do
- if EndTime > 0 then DrawCaption(cScreenWidth div 2, 8 + i * 32 + cConsoleYAdd, r, Surface, true);
- inc(i)
- end;
-while (Captions[0].EndTime > 0) and (Captions[0].EndTime <= RealTicks) do
- begin
- for i:= 1 to Pred(cMaxCaptions) do
- Captions[Pred(i)]:= Captions[i];
- Captions[Pred(cMaxCaptions)].EndTime:= 0
- end;
-
-// Указание на лаг
-if isInLag then DrawSprite(sprLag, 32, 32 + cConsoleYAdd, (RealTicks shr 7) mod 7, Surface);
-
-// Курсор
-if isCursorVisible then DrawSprite(sprArrow, CursorPoint.X, CursorPoint.Y, (RealTicks shr 6) mod 8, Surface);
-
-{$IFDEF COUNTTICKS}
-DXOutText(10, 10, fnt16, inttostr(cntTicks), Surface);
-{$ENDIF}
-
-inc(Frames);
-inc(CountTicks, Lag);
-if CountTicks >= 1000 then
- begin
- FPS:= Frames;
- Frames:= 0;
- CountTicks:= 0;
- end;
-if cShowFPS then DXOutText(cScreenWidth - 50, 10, fnt16, inttostr(FPS) + ' fps', Surface)
-end;
-
-procedure AddCaption(s: shortstring; Color, Group: LongWord);
-var i, t, m, k: LongWord;
-begin
-i:= 0;
-while (i < cMaxCaptions) and (Captions[i].Group <> Group)do inc(i);
-if i < cMaxCaptions then
- begin
- while (i < Pred(cMaxCaptions)) do
- begin
- Captions[i]:= Captions[Succ(i)];
- inc(i)
- end;
- Captions[Pred(cMaxCaptions)].EndTime:= 0
- end;
-
-if Captions[Pred(cMaxCaptions)].EndTime > 0 then
- begin
- m:= Pred(cMaxCaptions);
- for i:= 1 to m do
- Captions[Pred(i)]:= Captions[i];
- Captions[m].EndTime:= 0
- end else
- begin
- m:= 0;
- while (m < cMaxCaptions)and(Captions[m].EndTime > 0) do inc(m)
- end;
-
-k:= 0;
-for i:= 0 to Pred(cMaxCaptions) do
- for t:= 0 to Pred(cMaxCaptions) do
- if (Captions[t].EndTime > 0)and(Captions[t].StorePos = k) then inc(k);
-
-Captions[m].r:= RenderString(s, Color, k);
-Captions[m].StorePos:= k;
-Captions[m].Group:= Group;
-Captions[m].EndTime:= RealTicks + 1200
-end;
-
-procedure MoveWorld;
-const PrevSentPointTime: LongWord = 0;
-var s: string[9];
-begin
-if not (CurrentTeam.ExtDriven and isCursorVisible) then SDL_GetMouseState(@CursorPoint.X, @CursorPoint.Y);
-
-if (FollowGear <> nil) then
- if abs(CursorPoint.X - prevPoint.X + CursorPoint.Y - prevpoint.Y) > 4 then
- begin
- FollowGear:= nil;
- AdjustMPoint;
- exit
- end
- else begin
- CursorPoint.x:= (CursorPoint.x + (round(FollowGear.X + Sign(FollowGear.dX) * 100) + WorldDx)) div 2;
- CursorPoint.y:= (CursorPoint.y + (round(FollowGear.Y) + WorldDy)) div 2
- end;
-
-if ((CursorPoint.X = prevPoint.X)and(CursorPoint.Y = prevpoint.Y)) then exit;
-
-if isCursorVisible then
- begin
- if (not CurrentTeam.ExtDriven)and(GameTicks >= PrevSentPointTime + cSendCursorPosTime) then
- begin
- s[0]:= #9;
- s[1]:= 'P';
- PInteger(@s[2])^:= CursorPoint.X - WorldDx;
- PInteger(@s[6])^:= CursorPoint.Y - WorldDy;
- SendIPC(s);
- PrevSentPointTime:= GameTicks
- end;
- end;
-if isCursorVisible or (FollowGear <> nil) then
- begin
- if CursorPoint.X < cScreenEdgesDist then
- begin
- WorldDx:= WorldDx - CursorPoint.X + cScreenEdgesDist;
- CursorPoint.X:= cScreenEdgesDist
- end else
- if CursorPoint.X > cScreenWidth - cScreenEdgesDist then
- begin
- WorldDx:= WorldDx - CursorPoint.X + cScreenWidth - cScreenEdgesDist;
- CursorPoint.X:= cScreenWidth - cScreenEdgesDist
- end;
- if CursorPoint.Y < cScreenEdgesDist then
- begin
- WorldDy:= WorldDy - CursorPoint.Y + cScreenEdgesDist;
- CursorPoint.Y:= cScreenEdgesDist
- end else
- if CursorPoint.Y > cScreenHeight - cScreenEdgesDist then
- begin
- WorldDy:= WorldDy - CursorPoint.Y + cScreenHeight - cScreenEdgesDist;
- CursorPoint.Y:= cScreenHeight - cScreenEdgesDist
- end;
- end else
- begin
- WorldDx:= WorldDx - CursorPoint.X + (cScreenWidth shr 1);
- WorldDy:= WorldDy - CursorPoint.Y + (cScreenHeight shr 1);
- CursorPoint.X:= (cScreenWidth shr 1);
- CursorPoint.Y:= (cScreenHeight shr 1);
- end;
-SDL_WarpMouse(CursorPoint.X, CursorPoint.Y);
-prevPoint:= CursorPoint;
-if WorldDy < cScreenHeight - cLandYShift - cVisibleWater then WorldDy:= cScreenHeight - cLandYShift - cVisibleWater;
-if WorldDy > 2048 then WorldDy:= 2048;
-if WorldDx < -2048 then WorldDx:= -2048;
-if WorldDx > cScreenWidth then WorldDx:= cScreenWidth;
-end;
-
-procedure AdjustMPoint;
-begin
-prevPoint.x:= cScreenWidth div 2;
-prevPoint.y:= cScreenHeight div 2;
-SDL_WarpMouse(prevPoint.X, prevPoint.Y);
-end;
-
-initialization
-FillChar(Captions, sizeof(Captions), 0)
-
-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 uWorld;
+interface
+uses SDLh, uGears;
+{$INCLUDE options.inc}
+const WorldDx: integer = -512;
+ WorldDy: integer = -256;
+
+procedure InitWorld;
+procedure DrawWorld(Lag: integer; Surface: PSDL_Surface);
+procedure AddCaption(s: shortstring; Color, Group: LongWord);
+procedure MoveWorld;
+procedure AdjustMPoint;
+
+{$IFDEF COUNTTICKS}
+var cntTicks: LongWord;
+{$ENDIF}
+var FollowGear: PGear = nil;
+
+implementation
+uses uStore, uMisc, uConsts, uTeams, uIO;
+const RealTicks: Longword = 0;
+ Frames: Longword = 0;
+ FPS: Longword = 0;
+ CountTicks: Longword = 0;
+ prevPoint: TPoint = (X: 0; Y: 0);
+
+type TCaptionStr = record
+ r: TSDL_Rect;
+ StorePos,
+ Group,
+ EndTime: LongWord;
+ end;
+
+var cWaterSprCount: integer;
+ Captions: array[0..Pred(cMaxCaptions)] of TCaptionStr;
+
+procedure InitWorld;
+begin
+cLandYShift:= cWaterLine + 64;
+cWaterSprCount:= 1 + cScreenWidth div (SpritesData[sprWater].Width)
+end;
+
+procedure DrawWorld(Lag: integer; Surface: PSDL_Surface);
+var i, t: integer;
+ r: TSDL_Rect;
+ team: PTeam;
+begin
+// синее небо
+inc(RealTicks, Lag);
+r.h:= WorldDy;
+if r.h > 0 then
+ begin
+ if r.h > cScreenHeight then r.h:= cScreenHeight;
+ r.x:= 0;
+ r.y:= 0;
+ r.w:= cScreenWidth;
+ SDL_FillRect(Surface, @r, cSkyColor)
+ end;
+// задний фон
+for i:= 0 to (cScreenWidth shr 6) do
+ DrawGear(sSky, i*64, WorldDy, Surface);
+
+for i:= -1 to 3 do // горизонт
+ DrawGear(sHorizont, i * 512 + (((WorldDx * 3) div 5) and $1FF), cWaterLine - 256 + WorldDy, Surface);
+
+// волны
+{$WARNINGS OFF}
+for i:= -1 to cWaterSprCount do DrawSprite(sprWater, i * 256 + ((WorldDx + (RealTicks shr 6) ) and $FF), cWaterLine + WorldDy - 40, (((GameTicks shr 7) + 2) mod 12), Surface);
+for i:= -1 to cWaterSprCount do DrawSprite(sprWater, i * 256 + ((WorldDx - (RealTicks shr 6) + 192) and $FF), cWaterLine + WorldDy - 30, (((GameTicks shr 7) + 8) mod 12), Surface);
+{$WARNINGS ON}
+
+// поле
+DrawLand(WorldDx, WorldDy, Surface);
+// вода
+r.y:= WorldDy + cWaterLine + 32;
+if r.y < cScreenHeight then
+ begin
+ r.h:= cScreenHeight - r.y;
+ r.x:= 0;
+ r.w:= cScreenWidth;
+ SDL_FillRect(Surface, @r, cWaterColor)
+ end;
+
+DrawGears(Surface);
+
+team:= TeamsList;
+while team<>nil do
+ begin
+ for i:= 0 to 7 do
+ with team.Hedgehogs[i] do
+ if Gear<>nil then
+ if Gear.State = 0 then
+ begin // ёжик не находится под управлением
+ DrawCaption( round(Gear.X) + WorldDx,
+ round(Gear.Y) - cHHHalfHeight - 30 + WorldDy,
+ HealthRect, Surface, true);
+ DrawCaption( round(Gear.X) + WorldDx,
+ round(Gear.Y) - cHHHalfHeight - 54 + WorldDy,
+ NameRect, Surface);
+// DrawCaption( round(Gear.X) + WorldDx,
+// round(Gear.Y) - Gear.HalfHeight - 60 + WorldDy,
+// Team.NameRect, Surface);
+ end else // ёжик, которым счас управляем
+ begin
+ if (Gear.State and (gstMoving or gstAttacked or gstDrowning or gstFalling))=0 then // рисуем прицел и, если бот думает, знак вопроса
+ if (Gear.State and gstHHThinking) <> 0 then
+ DrawGear(sQuestion, Round(Gear.X) - 10 + WorldDx, Round(Gear.Y) - cHHHalfHeight - 34 + WorldDy, Surface)
+ else
+ DrawCaption(Round(Gear.X + Sign(Gear.dX) * Sin(Gear.Angle*pi/cMaxAngle)*60) + WorldDx,
+ Round(Gear.Y - Cos(Gear.Angle*pi/cMaxAngle)*60) + WorldDy - 5,
+ Team.CrossHairRect, Surface)
+ end;
+ team:= team.Next
+ end;
+
+// волны
+{$WARNINGS OFF}
+for i:= -1 to cWaterSprCount do DrawSprite(sprWater, i * 256 + ((WorldDx + (RealTicks shr 6) + 64) and $FF), cWaterLine + WorldDy - 20, (((GameTicks shr 7) + 4 ) mod 12), Surface);
+for i:= -1 to cWaterSprCount do DrawSprite(sprWater, i * 256 + ((WorldDx - (RealTicks shr 6) + 128) and $FF), cWaterLine + WorldDy - 10, (((GameTicks shr 7) + 10) mod 12), Surface);
+for i:= -1 to cWaterSprCount do DrawSprite(sprWater, i * 256 + ((WorldDx + (RealTicks shr 6) ) and $FF), cWaterLine + WorldDy , (((GameTicks shr 7) + 6 ) mod 12), Surface);
+{$WARNINGS ON}
+
+if TurnTimeLeft <> 0 then
+ begin
+ i:= Succ(Pred(TurnTimeLeft) div 1000);
+ if i>99 then t:= 112
+ else if i>9 then t:= 96
+ else t:= 80;
+ DrawSprite(sprFrame, t, cScreenHeight - 48, 1, Surface);
+ while i > 0 do
+ begin
+ dec(t, 32);
+ DrawSprite(sprBigDigit, t, cScreenHeight - 48, i mod 10, Surface);
+ i:= i div 10
+ end;
+ DrawSprite(sprFrame, t - 4, cScreenHeight - 48, 0, Surface);
+ end;
+if CurrentTeam <> nil then
+ case AttackBar of
+ 1: begin
+ r:= StuffPoz[sPowerBar];
+ {$WARNINGS OFF}
+ r.w:= (CurrentTeam.Hedgehogs[CurrentTeam.CurrHedgehog].Gear.Power * 256) div cPowerDivisor;
+ {$WARNINGS ON}
+ DrawSpriteFromRect(r, cScreenWidth - 272, cScreenHeight - 48, 16, 0, Surface);
+ end;
+ end;
+
+// Указатель на цель
+if TargetPoint.X <> NoPointX then DrawSprite(sprTargetP, TargetPoint.X + WorldDx - 16, TargetPoint.Y + WorldDy - 16, 0, Surface);
+
+// Captions
+i:= 0;
+while (i < cMaxCaptions) do
+ begin
+ with Captions[i] do
+ if EndTime > 0 then DrawCaption(cScreenWidth div 2, 8 + i * 32 + cConsoleYAdd, r, Surface, true);
+ inc(i)
+ end;
+while (Captions[0].EndTime > 0) and (Captions[0].EndTime <= RealTicks) do
+ begin
+ for i:= 1 to Pred(cMaxCaptions) do
+ Captions[Pred(i)]:= Captions[i];
+ Captions[Pred(cMaxCaptions)].EndTime:= 0
+ end;
+
+// Указание на лаг
+if isInLag then DrawSprite(sprLag, 32, 32 + cConsoleYAdd, (RealTicks shr 7) mod 7, Surface);
+
+// Курсор
+if isCursorVisible then DrawSprite(sprArrow, CursorPoint.X, CursorPoint.Y, (RealTicks shr 6) mod 8, Surface);
+
+{$IFDEF COUNTTICKS}
+DXOutText(10, 10, fnt16, inttostr(cntTicks), Surface);
+{$ENDIF}
+
+inc(Frames);
+inc(CountTicks, Lag);
+if CountTicks >= 1000 then
+ begin
+ FPS:= Frames;
+ Frames:= 0;
+ CountTicks:= 0;
+ end;
+if cShowFPS then DXOutText(cScreenWidth - 50, 10, fnt16, inttostr(FPS) + ' fps', Surface)
+end;
+
+procedure AddCaption(s: shortstring; Color, Group: LongWord);
+var i, t, m, k: LongWord;
+begin
+i:= 0;
+while (i < cMaxCaptions) and (Captions[i].Group <> Group)do inc(i);
+if i < cMaxCaptions then
+ begin
+ while (i < Pred(cMaxCaptions)) do
+ begin
+ Captions[i]:= Captions[Succ(i)];
+ inc(i)
+ end;
+ Captions[Pred(cMaxCaptions)].EndTime:= 0
+ end;
+
+if Captions[Pred(cMaxCaptions)].EndTime > 0 then
+ begin
+ m:= Pred(cMaxCaptions);
+ for i:= 1 to m do
+ Captions[Pred(i)]:= Captions[i];
+ Captions[m].EndTime:= 0
+ end else
+ begin
+ m:= 0;
+ while (m < cMaxCaptions)and(Captions[m].EndTime > 0) do inc(m)
+ end;
+
+k:= 0;
+for i:= 0 to Pred(cMaxCaptions) do
+ for t:= 0 to Pred(cMaxCaptions) do
+ if (Captions[t].EndTime > 0)and(Captions[t].StorePos = k) then inc(k);
+
+Captions[m].r:= RenderString(s, Color, k);
+Captions[m].StorePos:= k;
+Captions[m].Group:= Group;
+Captions[m].EndTime:= RealTicks + 1200
+end;
+
+procedure MoveWorld;
+const PrevSentPointTime: LongWord = 0;
+var s: string[9];
+begin
+if not (CurrentTeam.ExtDriven and isCursorVisible) then SDL_GetMouseState(@CursorPoint.X, @CursorPoint.Y);
+
+if (FollowGear <> nil) then
+ if abs(CursorPoint.X - prevPoint.X + CursorPoint.Y - prevpoint.Y) > 4 then
+ begin
+ FollowGear:= nil;
+ AdjustMPoint;
+ exit
+ end
+ else begin
+ CursorPoint.x:= (CursorPoint.x + (round(FollowGear.X + Sign(FollowGear.dX) * 100) + WorldDx)) div 2;
+ CursorPoint.y:= (CursorPoint.y + (round(FollowGear.Y) + WorldDy)) div 2
+ end;
+
+if ((CursorPoint.X = prevPoint.X)and(CursorPoint.Y = prevpoint.Y)) then exit;
+
+if isCursorVisible then
+ begin
+ if (not CurrentTeam.ExtDriven)and(GameTicks >= PrevSentPointTime + cSendCursorPosTime) then
+ begin
+ s[0]:= #9;
+ s[1]:= 'P';
+ PInteger(@s[2])^:= CursorPoint.X - WorldDx;
+ PInteger(@s[6])^:= CursorPoint.Y - WorldDy;
+ SendIPC(s);
+ PrevSentPointTime:= GameTicks
+ end;
+ end;
+if isCursorVisible or (FollowGear <> nil) then
+ begin
+ if CursorPoint.X < cScreenEdgesDist then
+ begin
+ WorldDx:= WorldDx - CursorPoint.X + cScreenEdgesDist;
+ CursorPoint.X:= cScreenEdgesDist
+ end else
+ if CursorPoint.X > cScreenWidth - cScreenEdgesDist then
+ begin
+ WorldDx:= WorldDx - CursorPoint.X + cScreenWidth - cScreenEdgesDist;
+ CursorPoint.X:= cScreenWidth - cScreenEdgesDist
+ end;
+ if CursorPoint.Y < cScreenEdgesDist then
+ begin
+ WorldDy:= WorldDy - CursorPoint.Y + cScreenEdgesDist;
+ CursorPoint.Y:= cScreenEdgesDist
+ end else
+ if CursorPoint.Y > cScreenHeight - cScreenEdgesDist then
+ begin
+ WorldDy:= WorldDy - CursorPoint.Y + cScreenHeight - cScreenEdgesDist;
+ CursorPoint.Y:= cScreenHeight - cScreenEdgesDist
+ end;
+ end else
+ begin
+ WorldDx:= WorldDx - CursorPoint.X + (cScreenWidth shr 1);
+ WorldDy:= WorldDy - CursorPoint.Y + (cScreenHeight shr 1);
+ CursorPoint.X:= (cScreenWidth shr 1);
+ CursorPoint.Y:= (cScreenHeight shr 1);
+ end;
+SDL_WarpMouse(CursorPoint.X, CursorPoint.Y);
+prevPoint:= CursorPoint;
+if WorldDy < cScreenHeight - cLandYShift - cVisibleWater then WorldDy:= cScreenHeight - cLandYShift - cVisibleWater;
+if WorldDy > 2048 then WorldDy:= 2048;
+if WorldDx < -2048 then WorldDx:= -2048;
+if WorldDx > cScreenWidth then WorldDx:= cScreenWidth;
+end;
+
+procedure AdjustMPoint;
+begin
+prevPoint.x:= cScreenWidth div 2;
+prevPoint.y:= cScreenHeight div 2;
+SDL_WarpMouse(prevPoint.X, prevPoint.Y);
+end;
+
+initialization
+FillChar(Captions, sizeof(Captions), 0)
+
+end.