# HG changeset patch # User unc0rr # Date 1124717741 0 # Node ID 30f2d1037d5da65660b237d1bd2e37ea6b39f7c8 # Parent 475c0f2f9d17f770440c1ec533a9c48390523ad8 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 diff -r 475c0f2f9d17 -r 30f2d1037d5d COPYING.txt --- /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 diff -r 475c0f2f9d17 -r 30f2d1037d5d README.txt --- /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 + +Fonts +(c) 1995 Gavin Helf , + +Images in Data/Front, Data/Graphics/Graves, +themes "ethereal", "norsk", "wood", "xtheme" +(c) 2005 Alexey Andreev \ No newline at end of file diff -r 475c0f2f9d17 -r 30f2d1037d5d hedgewars/CCHandlers.inc --- /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 + * + * 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; + diff -r 475c0f2f9d17 -r 30f2d1037d5d hedgewars/Data/Fonts/UN1251N.TTF Binary file hedgewars/Data/Fonts/UN1251N.TTF has changed diff -r 475c0f2f9d17 -r 30f2d1037d5d hedgewars/Data/Forts/BarrelhouseL.png Binary file hedgewars/Data/Forts/BarrelhouseL.png has changed diff -r 475c0f2f9d17 -r 30f2d1037d5d hedgewars/Data/Forts/BarrelhouseR.png Binary file hedgewars/Data/Forts/BarrelhouseR.png has changed diff -r 475c0f2f9d17 -r 30f2d1037d5d hedgewars/Data/Graphics/Arrow.png Binary file hedgewars/Data/Graphics/Arrow.png has changed diff -r 475c0f2f9d17 -r 30f2d1037d5d hedgewars/Data/Graphics/BigDigits.png Binary file hedgewars/Data/Graphics/BigDigits.png has changed diff -r 475c0f2f9d17 -r 30f2d1037d5d hedgewars/Data/Graphics/BlueWater.png Binary file hedgewars/Data/Graphics/BlueWater.png has changed diff -r 475c0f2f9d17 -r 30f2d1037d5d hedgewars/Data/Graphics/Bomb.png Binary file hedgewars/Data/Graphics/Bomb.png has changed diff -r 475c0f2f9d17 -r 30f2d1037d5d hedgewars/Data/Graphics/Clouds.png Binary file hedgewars/Data/Graphics/Clouds.png has changed diff -r 475c0f2f9d17 -r 30f2d1037d5d hedgewars/Data/Graphics/Console.png Binary file hedgewars/Data/Graphics/Console.png has changed diff -r 475c0f2f9d17 -r 30f2d1037d5d hedgewars/Data/Graphics/Crosshair.png Binary file hedgewars/Data/Graphics/Crosshair.png has changed diff -r 475c0f2f9d17 -r 30f2d1037d5d hedgewars/Data/Graphics/Frame.png Binary file hedgewars/Data/Graphics/Frame.png has changed diff -r 475c0f2f9d17 -r 30f2d1037d5d hedgewars/Data/Graphics/Girder.png Binary file hedgewars/Data/Graphics/Girder.png has changed diff -r 475c0f2f9d17 -r 30f2d1037d5d hedgewars/Data/Graphics/Graves/Bone.png Binary file hedgewars/Data/Graphics/Graves/Bone.png has changed diff -r 475c0f2f9d17 -r 30f2d1037d5d hedgewars/Data/Graphics/Graves/Rip.png Binary file hedgewars/Data/Graphics/Graves/Rip.png has changed diff -r 475c0f2f9d17 -r 30f2d1037d5d hedgewars/Data/Graphics/Graves/Simple.png Binary file hedgewars/Data/Graphics/Graves/Simple.png has changed diff -r 475c0f2f9d17 -r 30f2d1037d5d hedgewars/Data/Graphics/Graves/coffin.png Binary file hedgewars/Data/Graphics/Graves/coffin.png has changed diff -r 475c0f2f9d17 -r 30f2d1037d5d hedgewars/Data/Graphics/Grenade.png Binary file hedgewars/Data/Graphics/Grenade.png has changed diff -r 475c0f2f9d17 -r 30f2d1037d5d hedgewars/Data/Graphics/Hedgehog.png Binary file hedgewars/Data/Graphics/Hedgehog.png has changed diff -r 475c0f2f9d17 -r 30f2d1037d5d hedgewars/Data/Graphics/Lag.png Binary file hedgewars/Data/Graphics/Lag.png has changed diff -r 475c0f2f9d17 -r 30f2d1037d5d hedgewars/Data/Graphics/PowerBar.png Binary file hedgewars/Data/Graphics/PowerBar.png has changed diff -r 475c0f2f9d17 -r 30f2d1037d5d hedgewars/Data/Graphics/RopeHook.png Binary file hedgewars/Data/Graphics/RopeHook.png has changed diff -r 475c0f2f9d17 -r 30f2d1037d5d hedgewars/Data/Graphics/SmokeTrace.png Binary file hedgewars/Data/Graphics/SmokeTrace.png has changed diff -r 475c0f2f9d17 -r 30f2d1037d5d hedgewars/Data/Graphics/Targetp.png Binary file hedgewars/Data/Graphics/Targetp.png has changed diff -r 475c0f2f9d17 -r 30f2d1037d5d hedgewars/Data/Graphics/UFO.png Binary file hedgewars/Data/Graphics/UFO.png has changed diff -r 475c0f2f9d17 -r 30f2d1037d5d hedgewars/Data/Graphics/thinking.png Binary file hedgewars/Data/Graphics/thinking.png has changed diff -r 475c0f2f9d17 -r 30f2d1037d5d hedgewars/Data/Sounds/explosion.ogg Binary file hedgewars/Data/Sounds/explosion.ogg has changed diff -r 475c0f2f9d17 -r 30f2d1037d5d hedgewars/Data/Sounds/graveimpact.ogg Binary file hedgewars/Data/Sounds/graveimpact.ogg has changed diff -r 475c0f2f9d17 -r 30f2d1037d5d hedgewars/Data/Sounds/grenadeimpact.ogg Binary file hedgewars/Data/Sounds/grenadeimpact.ogg has changed diff -r 475c0f2f9d17 -r 30f2d1037d5d hedgewars/Data/Sounds/shotgunfire.ogg Binary file hedgewars/Data/Sounds/shotgunfire.ogg has changed diff -r 475c0f2f9d17 -r 30f2d1037d5d hedgewars/Data/Sounds/shotgunreload.ogg Binary file hedgewars/Data/Sounds/shotgunreload.ogg has changed diff -r 475c0f2f9d17 -r 30f2d1037d5d hedgewars/Data/Sounds/splash.ogg Binary file hedgewars/Data/Sounds/splash.ogg has changed diff -r 475c0f2f9d17 -r 30f2d1037d5d hedgewars/Data/Sounds/throwpowerup.ogg Binary file hedgewars/Data/Sounds/throwpowerup.ogg has changed diff -r 475c0f2f9d17 -r 30f2d1037d5d hedgewars/Data/Sounds/throwrelease.ogg Binary file hedgewars/Data/Sounds/throwrelease.ogg has changed diff -r 475c0f2f9d17 -r 30f2d1037d5d hedgewars/Data/Teams/test.cfg --- /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 diff -r 475c0f2f9d17 -r 30f2d1037d5d hedgewars/Data/Teams/unC0Rr.cfg --- /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" diff -r 475c0f2f9d17 -r 30f2d1037d5d hedgewars/Data/Themes/avematan/Border.png Binary file hedgewars/Data/Themes/avematan/Border.png has changed diff -r 475c0f2f9d17 -r 30f2d1037d5d hedgewars/Data/Themes/avematan/LandTex.png Binary file hedgewars/Data/Themes/avematan/LandTex.png has changed diff -r 475c0f2f9d17 -r 30f2d1037d5d hedgewars/Data/Themes/avematan/Sky.png Binary file hedgewars/Data/Themes/avematan/Sky.png has changed diff -r 475c0f2f9d17 -r 30f2d1037d5d hedgewars/Data/Themes/avematan/a.png Binary file hedgewars/Data/Themes/avematan/a.png has changed diff -r 475c0f2f9d17 -r 30f2d1037d5d hedgewars/Data/Themes/avematan/e.png Binary file hedgewars/Data/Themes/avematan/e.png has changed diff -r 475c0f2f9d17 -r 30f2d1037d5d hedgewars/Data/Themes/avematan/horizont.png Binary file hedgewars/Data/Themes/avematan/horizont.png has changed diff -r 475c0f2f9d17 -r 30f2d1037d5d hedgewars/Data/Themes/avematan/ksi.png Binary file hedgewars/Data/Themes/avematan/ksi.png has changed diff -r 475c0f2f9d17 -r 30f2d1037d5d hedgewars/Data/Themes/avematan/theme.cfg --- /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 diff -r 475c0f2f9d17 -r 30f2d1037d5d hedgewars/Data/Themes/bubbles/Border.png Binary file hedgewars/Data/Themes/bubbles/Border.png has changed diff -r 475c0f2f9d17 -r 30f2d1037d5d hedgewars/Data/Themes/bubbles/LandTex.png Binary file hedgewars/Data/Themes/bubbles/LandTex.png has changed diff -r 475c0f2f9d17 -r 30f2d1037d5d hedgewars/Data/Themes/bubbles/Sky.png Binary file hedgewars/Data/Themes/bubbles/Sky.png has changed diff -r 475c0f2f9d17 -r 30f2d1037d5d hedgewars/Data/Themes/bubbles/horizont.png Binary file hedgewars/Data/Themes/bubbles/horizont.png has changed diff -r 475c0f2f9d17 -r 30f2d1037d5d hedgewars/Data/Themes/bubbles/round.png Binary file hedgewars/Data/Themes/bubbles/round.png has changed diff -r 475c0f2f9d17 -r 30f2d1037d5d hedgewars/Data/Themes/bubbles/theme.cfg --- /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 diff -r 475c0f2f9d17 -r 30f2d1037d5d hedgewars/Data/Themes/ethereal/Border.png Binary file hedgewars/Data/Themes/ethereal/Border.png has changed diff -r 475c0f2f9d17 -r 30f2d1037d5d hedgewars/Data/Themes/ethereal/LandTex.png Binary file hedgewars/Data/Themes/ethereal/LandTex.png has changed diff -r 475c0f2f9d17 -r 30f2d1037d5d hedgewars/Data/Themes/ethereal/Sky.png Binary file hedgewars/Data/Themes/ethereal/Sky.png has changed diff -r 475c0f2f9d17 -r 30f2d1037d5d hedgewars/Data/Themes/ethereal/horizont.png Binary file hedgewars/Data/Themes/ethereal/horizont.png has changed diff -r 475c0f2f9d17 -r 30f2d1037d5d hedgewars/Data/Themes/ethereal/theme.cfg --- /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 diff -r 475c0f2f9d17 -r 30f2d1037d5d hedgewars/Data/Themes/norsk/Border.png Binary file hedgewars/Data/Themes/norsk/Border.png has changed diff -r 475c0f2f9d17 -r 30f2d1037d5d hedgewars/Data/Themes/norsk/LandTex.png Binary file hedgewars/Data/Themes/norsk/LandTex.png has changed diff -r 475c0f2f9d17 -r 30f2d1037d5d hedgewars/Data/Themes/norsk/Sky.png Binary file hedgewars/Data/Themes/norsk/Sky.png has changed diff -r 475c0f2f9d17 -r 30f2d1037d5d hedgewars/Data/Themes/norsk/horizont.png Binary file hedgewars/Data/Themes/norsk/horizont.png has changed diff -r 475c0f2f9d17 -r 30f2d1037d5d hedgewars/Data/Themes/norsk/theme.cfg --- /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 diff -r 475c0f2f9d17 -r 30f2d1037d5d hedgewars/Data/Themes/themes.cfg --- /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 diff -r 475c0f2f9d17 -r 30f2d1037d5d hedgewars/Data/Themes/tibet/Border.png Binary file hedgewars/Data/Themes/tibet/Border.png has changed diff -r 475c0f2f9d17 -r 30f2d1037d5d hedgewars/Data/Themes/tibet/LandTex.png Binary file hedgewars/Data/Themes/tibet/LandTex.png has changed diff -r 475c0f2f9d17 -r 30f2d1037d5d hedgewars/Data/Themes/tibet/Sky.png Binary file hedgewars/Data/Themes/tibet/Sky.png has changed diff -r 475c0f2f9d17 -r 30f2d1037d5d hedgewars/Data/Themes/tibet/chha.png Binary file hedgewars/Data/Themes/tibet/chha.png has changed diff -r 475c0f2f9d17 -r 30f2d1037d5d hedgewars/Data/Themes/tibet/horizont.png Binary file hedgewars/Data/Themes/tibet/horizont.png has changed diff -r 475c0f2f9d17 -r 30f2d1037d5d hedgewars/Data/Themes/tibet/ma.png Binary file hedgewars/Data/Themes/tibet/ma.png has changed diff -r 475c0f2f9d17 -r 30f2d1037d5d hedgewars/Data/Themes/tibet/nga.png Binary file hedgewars/Data/Themes/tibet/nga.png has changed diff -r 475c0f2f9d17 -r 30f2d1037d5d hedgewars/Data/Themes/tibet/sa.png Binary file hedgewars/Data/Themes/tibet/sa.png has changed diff -r 475c0f2f9d17 -r 30f2d1037d5d hedgewars/Data/Themes/tibet/ta1.png Binary file hedgewars/Data/Themes/tibet/ta1.png has changed diff -r 475c0f2f9d17 -r 30f2d1037d5d hedgewars/Data/Themes/tibet/theme.cfg --- /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 diff -r 475c0f2f9d17 -r 30f2d1037d5d hedgewars/Data/Themes/wood/Border.png Binary file hedgewars/Data/Themes/wood/Border.png has changed diff -r 475c0f2f9d17 -r 30f2d1037d5d hedgewars/Data/Themes/wood/LandTex.png Binary file hedgewars/Data/Themes/wood/LandTex.png has changed diff -r 475c0f2f9d17 -r 30f2d1037d5d hedgewars/Data/Themes/wood/Sky.png Binary file hedgewars/Data/Themes/wood/Sky.png has changed diff -r 475c0f2f9d17 -r 30f2d1037d5d hedgewars/Data/Themes/wood/horizont.png Binary file hedgewars/Data/Themes/wood/horizont.png has changed diff -r 475c0f2f9d17 -r 30f2d1037d5d hedgewars/Data/Themes/wood/theme.cfg --- /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 diff -r 475c0f2f9d17 -r 30f2d1037d5d hedgewars/Data/Themes/xtheme/Border.png Binary file hedgewars/Data/Themes/xtheme/Border.png has changed diff -r 475c0f2f9d17 -r 30f2d1037d5d hedgewars/Data/Themes/xtheme/LandTex.png Binary file hedgewars/Data/Themes/xtheme/LandTex.png has changed diff -r 475c0f2f9d17 -r 30f2d1037d5d hedgewars/Data/Themes/xtheme/Sky.png Binary file hedgewars/Data/Themes/xtheme/Sky.png has changed diff -r 475c0f2f9d17 -r 30f2d1037d5d hedgewars/Data/Themes/xtheme/horizont.png Binary file hedgewars/Data/Themes/xtheme/horizont.png has changed diff -r 475c0f2f9d17 -r 30f2d1037d5d hedgewars/Data/Themes/xtheme/plant1.png Binary file hedgewars/Data/Themes/xtheme/plant1.png has changed diff -r 475c0f2f9d17 -r 30f2d1037d5d hedgewars/Data/Themes/xtheme/theme.cfg --- /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 diff -r 475c0f2f9d17 -r 30f2d1037d5d hedgewars/Data/front/exit.bmp Binary file hedgewars/Data/front/exit.bmp has changed diff -r 475c0f2f9d17 -r 30f2d1037d5d hedgewars/Data/front/playdemo.bmp Binary file hedgewars/Data/front/playdemo.bmp has changed diff -r 475c0f2f9d17 -r 30f2d1037d5d hedgewars/Data/front/settings.bmp Binary file hedgewars/Data/front/settings.bmp has changed diff -r 475c0f2f9d17 -r 30f2d1037d5d hedgewars/Data/front/startlocal.bmp Binary file hedgewars/Data/front/startlocal.bmp has changed diff -r 475c0f2f9d17 -r 30f2d1037d5d hedgewars/Data/front/startnet.bmp Binary file hedgewars/Data/front/startnet.bmp has changed diff -r 475c0f2f9d17 -r 30f2d1037d5d hedgewars/GSHandlers.inc --- /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 + * + * 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; diff -r 475c0f2f9d17 -r 30f2d1037d5d hedgewars/HHHandlers.inc --- /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 + * + * 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; diff -r 475c0f2f9d17 -r 30f2d1037d5d hedgewars/Hedge.dpr --- /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 + * + * 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. + diff -r 475c0f2f9d17 -r 30f2d1037d5d hedgewars/Hedge.res Binary file hedgewars/Hedge.res has changed diff -r 475c0f2f9d17 -r 30f2d1037d5d hedgewars/Makefile --- /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 diff -r 475c0f2f9d17 -r 30f2d1037d5d hedgewars/SDLh.pas --- /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 + * + * 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. diff -r 475c0f2f9d17 -r 30f2d1037d5d hedgewars/fConsts.pas --- /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 + * + * 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. diff -r 475c0f2f9d17 -r 30f2d1037d5d hedgewars/fGUI.pas --- /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 + * + * 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. diff -r 475c0f2f9d17 -r 30f2d1037d5d hedgewars/fGame.pas --- /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 + * + * 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. diff -r 475c0f2f9d17 -r 30f2d1037d5d hedgewars/fIPC.pas --- /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 + * + * 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. diff -r 475c0f2f9d17 -r 30f2d1037d5d hedgewars/fMisc.pas --- /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 + * + * 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. diff -r 475c0f2f9d17 -r 30f2d1037d5d hedgewars/fNet.pas --- /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 + * + * 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. diff -r 475c0f2f9d17 -r 30f2d1037d5d hedgewars/fOptionsGUI.pas --- /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 + * + * 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. diff -r 475c0f2f9d17 -r 30f2d1037d5d hedgewars/getrevnum.dpr --- /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 + * + * 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. diff -r 475c0f2f9d17 -r 30f2d1037d5d hedgewars/hw.dpr --- /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 + * + * 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. diff -r 475c0f2f9d17 -r 30f2d1037d5d hedgewars/hwserv.dpr --- /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 + * + * 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. diff -r 475c0f2f9d17 -r 30f2d1037d5d hedgewars/options.inc --- /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 + * + * 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} + diff -r 475c0f2f9d17 -r 30f2d1037d5d hedgewars/runhelper.dpr --- /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 + * + * 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. diff -r 475c0f2f9d17 -r 30f2d1037d5d hedgewars/uAI.pas --- /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 + * + * 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. diff -r 475c0f2f9d17 -r 30f2d1037d5d hedgewars/uAIActions.pas --- /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 + * + * 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. diff -r 475c0f2f9d17 -r 30f2d1037d5d hedgewars/uAIAmmoTests.pas --- /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 + * + * 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. diff -r 475c0f2f9d17 -r 30f2d1037d5d hedgewars/uAIMisc.pas --- /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 + * + * 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. diff -r 475c0f2f9d17 -r 30f2d1037d5d hedgewars/uCollisions.pas --- /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 + * + * 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. diff -r 475c0f2f9d17 -r 30f2d1037d5d hedgewars/uConsole.pas --- /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 + * + * 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. diff -r 475c0f2f9d17 -r 30f2d1037d5d hedgewars/uConsts.pas --- /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 + * + * 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. diff -r 475c0f2f9d17 -r 30f2d1037d5d hedgewars/uGame.pas --- /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 + * + * 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. diff -r 475c0f2f9d17 -r 30f2d1037d5d hedgewars/uGears.pas --- /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 + * + * 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. diff -r 475c0f2f9d17 -r 30f2d1037d5d hedgewars/uIO.pas --- /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 + * + * 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. diff -r 475c0f2f9d17 -r 30f2d1037d5d hedgewars/uKeys.pas --- /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 + * + * 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. diff -r 475c0f2f9d17 -r 30f2d1037d5d hedgewars/uLand.pas --- /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 + * + * 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 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. diff -r 475c0f2f9d17 -r 30f2d1037d5d hedgewars/uMisc.pas --- /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 + * + * 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. diff -r 475c0f2f9d17 -r 30f2d1037d5d hedgewars/uNet.pas --- /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 + * + * 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. diff -r 475c0f2f9d17 -r 30f2d1037d5d hedgewars/uPlayers.pas --- /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 + * + * 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. diff -r 475c0f2f9d17 -r 30f2d1037d5d hedgewars/uRandom.pas --- /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 + * + * 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. diff -r 475c0f2f9d17 -r 30f2d1037d5d hedgewars/uSHA.pas --- /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 + * + * 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. diff -r 475c0f2f9d17 -r 30f2d1037d5d hedgewars/uServerMisc.pas --- /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 + * + * 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. diff -r 475c0f2f9d17 -r 30f2d1037d5d hedgewars/uSound.pas --- /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 + * + * 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. diff -r 475c0f2f9d17 -r 30f2d1037d5d hedgewars/uStore.pas --- /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 + * + * 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. diff -r 475c0f2f9d17 -r 30f2d1037d5d hedgewars/uTeams.pas --- /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 + * + * 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 (inil 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. diff -r 475c0f2f9d17 -r 30f2d1037d5d hedgewars/uWorld.pas --- /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 + * + * 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.