Add current sources.
hw, hwserv and runhelper are compilable under Windows and *nix with FreePascal (and use -Od option) and run well on these OSes
Hedge.dpr can be run only in Windows... to be ported
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/COPYING.txt Mon Aug 22 13:35:41 2005 +0000
@@ -0,0 +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
+OF SUCH DAMAGE.
\ No newline at end of file
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/README.txt Mon Aug 22 13:35:41 2005 +0000
@@ -0,0 +1,15 @@
+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"
+(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
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/hedgewars/CCHandlers.inc Mon Aug 22 13:35:41 2005 +0000
@@ -0,0 +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;
+
Binary file hedgewars/Data/Fonts/UN1251N.TTF has changed
Binary file hedgewars/Data/Forts/BarrelhouseL.png has changed
Binary file hedgewars/Data/Forts/BarrelhouseR.png has changed
Binary file hedgewars/Data/Graphics/Arrow.png has changed
Binary file hedgewars/Data/Graphics/BigDigits.png has changed
Binary file hedgewars/Data/Graphics/BlueWater.png has changed
Binary file hedgewars/Data/Graphics/Bomb.png has changed
Binary file hedgewars/Data/Graphics/Clouds.png has changed
Binary file hedgewars/Data/Graphics/Console.png has changed
Binary file hedgewars/Data/Graphics/Crosshair.png has changed
Binary file hedgewars/Data/Graphics/Frame.png has changed
Binary file hedgewars/Data/Graphics/Girder.png has changed
Binary file hedgewars/Data/Graphics/Graves/Bone.png has changed
Binary file hedgewars/Data/Graphics/Graves/Rip.png has changed
Binary file hedgewars/Data/Graphics/Graves/Simple.png has changed
Binary file hedgewars/Data/Graphics/Graves/coffin.png has changed
Binary file hedgewars/Data/Graphics/Grenade.png has changed
Binary file hedgewars/Data/Graphics/Hedgehog.png has changed
Binary file hedgewars/Data/Graphics/Lag.png has changed
Binary file hedgewars/Data/Graphics/PowerBar.png has changed
Binary file hedgewars/Data/Graphics/RopeHook.png has changed
Binary file hedgewars/Data/Graphics/SmokeTrace.png has changed
Binary file hedgewars/Data/Graphics/Targetp.png has changed
Binary file hedgewars/Data/Graphics/UFO.png has changed
Binary file hedgewars/Data/Graphics/thinking.png has changed
Binary file hedgewars/Data/Sounds/explosion.ogg has changed
Binary file hedgewars/Data/Sounds/graveimpact.ogg has changed
Binary file hedgewars/Data/Sounds/grenadeimpact.ogg has changed
Binary file hedgewars/Data/Sounds/shotgunfire.ogg has changed
Binary file hedgewars/Data/Sounds/shotgunreload.ogg has changed
Binary file hedgewars/Data/Sounds/splash.ogg has changed
Binary file hedgewars/Data/Sounds/throwpowerup.ogg has changed
Binary file hedgewars/Data/Sounds/throwrelease.ogg has changed
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/hedgewars/Data/Teams/test.cfg Mon Aug 22 13:35:41 2005 +0000
@@ -0,0 +1,45 @@
+; Конфиг команды
+
+name team "-= ЕЖЫ =-"
+
+name hh0 "Маленький"
+name hh1 "Удаленький"
+name hh2 "Игольчатый"
+name hh3 "Стреляный"
+name hh4 "Ежиха"
+name hh5 "Ежонок"
+name hh6 "Инфернальный"
+name hh7 "X"
+
+bind left "+left"
+bind right "+right"
+bind up "+up"
+bind down "+down"
+
+bind F1 "slot 1"
+bind F2 "slot 2"
+bind F3 "slot 3"
+bind F4 "slot 4"
+bind F5 "slot 5"
+bind F6 "slot 6"
+bind F7 "slot 7"
+bind F8 "slot 8"
+bind F10 "quit"
+
+bind F11 "capture"
+
+bind space "+attack"
+bind return "ljump"
+bind backspace "hjump"
+bind tab "switch"
+
+bind 1 "timer 1"
+bind 2 "timer 2"
+bind 3 "timer 3"
+bind 4 "timer 4"
+bind 5 "timer 5"
+
+bind mousel "put"
+
+grave Bone
+fort Barrelhouse
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/hedgewars/Data/Teams/unC0Rr.cfg Mon Aug 22 13:35:41 2005 +0000
@@ -0,0 +1,46 @@
+; Конфиг команды
+
+name team "C0CuCKAzZz"
+
+name hh0 "Йожык"
+name hh1 "Ёжик"
+name hh2 "Ёжык"
+name hh3 "Йожик"
+name hh4 "Ёжик без ножек"
+name hh5 "Just hedgehog"
+name hh6 "Ёжик без головы"
+name hh7 "Валасатый йож"
+
+bind left "+left"
+bind right "+right"
+bind up "+up"
+bind down "+down"
+
+bind F1 "slot 1"
+bind F2 "slot 2"
+bind F3 "slot 3"
+bind F4 "slot 4"
+bind F5 "slot 5"
+bind F6 "slot 6"
+bind F7 "slot 7"
+bind F8 "slot 8"
+bind F10 "quit"
+
+bind F11 "capture"
+
+bind space "+attack"
+bind return "ljump"
+bind backspace "hjump"
+bind tab "switch"
+
+bind 1 "timer 1"
+bind 2 "timer 2"
+bind 3 "timer 3"
+bind 4 "timer 4"
+bind 5 "timer 5"
+
+bind mousel "put"
+
+grave "coffin"
+
+fort "Barrelhouse"
Binary file hedgewars/Data/Themes/avematan/Border.png has changed
Binary file hedgewars/Data/Themes/avematan/LandTex.png has changed
Binary file hedgewars/Data/Themes/avematan/Sky.png has changed
Binary file hedgewars/Data/Themes/avematan/a.png has changed
Binary file hedgewars/Data/Themes/avematan/e.png has changed
Binary file hedgewars/Data/Themes/avematan/horizont.png has changed
Binary file hedgewars/Data/Themes/avematan/ksi.png has changed
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/hedgewars/Data/Themes/avematan/theme.cfg Mon Aug 22 13:35:41 2005 +0000
@@ -0,0 +1,8 @@
+8388608
+3
+a
+2 65 45
+e
+2 56 33
+ksi
+2 82 17
Binary file hedgewars/Data/Themes/bubbles/Border.png has changed
Binary file hedgewars/Data/Themes/bubbles/LandTex.png has changed
Binary file hedgewars/Data/Themes/bubbles/Sky.png has changed
Binary file hedgewars/Data/Themes/bubbles/horizont.png has changed
Binary file hedgewars/Data/Themes/bubbles/round.png has changed
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/hedgewars/Data/Themes/bubbles/theme.cfg Mon Aug 22 13:35:41 2005 +0000
@@ -0,0 +1,4 @@
+2829989
+1
+round
+2 91 10
\ No newline at end of file
Binary file hedgewars/Data/Themes/ethereal/Border.png has changed
Binary file hedgewars/Data/Themes/ethereal/LandTex.png has changed
Binary file hedgewars/Data/Themes/ethereal/Sky.png has changed
Binary file hedgewars/Data/Themes/ethereal/horizont.png has changed
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/hedgewars/Data/Themes/ethereal/theme.cfg Mon Aug 22 13:35:41 2005 +0000
@@ -0,0 +1,2 @@
+32896
+0
\ No newline at end of file
Binary file hedgewars/Data/Themes/norsk/Border.png has changed
Binary file hedgewars/Data/Themes/norsk/LandTex.png has changed
Binary file hedgewars/Data/Themes/norsk/Sky.png has changed
Binary file hedgewars/Data/Themes/norsk/horizont.png has changed
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/hedgewars/Data/Themes/norsk/theme.cfg Mon Aug 22 13:35:41 2005 +0000
@@ -0,0 +1,2 @@
+32896
+0
\ No newline at end of file
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/hedgewars/Data/Themes/themes.cfg Mon Aug 22 13:35:41 2005 +0000
@@ -0,0 +1,8 @@
+7
+avematan
+bubbles
+ethereal
+norsk
+tibet
+wood
+xtheme
Binary file hedgewars/Data/Themes/tibet/Border.png has changed
Binary file hedgewars/Data/Themes/tibet/LandTex.png has changed
Binary file hedgewars/Data/Themes/tibet/Sky.png has changed
Binary file hedgewars/Data/Themes/tibet/chha.png has changed
Binary file hedgewars/Data/Themes/tibet/horizont.png has changed
Binary file hedgewars/Data/Themes/tibet/ma.png has changed
Binary file hedgewars/Data/Themes/tibet/nga.png has changed
Binary file hedgewars/Data/Themes/tibet/sa.png has changed
Binary file hedgewars/Data/Themes/tibet/ta1.png has changed
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/hedgewars/Data/Themes/tibet/theme.cfg Mon Aug 22 13:35:41 2005 +0000
@@ -0,0 +1,12 @@
+4989440
+5
+chha
+2 65 10
+ma
+2 90 20
+nga
+2 115 8
+sa
+2 100 20
+ta1
+2 61 10
\ No newline at end of file
Binary file hedgewars/Data/Themes/wood/Border.png has changed
Binary file hedgewars/Data/Themes/wood/LandTex.png has changed
Binary file hedgewars/Data/Themes/wood/Sky.png has changed
Binary file hedgewars/Data/Themes/wood/horizont.png has changed
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/hedgewars/Data/Themes/wood/theme.cfg Mon Aug 22 13:35:41 2005 +0000
@@ -0,0 +1,2 @@
+5129753
+0
Binary file hedgewars/Data/Themes/xtheme/Border.png has changed
Binary file hedgewars/Data/Themes/xtheme/LandTex.png has changed
Binary file hedgewars/Data/Themes/xtheme/Sky.png has changed
Binary file hedgewars/Data/Themes/xtheme/horizont.png has changed
Binary file hedgewars/Data/Themes/xtheme/plant1.png has changed
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/hedgewars/Data/Themes/xtheme/theme.cfg Mon Aug 22 13:35:41 2005 +0000
@@ -0,0 +1,4 @@
+8388608
+1
+plant1
+2 37 25
\ No newline at end of file
Binary file hedgewars/Data/front/exit.bmp has changed
Binary file hedgewars/Data/front/playdemo.bmp has changed
Binary file hedgewars/Data/front/settings.bmp has changed
Binary file hedgewars/Data/front/startlocal.bmp has changed
Binary file hedgewars/Data/front/startnet.bmp has changed
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/hedgewars/GSHandlers.inc Mon Aug 22 13:35:41 2005 +0000
@@ -0,0 +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;
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/hedgewars/HHHandlers.inc Mon Aug 22 13:35:41 2005 +0000
@@ -0,0 +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;
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/hedgewars/Hedge.dpr Mon Aug 22 13:35:41 2005 +0000
@@ -0,0 +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.
+
Binary file hedgewars/Hedge.res has changed
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/hedgewars/Makefile Mon Aug 22 13:35:41 2005 +0000
@@ -0,0 +1,3 @@
+fpc-compile:
+ 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
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/hedgewars/SDLh.pas Mon Aug 22 13:35:41 2005 +0000
@@ -0,0 +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.
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/hedgewars/fConsts.pas Mon Aug 22 13:35:41 2005 +0000
@@ -0,0 +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.
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/hedgewars/fGUI.pas Mon Aug 22 13:35:41 2005 +0000
@@ -0,0 +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.
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/hedgewars/fGame.pas Mon Aug 22 13:35:41 2005 +0000
@@ -0,0 +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.
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/hedgewars/fIPC.pas Mon Aug 22 13:35:41 2005 +0000
@@ -0,0 +1,183 @@
+(*
+ * 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);
+if ( bind(hIPCListenSockTCP, myaddrTCP, t) <> 0) then exit;
+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('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.
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/hedgewars/fMisc.pas Mon Aug 22 13:35:41 2005 +0000
@@ -0,0 +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.
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/hedgewars/fNet.pas Mon Aug 22 13:35:41 2005 +0000
@@ -0,0 +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.
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/hedgewars/fOptionsGUI.pas Mon Aug 22 13:35:41 2005 +0000
@@ -0,0 +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.
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/hedgewars/getrevnum.dpr Mon Aug 22 13:35:41 2005 +0000
@@ -0,0 +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.
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/hedgewars/hw.dpr Mon Aug 22 13:35:41 2005 +0000
@@ -0,0 +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
+ GenLandSurface;
+ //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.
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/hedgewars/hwserv.dpr Mon Aug 22 13:35:41 2005 +0000
@@ -0,0 +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.
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/hedgewars/options.inc Mon Aug 22 13:35:41 2005 +0000
@@ -0,0 +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}
+
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/hedgewars/runhelper.dpr Mon Aug 22 13:35:41 2005 +0000
@@ -0,0 +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.
+ *)
+
+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.
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/hedgewars/uAI.pas Mon Aug 22 13:35:41 2005 +0000
@@ -0,0 +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.
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/hedgewars/uAIActions.pas Mon Aug 22 13:35:41 2005 +0000
@@ -0,0 +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.
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/hedgewars/uAIAmmoTests.pas Mon Aug 22 13:35:41 2005 +0000
@@ -0,0 +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.
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/hedgewars/uAIMisc.pas Mon Aug 22 13:35:41 2005 +0000
@@ -0,0 +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.
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/hedgewars/uCollisions.pas Mon Aug 22 13:35:41 2005 +0000
@@ -0,0 +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.
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/hedgewars/uConsole.pas Mon Aug 22 13:35:41 2005 +0000
@@ -0,0 +1,296 @@
+(*
+ * 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('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.
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/hedgewars/uConsts.pas Mon Aug 22 13:35:41 2005 +0000
@@ -0,0 +1,303 @@
+(*
+ * 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;
+
+ 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.
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/hedgewars/uGame.pas Mon Aug 22 13:35:41 2005 +0000
@@ -0,0 +1,93 @@
+(*
+ * 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;
+
+// если тачка слабая, то Lag с каждым кадром стремится в бесконечность
+if Lag > 100 then Lag:= 100;
+
+for i:= 0 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.
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/hedgewars/uGears.pas Mon Aug 22 13:35:41 2005 +0000
@@ -0,0 +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.
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/hedgewars/uIO.pas Mon Aug 22 13:35:41 2005 +0000
@@ -0,0 +1,208 @@
+(*
+ * 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.
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/hedgewars/uKeys.pas Mon Aug 22 13:35:41 2005 +0000
@@ -0,0 +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.
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/hedgewars/uLand.pas Mon Aug 22 13:35:41 2005 +0000
@@ -0,0 +1,502 @@
+(*
+ * 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.
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/hedgewars/uMisc.pas Mon Aug 22 13:35:41 2005 +0000
@@ -0,0 +1,209 @@
+(*
+ * 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;
+ 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.
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/hedgewars/uNet.pas Mon Aug 22 13:35:41 2005 +0000
@@ -0,0 +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.
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/hedgewars/uPlayers.pas Mon Aug 22 13:35:41 2005 +0000
@@ -0,0 +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.
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/hedgewars/uRandom.pas Mon Aug 22 13:35:41 2005 +0000
@@ -0,0 +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.
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/hedgewars/uSHA.pas Mon Aug 22 13:35:41 2005 +0000
@@ -0,0 +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.
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/hedgewars/uServerMisc.pas Mon Aug 22 13:35:41 2005 +0000
@@ -0,0 +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.
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/hedgewars/uSound.pas Mon Aug 22 13:35:41 2005 +0000
@@ -0,0 +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.
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/hedgewars/uStore.pas Mon Aug 22 13:35:41 2005 +0000
@@ -0,0 +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.
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/hedgewars/uTeams.pas Mon Aug 22 13:35:41 2005 +0000
@@ -0,0 +1,268 @@
+(*
+ * 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.
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/hedgewars/uWorld.pas Mon Aug 22 13:35:41 2005 +0000
@@ -0,0 +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.
