# HG changeset patch # User unc0rr # Date 1124813873 0 # Node ID bcbd7adb4e4b15c6aa2887aa60620ab16dff5334 # Parent ffe4ad26a64cc9126488f223790e764f06d8f548 - set svn:eol-style to native - Fixes for compilation and run on *nix - Read hedgehogs spawn points from fort's config diff -r ffe4ad26a64c -r bcbd7adb4e4b COPYING.txt --- a/COPYING.txt Mon Aug 22 21:38:06 2005 +0000 +++ b/COPYING.txt Tue Aug 23 16:17:53 2005 +0000 @@ -1,27 +1,27 @@ -Distributed under the terms of the BSD-modified licence: - -Permission is hereby granted, free of charge, to any person obtaining a copy of -this software and associated documentation files (the "Software"), to deal with -the Software without restriction, including without limitation the rights to -use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of -the Software, and to permit persons to whom the Software is furnished to do so, -subject to the following conditions: - -1. Redistributions of source code must retain the above copyright notice, this - list of conditions and the following disclaimer. -2. Redistributions in binary form must reproduce the above copyright notice, - this list of conditions and the following disclaimer in the documentation - and/or other materials provided with the distribution. -3. The name of the author may not be used to endorse or promote products derived - from this software without specific prior written permission. - -THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR IMPLIED -WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF -MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT -SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, -EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT -OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS -INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN -CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING -IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY +Distributed under the terms of the BSD-modified licence: + +Permission is hereby granted, free of charge, to any person obtaining a copy of +this software and associated documentation files (the "Software"), to deal with +the Software without restriction, including without limitation the rights to +use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of +the Software, and to permit persons to whom the Software is furnished to do so, +subject to the following conditions: + +1. Redistributions of source code must retain the above copyright notice, this + list of conditions and the following disclaimer. +2. Redistributions in binary form must reproduce the above copyright notice, + this list of conditions and the following disclaimer in the documentation + and/or other materials provided with the distribution. +3. The name of the author may not be used to endorse or promote products derived + from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR IMPLIED +WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF +MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT +SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, +EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT +OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS +INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN +CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING +IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. \ No newline at end of file diff -r ffe4ad26a64c -r bcbd7adb4e4b README.txt --- a/README.txt Mon Aug 22 21:38:06 2005 +0000 +++ b/README.txt Tue Aug 23 16:17:53 2005 +0000 @@ -1,16 +1,16 @@ -Hedgewars - a Worms-like game. -Distributed under the terms of the BSD-modified licence. - -Source, -images in Data/Graphics, -sounds in Data/Sounds, -themes "avematan", "bubbles", "tibet" -fort "Barrelhouse" -(c) 2004, 2005 Andrey Korotaev - -Fonts -(c) 1995 Gavin Helf , - -Images in Data/Front, Data/Graphics/Graves, -themes "ethereal", "norsk", "wood", "xtheme" +Hedgewars - a Worms-like game. +Distributed under the terms of the BSD-modified licence. + +Source, +images in Data/Graphics, +sounds in Data/Sounds, +themes "avematan", "bubbles", "tibet" +fort "Barrelhouse" +(c) 2004, 2005 Andrey Korotaev + +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 ffe4ad26a64c -r bcbd7adb4e4b hedgewars/CCHandlers.inc --- a/hedgewars/CCHandlers.inc Mon Aug 22 21:38:06 2005 +0000 +++ b/hedgewars/CCHandlers.inc Tue Aug 23 16:17:53 2005 +0000 @@ -1,376 +1,376 @@ -(* - * Hedgewars, a worms-like game - * Copyright (c) 2004, 2005 Andrey Korotaev - * - * Distributed under the terms of the BSD-modified licence: - * - * Permission is hereby granted, free of charge, to any person obtaining a copy - * of this software and associated documentation files (the "Software"), to deal - * with the Software without restriction, including without limitation the - * rights to use, copy, modify, merge, publish, distribute, sublicense, and/or - * sell copies of the Software, and to permit persons to whom the Software is - * furnished to do so, subject to the following conditions: - * - * 1. Redistributions of source code must retain the above copyright notice, - * this list of conditions and the following disclaimer. - * 2. Redistributions in binary form must reproduce the above copyright notice, - * this list of conditions and the following disclaimer in the documentation - * and/or other materials provided with the distribution. - * 3. The name of the author may not be used to endorse or promote products - * derived from this software without specific prior written permission. - * - * THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR IMPLIED - * WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF - * MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO - * EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, - * SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, - * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; - * OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, - * WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR - * OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF - * ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. - *) - -function CheckNoTeamOrHH: boolean; -begin -Result:= (CurrentTeam=nil) or (CurrentTeam.Hedgehogs[CurrentTeam.CurrHedgehog].Gear = nil); -{$IFDEF DEBUGFILE} -if Result then - if CurrentTeam = nil then AddFileLog('CONSOLE: CurTeam = nil') - else AddFileLog('CONSOLE: CurTeam <> nil, Gear = nil') -{$ENDIF} -end; -//////////////////////////////////////////////////////////////////////////////// -procedure chQuit(var s: shortstring); -begin -GameState:= gsExit -end; - -procedure chAddTeam(var s: shortstring); -begin -if isDeveloperMode then AddTeam; -if GameType = gmtDemo then CurrentTeam.ExtDriven:= true -end; - -procedure chTeamLocal(var s: shortstring); -begin -if not isDeveloperMode then exit; -if CurrentTeam = nil then OutError(errmsgIncorrectUse + ' "/rdriven"', true); -CurrentTeam.ExtDriven:= true -end; - -procedure chName(var id: shortstring); -var s: shortstring; -begin -if CurrentTeam = nil then OutError(errmsgIncorrectUse + ' "/name"', true); -SplitBySpace(id, s); -if s[1]='"' then Delete(s, 1, 1); -if s[byte(s[0])]='"' then Delete(s, byte(s[0]), 1); -if id = 'team' then CurrentTeam.TeamName:= s -else if (id[1]='h')and(id[2]='h')and(id[3]>='0')and(id[3]<='7') then - CurrentTeam.Hedgehogs[byte(id[3])-48].Name:= s -else OutError(errmsgUnknownVariable + ' "' + id + '"') -end; - -procedure chGrave(var s: shortstring); -begin -if CurrentTeam = nil then OutError(errmsgIncorrectUse + ' "/grave"', true); -if s[1]='"' then Delete(s, 1, 1); -if s[byte(s[0])]='"' then Delete(s, byte(s[0]), 1); -CurrentTeam.GraveName:= s -end; - -procedure chFort(var s: shortstring); -begin -if CurrentTeam = nil then OutError(errmsgIncorrectUse + ' "/grave"', true); -if s[1]='"' then Delete(s, 1, 1); -if s[byte(s[0])]='"' then Delete(s, byte(s[0]), 1); -CurrentTeam.FortName:= s -end; - -procedure chColor(var id: shortstring); -var c: integer; -begin -if CurrentTeam = nil then OutError(errmsgIncorrectUse + ' "/color"', true); -val(id, CurrentTeam.Color, c); -AdjustColor(CurrentTeam.Color) -end; - -procedure chAdd(var id: shortstring); -var s: shortstring; - c: integer; - Gear: PGear; - b: byte; -begin -if (not isDeveloperMode)or(CurrentTeam=nil) then exit; -SplitBySpace(id, s); -if (id[1]='h')and(id[2]='h')and(id[3]>='0')and(id[3]<='7') then - begin - b:= byte(id[3])-48; - val(s, CurrentTeam.Hedgehogs[b].BotLevel, c); - Gear:= AddGear(0, 0, gtHedgehog, 0); - Gear.Hedgehog:= @CurrentTeam.Hedgehogs[b]; - PHedgehog(Gear.Hedgehog).Team:= CurrentTeam; - CurrentTeam.Hedgehogs[b].Gear:= Gear - end -else OutError(errmsgUnknownVariable + ' "' + id + '"', true) -end; - -procedure chBind(var id: shortstring); -var s: shortstring; - b: integer; -begin -if CurrentTeam = nil then exit; -SplitBySpace(id, s); -if s[1]='"' then Delete(s, 1, 1); -if s[byte(s[0])]='"' then Delete(s, byte(s[0]), 1); -b:= KeyNameToCode(id); -if b = 0 then OutError(errmsgUnknownVariable + ' "' + id + '"') - else CurrentTeam.Aliases[b]:= s -end; - -procedure chLeft_p(var s: shortstring); -begin -if CheckNoTeamOrHH then exit; -if not CurrentTeam.ExtDriven then SendIPC('L'); -with CurrentTeam.Hedgehogs[CurrentTeam.CurrHedgehog].Gear^ do - Message:= Message or gm_Left -end; - -procedure chLeft_m(var s: shortstring); -begin -if CheckNoTeamOrHH then exit; -if not CurrentTeam.ExtDriven then SendIPC('l'); -with CurrentTeam.Hedgehogs[CurrentTeam.CurrHedgehog].Gear^ do - Message:= Message and not gm_Left -end; - -procedure chRight_p(var s: shortstring); -begin -if CheckNoTeamOrHH then exit; -if not CurrentTeam.ExtDriven then SendIPC('R'); -with CurrentTeam.Hedgehogs[CurrentTeam.CurrHedgehog].Gear^ do - Message:= Message or gm_Right -end; - -procedure chRight_m(var s: shortstring); -begin -if CheckNoTeamOrHH then exit; -if not CurrentTeam.ExtDriven then SendIPC('r'); -with CurrentTeam.Hedgehogs[CurrentTeam.CurrHedgehog].Gear^ do - Message:= Message and not gm_Right -end; - -procedure chUp_p(var s: shortstring); -begin -if CheckNoTeamOrHH then exit; -if not CurrentTeam.ExtDriven then SendIPC('U'); -with CurrentTeam.Hedgehogs[CurrentTeam.CurrHedgehog].Gear^ do - Message:= Message or gm_Up -end; - -procedure chUp_m(var s: shortstring); -begin -if CheckNoTeamOrHH then exit; -if not CurrentTeam.ExtDriven then SendIPC('u'); -with CurrentTeam.Hedgehogs[CurrentTeam.CurrHedgehog].Gear^ do - Message:= Message and not gm_Up -end; - -procedure chDown_p(var s: shortstring); -begin -if CheckNoTeamOrHH then exit; -if not CurrentTeam.ExtDriven then SendIPC('D'); -with CurrentTeam.Hedgehogs[CurrentTeam.CurrHedgehog].Gear^ do - Message:= Message or gm_Down -end; - -procedure chDown_m(var s: shortstring); -begin -if CheckNoTeamOrHH then exit; -if not CurrentTeam.ExtDriven then SendIPC('d'); -with CurrentTeam.Hedgehogs[CurrentTeam.CurrHedgehog].Gear^ do - Message:= Message and not gm_Down -end; - -procedure chLJump(var s: shortstring); -begin -if CheckNoTeamOrHH then exit; -if not CurrentTeam.ExtDriven then SendIPC('j'); -with CurrentTeam.Hedgehogs[CurrentTeam.CurrHedgehog].Gear^ do - Message:= Message or gm_LJump -end; - -procedure chHJump(var s: shortstring); -begin -if CheckNoTeamOrHH then exit; -if not CurrentTeam.ExtDriven then SendIPC('J'); -with CurrentTeam.Hedgehogs[CurrentTeam.CurrHedgehog].Gear^ do - Message:= Message or gm_HJump -end; - -procedure chAttack_p(var s: shortstring); -begin -if CheckNoTeamOrHH then exit; -with CurrentTeam.Hedgehogs[CurrentTeam.CurrHedgehog].Gear^ do - begin - {$IFDEF DEBUGFILE}AddFileLog('/+attack: Gear.State = '+inttostr(State));{$ENDIF} - if ((State and gstHHDriven)<>0)and((State and (gstAttacked or gstHHChooseTarget or gstMoving)) = 0) then - begin - FollowGear:= CurrentTeam.Hedgehogs[CurrentTeam.CurrHedgehog].Gear; - if not CurrentTeam.ExtDriven then SendIPC('A'); - Message:= Message or gm_Attack - end - end -end; - -procedure chAttack_m(var s: shortstring); -var xx, yy: real; -begin -if CheckNoTeamOrHH then exit; -with CurrentTeam.Hedgehogs[CurrentTeam.CurrHedgehog].Gear^, - CurrentTeam.Hedgehogs[CurrentTeam.CurrHedgehog] do - begin - {$IFDEF DEBUGFILE}AddFileLog('/-attack: Gear.State = '+inttostr(State)+' CurAmmoGear = '+inttostr(longword(CurAmmoGear)));{$ENDIF} - if CurAmmoGear <> nil then - begin - Message:= Message and not gm_Attack; - if not CurrentTeam.ExtDriven then SendIPC('a') - end; - if (((State and (gstHHDriven or gstAttacking)) = (gstHHDriven or gstAttacking))and - ((State and (gstAttacked or gstMoving or gstHHChooseTarget)) = 0)and - (((State and gstFalling ) = 0)or((Ammo[CurSlot, CurAmmo].Propz and ammoprop_AttackInFall) <> 0))and - (((State and gstHHJumping) = 0)or((Ammo[CurSlot, CurAmmo].Propz and ammoprop_AttackInJump) <> 0)))and - (CurAmmoGear = nil) then - begin - if (Ammo[CurSlot, CurAmmo].Propz and ammoprop_Power) <> 0 then - begin - StopSound(sndThrowPowerUp); - PlaySound(sndThrowRelease); - end; - xx:= Sign(dX)*Sin(Angle*pi/cMaxAngle); - yy:= -Cos(Angle*pi/cMaxAngle); - case Ammo[CurSlot, CurAmmo].AmmoType of - amBazooka: FollowGear:= AddGear(round(X), round(Y), gtAmmo_Grenade, 0, xx*Power/cPowerDivisor, yy*Power/cPowerDivisor); - amGrenade: FollowGear:= AddGear(round(X), round(Y), gtAmmo_Bomb, 0, xx*Power/cPowerDivisor, yy*Power/cPowerDivisor, Ammo[CurSlot, CurAmmo].Timer); - amUFO: FollowGear:= AddGear(round(X), round(Y), gtUFO, 0, xx*Power/cPowerDivisor, yy*Power/cPowerDivisor); - amShotgun: begin - PlaySound(sndShotgunReload); - FollowGear:= AddGear(round(X + xx*20), round(Y + yy*20), gtShotgunShot, 0, xx * 0.5, 0.5 * yy); - end; - amSkip: TurnTimeLeft:= 0; - amPickHammer: CurAmmoGear:= AddGear(round(Gear.X), round(Gear.Y) + cHHHalfHeight, gtPickHammer, 0); - amRope: CurAmmoGear:= AddGear(round(Gear.X), round(Gear.Y), gtRope, 0, xx, yy); - end; - Power:= 0; - if CurAmmoGear <> nil then - begin - CurAmmoGear.Message:= Gear.Message; - exit - end else - begin - Message:= Message and not gm_Attack; - if not CurrentTeam.ExtDriven then SendIPC('a') - end; - AfterAttack - end - end -end; - -procedure chSwitch(var s: shortstring); -begin -if CheckNoTeamOrHH then exit; -if not CurrentTeam.ExtDriven then SendIPC('S'); -with CurrentTeam.Hedgehogs[CurrentTeam.CurrHedgehog].Gear^ do - Message:= Message or gm_Switch -end; - -procedure chNextTurn(var s: shortstring); -begin -if AllInactive then - begin - if not CurrentTeam.ExtDriven then SendIPC('N'); - {$IFDEF DEBUGFILE}AddFileLog('Doing SwitchHedgehog: time '+inttostr(GameTicks));{$ENDIF} - SwitchHedgehog; - end -end; - -procedure chSay(var s: shortstring); -begin -WriteLnToConsole('> ' + s); -SendIPC('s'+s) -end; - -procedure chTimer(var s: shortstring); -begin -if (s[0] <> #1) or (s[1] < '1') or (s[1] > '5') or (CurrentTeam = nil) then exit; -with CurrentTeam.Hedgehogs[CurrentTeam.CurrHedgehog] do - if (Ammo[CurSlot, CurAmmo].Propz and ammoprop_Timerable) <> 0 then - begin - Ammo[CurSlot, CurAmmo].Timer:= 1000 * (byte(s[1]) - 48); - with CurrentTeam^ do - ApplyAmmoChanges(@Hedgehogs[CurrHedgehog]); - if not CurrentTeam.ExtDriven then SendIPC(s); - end -end; - -procedure chSlot(var s: shortstring); -var slot: LongWord; - caSlot, caAmmo: PLongword; -begin -if (s[0] <> #1) or (CurrentTeam = nil) then exit; -slot:= byte(s[1]) - 49; -if slot > cMaxSlot then exit; -if not CurrentTeam.ExtDriven then SendIPC(char(byte(s[1]) + 79)); -with CurrentTeam^ do - begin - with Hedgehogs[CurrHedgehog] do - begin - if ((Gear.State and (gstAttacking or gstAttacked)) <> 0) or (AttacksNum > 0) - or ((Gear.State and gstHHDriven) = 0) then exit; // во время стрельбы исключает смену оружия - if CurAmmoGear = nil then begin caSlot:= @CurSlot; caAmmo:= @CurAmmo end - else begin caSlot:= @AltSlot; caAmmo:= @AltAmmo end; - if caSlot^ = slot then - begin - inc(caAmmo^); - if (caAmmo^ > cMaxSlotAmmo) or (Ammo[slot, caAmmo^].Count = 0) then caAmmo^:= 0 - end else - if Ammo[slot, 0].Count > 0 then - begin - caSlot^:= slot; - caAmmo^:= 0; - end; - TargetPoint.X:= NoPointX; - end; - ApplyAmmoChanges(@Hedgehogs[CurrHedgehog]) - end -end; - -procedure chPut(var s: shortstring); -begin -if CheckNoTeamOrHH then exit; -with CurrentTeam.Hedgehogs[CurrentTeam.CurrHedgehog].Gear^ do - if (State and gstHHChooseTarget) <> 0 then - begin - isCursorVisible:= false; - if not CurrentTeam.ExtDriven then - begin - SDL_GetMouseState(@TargetPoint.X, @TargetPoint.Y); - dec(TargetPoint.X, WorldDx); - dec(TargetPoint.Y, WorldDy); - s[0]:= #9; - s[1]:= 'p'; - PInteger(@s[2])^:= TargetPoint.X; - PInteger(@s[6])^:= TargetPoint.Y; - SendIPC(s) - end; - AdjustMPoint; - State:= State and not gstHHChooseTarget; - end else if CurrentTeam.ExtDriven then OutError('got /put while not being in choose target mode', true) -end; - -procedure chCapture(var s: shortstring); -begin -flagMakeCapture:= true -end; - +(* + * Hedgewars, a worms-like game + * Copyright (c) 2004, 2005 Andrey Korotaev + * + * 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 ffe4ad26a64c -r bcbd7adb4e4b hedgewars/Data/Forts/BarrelhouseL.txt --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/hedgewars/Data/Forts/BarrelhouseL.txt Tue Aug 23 16:17:53 2005 +0000 @@ -0,0 +1,11 @@ +247 122 +19 229 +709 147 +478 294 +345 319 +218 277 +130 478 +212 936 +787 414 +797 609 +805 953 \ No newline at end of file diff -r ffe4ad26a64c -r bcbd7adb4e4b hedgewars/Data/Forts/BarrelhouseR.txt --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/hedgewars/Data/Forts/BarrelhouseR.txt Tue Aug 23 16:17:53 2005 +0000 @@ -0,0 +1,11 @@ +776 122 +1004 229 +315 147 +545 294 +678 319 +805 277 +893 478 +811 936 +236 414 +226 609 +218 953 \ No newline at end of file diff -r ffe4ad26a64c -r bcbd7adb4e4b hedgewars/GSHandlers.inc --- a/hedgewars/GSHandlers.inc Mon Aug 22 21:38:06 2005 +0000 +++ b/hedgewars/GSHandlers.inc Tue Aug 23 16:17:53 2005 +0000 @@ -1,550 +1,550 @@ -(* - * Hedgewars, a worms-like game - * Copyright (c) 2004, 2005 Andrey Korotaev - * - * Distributed under the terms of the BSD-modified licence: - * - * Permission is hereby granted, free of charge, to any person obtaining a copy - * of this software and associated documentation files (the "Software"), to deal - * with the Software without restriction, including without limitation the - * rights to use, copy, modify, merge, publish, distribute, sublicense, and/or - * sell copies of the Software, and to permit persons to whom the Software is - * furnished to do so, subject to the following conditions: - * - * 1. Redistributions of source code must retain the above copyright notice, - * this list of conditions and the following disclaimer. - * 2. Redistributions in binary form must reproduce the above copyright notice, - * this list of conditions and the following disclaimer in the documentation - * and/or other materials provided with the distribution. - * 3. The name of the author may not be used to endorse or promote products - * derived from this software without specific prior written permission. - * - * THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR IMPLIED - * WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF - * MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO - * EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, - * SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, - * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; - * OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, - * WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR - * OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF - * ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. - *) - -procedure doStepDrowningGear(Gear: PGear); forward; - -function CheckGearDrowning(Gear: PGear): boolean; -begin -Result:= Gear.Y + Gear.HalfHeight >= cWaterLine; -if Result then - begin - Gear.State:= gstDrowning; - Gear.doStep:= doStepDrowningGear; - PlaySound(sndSplash) - end -end; - -procedure CheckCollision(Gear: PGear); -begin -if TestCollisionXwithGear(Gear, Sign(Gear.X)) or TestCollisionYwithGear(Gear, Sign(Gear.Y)) - then Gear.State:= Gear.State or gstCollision - else Gear.State:= Gear.State and not gstCollision -end; - -procedure CheckHHDamage(Gear: PGear); -begin -if Gear.dY > 0.35 then Gear.Damage:= Gear.Damage + round(25 * (abs(Gear.dY) - 0.35)); -end; - -//////////////////////////////////////////////////////////////////////////////// -//////////////////////////////////////////////////////////////////////////////// -procedure CalcRotationDirAngle(Gear: PGear); -var dAngle: real; -begin -dAngle:= (abs(Gear.dX) + abs(Gear.dY))*0.1; -if Gear.dX >= 0 then Gear.DirAngle:= Gear.DirAngle + dAngle - else Gear.DirAngle:= Gear.DirAngle - dAngle; -if Gear.DirAngle < 0 then Gear.DirAngle:= Gear.DirAngle + 16 -else if Gear.DirAngle >= 16 then Gear.DirAngle:= Gear.DirAngle - 16 -end; - -//////////////////////////////////////////////////////////////////////////////// -procedure doStepDrowningGear(Gear: PGear); -begin -AllInactive:= false; -Gear.Y:= Gear.Y + cDrownSpeed; -if round(Gear.Y) > Gear.HalfHeight + cWaterLine + 48 + cVisibleWater then DeleteGear(Gear) -end; - -//////////////////////////////////////////////////////////////////////////////// -procedure doStepFallingGear(Gear: PGear); -var b: boolean; -begin -if TestCollisionYwithGear(Gear, Sign(Gear.dY)) then - begin - Gear.dX:= Gear.dX * Gear.Friction; - Gear.dY:= - Gear.dY * Gear.Elasticity; - b:= false - end else b:= true; -if TestCollisionXwithGear(Gear, Sign(Gear.dX)) then - begin - Gear.dX:= - Gear.dX * Gear.Elasticity; -// Gear.dY:= Gear.dY; - b:= false - end; -if b then - begin - Gear.dY:= Gear.dY + cGravity; - Gear.State:= Gear.State and not gstCollision - end else - begin - if sqr(Gear.dX) + sqr(Gear.dY) < 0.00001 then - if (Gear.Timer = 0) then Gear.Active:= false - else begin - Gear.dX:= 0; - Gear.dY:= 0 - end; - Gear.State:= Gear.State or gstCollision - end; -Gear.X:= Gear.X + Gear.dX; -Gear.Y:= Gear.Y + Gear.dY; -CheckGearDrowning(Gear); -if (sqr(Gear.dX) + sqr(Gear.dY) < 0.003) then Gear.State:= Gear.State and not gstMoving - else Gear.State:= Gear.State or gstMoving -end; - -//////////////////////////////////////////////////////////////////////////////// -procedure doStepCloud(Gear: PGear); -begin -Gear.X:= Gear.X + cWindSpeed * 200 + Gear.dX; -if Gear.X < -cScreenWidth-256 then Gear.X:= cScreenWidth + 2048 else -if Gear.X > cScreenWidth + 2048 then Gear.X:= -cScreenWidth - 256 -end; - -//////////////////////////////////////////////////////////////////////////////// -procedure doStepBomb(Gear: PGear); -begin -AllInactive:= false; -doStepFallingGear(Gear); -dec(Gear.Timer); -if Gear.Timer = 0 then - begin - doMakeExplosion(round(Gear.X), round(Gear.Y), 50, EXPLAutoSound); - DeleteGear(Gear); - SetAllToActive; - exit - end; -CalcRotationDirAngle(Gear); -if (Gear.State and (gstCollision or gstMoving)) = (gstCollision or gstMoving) then PlaySound(sndGrenadeImpact) -end; - -//////////////////////////////////////////////////////////////////////////////// -procedure doStepGrenade(Gear: PGear); -begin -AllInactive:= false; -Gear.dX:= Gear.dX + cWindSpeed; -doStepFallingGear(Gear); -if (Gear.State and gstCollision) <> 0 then - begin - doMakeExplosion(round(Gear.X), round(Gear.Y), 50, EXPLAutoSound); - DeleteGear(Gear); - SetAllToActive; - exit - end; -if (GameTicks and $3F) = 0 then - AddGear(round(Gear.X), round(Gear.Y), gtSmokeTrace, 0) -end; - -//////////////////////////////////////////////////////////////////////////////// -procedure doStepHealthTag(Gear: PGear); -begin -AllInactive:= false; -dec(Gear.Timer); -Gear.Y:= Gear.Y - 0.07; -if Gear.Timer = 0 then - begin - PHedgehog(Gear.Hedgehog).Gear.Active:= true; - DeleteGear(Gear) - end -end; - -//////////////////////////////////////////////////////////////////////////////// -procedure doStepGrave(Gear: PGear); -begin -AllInactive:= false; -if Gear.dY < 0 then - if TestCollisionY(Gear, -1) then Gear.dY:= 0; - -if Gear.dY >=0 then - if TestCollisionY(Gear, 1) then - begin - Gear.dY:= - Gear.dY * Gear.Elasticity; - if Gear.dY > - 0.001 then - begin - Gear.Active:= false; - exit - end else if Gear.dY < - 0.03 then PlaySound(sndGraveImpact) - end; -Gear.Y:= Gear.Y + Gear.dY; -CheckGearDrowning(Gear); -Gear.dY:= Gear.dY + cGravity -end; - -//////////////////////////////////////////////////////////////////////////////// -procedure doStepUFOWork(Gear: PGear); -var t: real; -begin -AllInactive:= false; -t:= sqrt(sqr(Gear.dX) + sqr(Gear.dY)); -Gear.dX:= Gear.Elasticity * (Gear.dX + 0.000004 * (TargetPoint.X - trunc(Gear.X))); -Gear.dY:= Gear.Elasticity * (Gear.dY + 0.000004 * (TargetPoint.Y - trunc(Gear.Y))); -t:= t / (sqrt(sqr(Gear.dX) + sqr(Gear.dY))); -Gear.dX:= Gear.dX * t; -Gear.dY:= Gear.dY * t; -Gear.X:= Gear.X + Gear.dX; -Gear.Y:= Gear.Y + Gear.dY; -CheckCollision(Gear); -dec(Gear.Timer); -if ((Gear.State and gstCollision) <> 0) or (Gear.Timer = 0) then - begin - doMakeExplosion(round(Gear.X), round(Gear.Y), 50, EXPLAutoSound); - DeleteGear(Gear); - SetAllToActive - end; -end; - -procedure doStepUFO(Gear: PGear); -begin -AllInactive:= false; -Gear.X:= Gear.X + Gear.dX; -Gear.Y:= Gear.Y + Gear.dY; -Gear.dY:= Gear.dY + cGravity; -CheckCollision(Gear); -if (Gear.State and gstCollision) <> 0 then - begin - doMakeExplosion(round(Gear.X), round(Gear.Y), 50, EXPLAutoSound); - DeleteGear(Gear); - SetAllToActive; - exit - end; -dec(Gear.Timer); -if Gear.Timer = 0 then - begin - Gear.Timer:= 5000; - Gear.doStep:= doStepUFOWork - end; -end; - -//////////////////////////////////////////////////////////////////////////////// -procedure doStepShotgunShot(Gear: PGear); -var i: LongWord; -begin -AllInactive:= false; -if Gear.Timer > 0 then - begin - dec(Gear.Timer); - if Gear.Timer = 1 then PlaySound(sndShotgunFire); - exit - end; -i:= 200; -repeat -Gear.X:= Gear.X + Gear.dX; -Gear.Y:= Gear.Y + Gear.dY; -CheckCollision(Gear); -if (Gear.State and gstCollision) <> 0 then - begin - doMakeExplosion(round(Gear.X), round(Gear.Y), 25, EXPLAllDamageInRadius); - DeleteGear(Gear); - SetAllToActive; - exit - end; -dec(i) -until i = 0; -if (Gear.X < 0) or (Gear.Y < 0) or (Gear.X > 2048) or (Gear.Y > 1024) then - DeleteGear(Gear) -end; - -//////////////////////////////////////////////////////////////////////////////// -procedure doStepActionTimer(Gear: PGear); -begin -dec(Gear.Timer); -case Gear.State of - gtsStartGame: begin - AllInactive:= false; - if Gear.Timer > 0 then exit; - AddCaption('Let''s fight!', $FFFFFF, capgrpStartGame); - DeleteGear(Gear) - end; - end; -end; - -//////////////////////////////////////////////////////////////////////////////// -procedure doStepPickHammerWork(Gear: PGear); -var i, ei: integer; - HHGear: PGear; -begin -Allinactive:= false; -dec(Gear.Timer); -if (Gear.Timer = 0)or((Gear.Message and gm_Destroy) <> 0) then - begin - DeleteGear(Gear); - AfterAttack; - SetAllToActive; - exit - end; -HHGear:= PHedgehog(Gear.Hedgehog).Gear; -if (Gear.Timer and $3F) = 0 then - begin - i:= round(Gear.X) - Gear.HalfWidth - GetRandom(2); - ei:= round(Gear.X) + Gear.HalfWidth + GetRandom(2); - while i <= ei do - begin - doMakeExplosion(i, round(Gear.Y) + 3, 3, 0); - inc(i, 1) - end; - SetAllToActive; - Gear.X:= Gear.X + Gear.dX; - Gear.Y:= Gear.Y + 1.9 - end; -if TestCollisionYwithGear(Gear, 1) then - begin - Gear.dY:= 0; - HHGear.dX:= 0.0000001 * Sign(PGear(Gear.Hedgehog).dX); - HHGear.dY:= 0; - end else - begin - Gear.dY:= Gear.dY + cGravity; - Gear.Y:= Gear.Y + Gear.dY; - if Gear.Y > 1024 then Gear.Timer:= 1 - end; - -Gear.X:= Gear.X + HHGear.dX; -HHGear.X:= Gear.X; -HHGear.Y:= Gear.Y - cHHHalfHeight; - -if (Gear.Message and gm_Attack) <> 0 then - if (Gear.State and gsttmpFlag) <> 0 then Gear.Timer:= 1 else else - if (Gear.State and gsttmpFlag) = 0 then Gear.State:= Gear.State or gsttmpFlag; -if ((Gear.Message and gm_Left) <> 0) then Gear.dX:= -0.3 else - if ((Gear.Message and gm_Right) <> 0) then Gear.dX:= 0.3 - else Gear.dX:= 0; -end; - -procedure doStepPickHammer(Gear: PGear); -var i, y: integer; - ar: TRangeArray; -begin -i:= 0; -y:= round(Gear.Y) - cHHHalfHeight*2; -while y < round(Gear.Y) do - begin - ar[i].Left := round(Gear.X) - Gear.HalfWidth - GetRandom(2); - ar[i].Right:= round(Gear.X) + Gear.HalfWidth + GetRandom(2); - inc(y, 2); - inc(i) - end; -DrawLineExplosions(@ar, 3, round(Gear.Y) - cHHHalfHeight*2, 2, Pred(i)); -Gear.dY:= PHedgehog(Gear.Hedgehog).Gear.dY; -doStepPickHammerWork(Gear); -Gear.doStep:= doStepPickHammerWork -end; - -//////////////////////////////////////////////////////////////////////////////// -procedure doStepRopeWork(Gear: PGear); -const pidiv2: real = pi/2; - flCheck: boolean = false; -var HHGear: PGear; - len, cs, cc, tx, ty: real; - lx, ly: integer; - - procedure DeleteMe; - begin - with HHGear^ do - begin - Message:= Message and not gm_Attack; - State:= State or gstFalling; - end; - DeleteGear(Gear); - OnUsedAmmo(PHedgehog(Gear.Hedgehog)^.Ammo); - ApplyAmmoChanges(PHedgehog(Gear.Hedgehog)) - end; - -begin -HHGear:= PHedgehog(Gear.Hedgehog).Gear; -if (HHGear.State and gstHHDriven) = 0 then - begin - DeleteMe; - exit - end; -Gear.dX:= HHGear.X - Gear.X; -Gear.dY:= HHGear.Y - Gear.Y; - -if (Gear.Message and gm_Left <> 0) then HHGear.dX:= HHGear.dX - 0.0002 else -if (Gear.Message and gm_Right <> 0) then HHGear.dX:= HHGear.dX + 0.0002; - -if not TestCollisionYwithGear(HHGear, 1) then HHGear.dY:= HHGear.dY + cGravity; - -HHGear.DirAngle:= arctan(Gear.dY + HHGear.dY, Gear.dX + HHGear.dX); -cs:= sin(HHGear.DirAngle); -cc:= cos(HHGear.DirAngle); - -flCheck:= not flCheck; -if flCheck then // check whether rope needs dividing - begin - len:= Gear.Elasticity - 20; - while len > 5 do - begin - tx:= cc*len; - ty:= cs*len; -// if TestCollisionXwithXYShift(Gear, round(tx), round(ty), Sign(HHGear.dX)) -/// or TestCollisionYwithXYShift(Gear, round(tx), round(ty), Sign(HHGear.dY)) then - lx:= round(Gear.X + tx) + sign(HHGear.dX); - ly:= round(Gear.Y + ty) + sign(HHGear.dY); - if ((ly and $FFFFFC00) = 0) and ((lx and $FFFFF800) = 0)and (Land[ly, lx] <> 0) then - begin - with RopePoints.ar[RopePoints.Count] do - begin - X:= Gear.X; - Y:= Gear.Y; - if RopePoints.Count = 0 then RopePoints.HookAngle:= DxDy2Angle32(Gear.dY, Gear.dX); - b:= (cc * HHGear.dY) > (cs * HHGear.dX); - dLen:= len - end; - Gear.X:= Gear.X + tx; - Gear.Y:= Gear.Y + ty; - inc(RopePoints.Count); - Gear.Elasticity:= Gear.Elasticity - len; - Gear.Friction:= Gear.Friction - len; - break - end; - len:= len - 3 - end; - end else - if RopePoints.Count > 0 then // check whether the last dividing point could be removed - begin - tx:= RopePoints.ar[Pred(RopePoints.Count)].X; - ty:= RopePoints.ar[Pred(RopePoints.Count)].Y; - if RopePoints.ar[Pred(RopePoints.Count)].b xor ((tx - Gear.X) * (ty - HHGear.Y) > (tx - HHGear.X) * (ty - Gear.Y)) then - begin - dec(RopePoints.Count); - Gear.X:=RopePoints.ar[RopePoints.Count].X; - Gear.Y:=RopePoints.ar[RopePoints.Count].Y; - Gear.Elasticity:= Gear.Elasticity + RopePoints.ar[RopePoints.Count].dLen; - Gear.Friction:= Gear.Friction + RopePoints.ar[RopePoints.Count].dLen - end - end; - -Gear.dX:= HHGear.X - Gear.X; -Gear.dY:= HHGear.Y - Gear.Y; -HHGear.DirAngle:= arctan(Gear.dY + HHGear.dY, Gear.dX + HHGear.dX); -cs:= sin(HHGear.DirAngle); -cc:= cos(HHGear.DirAngle); - -HHGear.dX:= HHGear.X; -HHGear.dY:= HHGear.Y; - -if ((Gear.Message and gm_Down) <> 0) and (Gear.Elasticity < Gear.Friction) then - if not (TestCollisionXwithGear(HHGear, Sign(Gear.dX)) - or TestCollisionYwithGear(HHGear, Sign(Gear.dY))) then Gear.Elasticity:= Gear.Elasticity + 0.3; - -if ((Gear.Message and gm_Up) <> 0) and (Gear.Elasticity > 30) then - if not (TestCollisionXwithGear(HHGear, -Sign(Gear.dX)) - or TestCollisionYwithGear(HHGear, -Sign(Gear.dY))) then Gear.Elasticity:= Gear.Elasticity - 0.3; - -HHGear.X:= Gear.X + cc*Gear.Elasticity; -HHGear.Y:= Gear.Y + cs*Gear.Elasticity; - -HHGear.dX:= HHGear.X - HHGear.dX; -HHGear.dY:= HHGear.Y - HHGear.dY; - -if TestCollisionXwithGear(HHGear, Sign(HHGear.dX)) then - HHGear.dX:= -0.9 * HHGear.dX; -if TestCollisionYwithGear(HHGear, Sign(HHGear.dY)) then - HHGear.dY:= -0.9 * HHGear.dY; - -if (Gear.Message and gm_Attack) <> 0 then - if (Gear.State and gsttmpFlag) <> 0 then DeleteMe else -else if (Gear.State and gsttmpFlag) = 0 then Gear.State:= Gear.State or gsttmpFlag; -end; - - -procedure doStepRopeAttach(Gear: PGear); -var HHGear: PGear; - tx, ty, tt: real; -begin -Gear.X:= Gear.X + Gear.dX; -Gear.Y:= Gear.Y + Gear.dY; -Gear.Elasticity:= Gear.Elasticity + 1.0; -HHGear:= PHedgehog(Gear.Hedgehog)^.Gear; -if (HHGear.State and gstFalling) <> 0 then - if HHTestCollisionYwithGear(HHGear, 1) then - begin - HHGear.dY:= 0; - CheckHHDamage(HHGear); - HHGear.State:= HHGear.State and not (gstFalling or gstHHJumping); - end else - begin - if TestCollisionXwithGear(HHGear, Sign(HHGear.dX)) then HHGear.dX:= 0.0000001 * Sign(HHGear.dX); - HHGear.X:= HHGear.X + HHGear.dX; - HHGear.Y:= HHGear.Y + HHGear.dY; - Gear.X:= Gear.X + HHGear.dX; - Gear.Y:= Gear.Y + HHGear.dY; - HHGear.dY:= HHGear.dY + cGravity; - tt:= Gear.Elasticity; - tx:= 0; - ty:= 0; - while tt > 20 do - begin - if TestCollisionXwithXYShift(Gear, round(tx), round(ty), Sign(Gear.dX)) - or TestCollisionYwithXYShift(Gear, round(tx), round(ty), Sign(Gear.dY)) then - begin - Gear.X:= Gear.X + tx; - Gear.Y:= Gear.Y + ty; - Gear.Elasticity:= tt; - Gear.doStep:= doStepRopeWork; - with HHGear^ do State:= State and not gstAttacking; - tt:= 0 - end; - tx:= tx - Gear.dX - Gear.dX; - ty:= ty - Gear.dY - Gear.dY; - tt:= tt - 2.0; - end; - end; -CheckCollision(Gear); -if (Gear.State and gstCollision) <> 0 then - begin - Gear.doStep:= doStepRopeWork; - with HHGear^ do State:= State and not gstAttacking; - if Gear.Elasticity < 10 then - Gear.Elasticity:= 10000; - end; - -if (Gear.Elasticity >= Gear.Friction) or ((Gear.Message and gm_Attack) = 0) then - begin - with PHedgehog(Gear.Hedgehog).Gear^ do - begin - State:= State and not gstAttacking; - Message:= Message and not gm_Attack - end; - DeleteGear(Gear) - end -end; - -procedure doStepRope(Gear: PGear); -begin -Gear.doStep:= doStepRopeAttach -end; - -//////////////////////////////////////////////////////////////////////////////// -procedure doStepSmokeTrace(Gear: PGear); -begin -inc(Gear.Timer); -if Gear.Timer > 64 then - begin - Gear.Timer:= 0; - dec(Gear.Tag) - end; -Gear.dX:= Gear.dX + cWindSpeed; -Gear.X:= Gear.X + Gear.dX; -if Gear.Tag = 0 then DeleteGear(Gear) -end; +(* + * Hedgewars, a worms-like game + * Copyright (c) 2004, 2005 Andrey Korotaev + * + * 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 ffe4ad26a64c -r bcbd7adb4e4b hedgewars/HHHandlers.inc --- a/hedgewars/HHHandlers.inc Mon Aug 22 21:38:06 2005 +0000 +++ b/hedgewars/HHHandlers.inc Tue Aug 23 16:17:53 2005 +0000 @@ -1,281 +1,281 @@ -(* - * Hedgewars, a worms-like game - * Copyright (c) 2004, 2005 Andrey Korotaev - * - * Distributed under the terms of the BSD-modified licence: - * - * Permission is hereby granted, free of charge, to any person obtaining a copy - * of this software and associated documentation files (the "Software"), to deal - * with the Software without restriction, including without limitation the - * rights to use, copy, modify, merge, publish, distribute, sublicense, and/or - * sell copies of the Software, and to permit persons to whom the Software is - * furnished to do so, subject to the following conditions: - * - * 1. Redistributions of source code must retain the above copyright notice, - * this list of conditions and the following disclaimer. - * 2. Redistributions in binary form must reproduce the above copyright notice, - * this list of conditions and the following disclaimer in the documentation - * and/or other materials provided with the distribution. - * 3. The name of the author may not be used to endorse or promote products - * derived from this software without specific prior written permission. - * - * THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR IMPLIED - * WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF - * MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO - * EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, - * SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, - * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; - * OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, - * WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR - * OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF - * ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. - *) - -procedure doStepHedgehog(Gear: PGear); forward; -//////////////////////////////////////////////////////////////////////////////// -procedure doStepHedgehogDriven(Gear: PGear); -const StepTicks: LongWord = 0; -begin -if isinMultiShoot and (Gear.Damage = 0) then exit; -AllInactive:= false; -if (TurnTimeLeft = 0) or (Gear.Damage > 0) then - begin - if ((Gear.State and (gstMoving or gstFalling)) = 0) - and (CurAmmoGear = nil) then Gear.dX:= 0.0000001 * Sign(Gear.dX); - {$WARNINGS OFF}Gear.State:= Gear.State and not gstHHDriven;{$WARNINGS ON} - exit - end; - -if CurAmmoGear <> nil then - begin - CurAmmoGear.Message:= Gear.Message; - exit - end; - -if (Gear.Message and gm_Attack)<>0 then - if (Gear.State and (gstAttacked or gstHHChooseTarget) = 0)and(CurAmmoGear = nil) then - with PHedgehog(Gear.Hedgehog)^ do -// if ((Gear.State and gstFalling ) = 0)or((Ammo[CurSlot, CurAmmo].Propz and ammoprop_AttackInFall) <> 0) -// and((Gear.State and gstHHJumping) = 0)or((Ammo[CurSlot, CurAmmo].Propz and ammoprop_AttackInJump) <> 0) then - begin - Gear.State:= Gear.State or gstAttacking; - if Gear.Power = cMaxPower then ParseCommand('-attack') - else begin - if (Ammo[CurSlot, CurAmmo].Propz and ammoprop_Power) = 0 then Gear.Power:= cMaxPower - else begin - if Gear.Power = 0 then - begin - AttackBar:= CurrentTeam.AttackBar; - PlaySound(sndThrowPowerUp) - end; - inc(Gear.Power) - end - end; - end else Gear.Message:= Gear.Message and not gm_Attack; - - -if (Gear.State and gstFalling) <> 0 then - begin - if ((Gear.Message and gm_HJump) <> 0) and ((Gear.State and gstHHJumping) <> 0) then - if (abs(Gear.dX) < 0.0000002) and (Gear.dY < -0.02) then - begin - Gear.dY:= -0.25; - Gear.dX:= Sign(Gear.dX) * 0.02 - end; - Gear.Message:= Gear.Message and not (gm_LJump or gm_HJump); - if TestCollisionXwithGear(Gear, Sign(Gear.dX)) then Gear.dX:= 0.0000001 * Sign(Gear.dX); - Gear.X:= Gear.X + Gear.dX; - Gear.dY:= Gear.dY + cGravity; - if (Gear.dY < 0)and TestCollisionYwithGear(Gear, -1) then Gear.dY:= 0; - Gear.Y:= Gear.Y + Gear.dY; - if (Gear.dY >= 0)and HHTestCollisionYwithGear(Gear, 1) then - begin - CheckHHDamage(Gear); - if ((abs(Gear.dX) + abs(Gear.dY)) < 0.55) - and ((Gear.State and gstHHJumping) <> 0) then Gear.dX:= 0.0000001 * Sign(Gear.dX); - Gear.State:= Gear.State and not (gstFalling or gstHHJumping); - StepTicks:= 200; - Gear.dY:= 0 - end; - CheckGearDrowning(Gear); - exit - end; - -if StepTicks > 0 then dec(StepTicks); - -if ((Gear.State and (gstMoving or gstFalling)) = 0) then - if (Gear.Message and gm_Up )<>0 then if Gear.Angle > 0 then dec(Gear.Angle) - else else - if (Gear.Message and gm_Down )<>0 then if Gear.Angle < cMaxAngle then inc(Gear.Angle); - -if ((Gear.State and (gstAttacking or gstMoving or gstFalling)) = 0)and(StepTicks = 0) then - begin - if ((Gear.Message and gm_LJump )<>0) then - begin - Gear.Message:= 0; - if not HHTestCollisionYwithGear(Gear, -1) then - if not TestCollisionXwithXYShift(Gear, 0, -2, Sign(Gear.dX)) then Gear.Y:= Gear.Y - 2 else - if not TestCollisionXwithXYShift(Gear, 0, -1, Sign(Gear.dX)) then Gear.Y:= Gear.Y - 1; - if not (TestCollisionXwithGear(Gear, Sign(Gear.dX)) - or HHTestCollisionYwithGear(Gear, -1)) then - begin - Gear.dY:= -0.15; - Gear.dX:= Sign(Gear.dX) * 0.15; - Gear.State:= Gear.State or gstFalling or gstHHJumping; - exit - end; - end; - if ((Gear.Message and gm_HJump )<>0) then - begin - Gear.Message:= 0; - if not HHTestCollisionYwithGear(Gear, -1) then - begin - Gear.dY:= -0.20; - Gear.dX:= 0.0000001 * Sign(Gear.dX); - Gear.X:= Gear.X - Sign(Gear.dX)*0.00008; // компенсация сдвига %) - Gear.State:= Gear.State or gstFalling or gstHHJumping; - exit - end; - end; - if (Gear.Message and gm_Left )<>0 then Gear.dX:= -1.0 else - if (Gear.Message and gm_Right )<>0 then Gear.dX:= 1.0 else exit; - PHedgehog(Gear.Hedgehog).visStepPos:= (PHedgehog(Gear.Hedgehog).visStepPos + 1) and 7; - StepTicks:= 40; - if TestCollisionXwithGear(Gear, Sign(Gear.dX)) then - begin - if not (TestCollisionXwithXYShift(Gear, 0, -6, Sign(Gear.dX)) - or HHTestCollisionYwithGear(Gear, -1)) then Gear.Y:= Gear.Y - 1; - if not (TestCollisionXwithXYShift(Gear, 0, -5, Sign(Gear.dX)) - or HHTestCollisionYwithGear(Gear, -1)) then Gear.Y:= Gear.Y - 1; - if not (TestCollisionXwithXYShift(Gear, 0, -4, Sign(Gear.dX)) - or HHTestCollisionYwithGear(Gear, -1)) then Gear.Y:= Gear.Y - 1; - if not (TestCollisionXwithXYShift(Gear, 0, -3, Sign(Gear.dX)) - or HHTestCollisionYwithGear(Gear, -1)) then Gear.Y:= Gear.Y - 1; - if not (TestCollisionXwithXYShift(Gear, 0, -2, Sign(Gear.dX)) - or HHTestCollisionYwithGear(Gear, -1)) then Gear.Y:= Gear.Y - 1; - if not (TestCollisionXwithXYShift(Gear, 0, -1, Sign(Gear.dX)) - or HHTestCollisionYwithGear(Gear, -1)) then Gear.Y:= Gear.Y - 1; - end; - if not TestCollisionXwithGear(Gear, Sign(Gear.dX)) then Gear.X:= Gear.X + Gear.dX; - - if not HHTestCollisionYwithGear(Gear, 1) then - begin - Gear.Y:= Gear.Y + 1; - if not HHTestCollisionYwithGear(Gear, 1) then - begin - Gear.Y:= Gear.Y + 1; - if not HHTestCollisionYwithGear(Gear, 1) then - begin - Gear.Y:= Gear.Y + 1; - if not HHTestCollisionYwithGear(Gear, 1) then - begin - Gear.Y:= Gear.Y + 1; - if not HHTestCollisionYwithGear(Gear, 1) then - begin - Gear.Y:= Gear.Y + 1; - if not HHTestCollisionYwithGear(Gear, 1) then - begin - Gear.Y:= Gear.Y + 1; - if not HHTestCollisionYwithGear(Gear, 1) then - begin - Gear.Y:= Gear.Y - 6; - Gear.dY:= 0; - Gear.dX:= 0.0000001 * Sign(Gear.dX); - Gear.State:= Gear.State or gstFalling - end; - SetAllHHToActive - end - end - end - end - end - end - end -end; - -//////////////////////////////////////////////////////////////////////////////// -procedure doStepHedgehogFree(Gear: PGear); -begin -if not HHTestCollisionYwithGear(Gear, 1) then - begin - if (Gear.dY < 0) and HHTestCollisionYwithGear(Gear, -1) then Gear.dY:= 0; - Gear.State:= Gear.State or gstFalling or gstMoving; - Gear.dY:= Gear.dY + cGravity - end else begin - CheckHHDamage(Gear); - if Gear.dY > 0 then Gear.dY:= 0; - Gear.State:= Gear.State and not gstFalling; - if ((Gear.State and gstMoving) <> 0) then Gear.dX:= Gear.dX * Gear.Friction - end; - - -if (Gear.State and gstMoving) <> 0 then - if TestCollisionXwithGear(Gear, Sign(Gear.dX)) then - if ((Gear.State and gstFalling) = 0) then - if abs(Gear.dX) > 0.01 then - if not TestCollisionXwithXYShift(Gear, 0, -1, Sign(Gear.dX)) then begin Gear.dX:= Gear.dX * 0.9; Gear.Y:= Gear.Y - 1 end else - if not TestCollisionXwithXYShift(Gear, 0, -2, Sign(Gear.dX)) then begin Gear.dX:= Gear.dX * 0.9; Gear.Y:= Gear.Y - 2 end else - if not TestCollisionXwithXYShift(Gear, 0, -3, Sign(Gear.dX)) then begin Gear.dX:= Gear.dX * 0.9; Gear.Y:= Gear.Y - 3 end else - if not TestCollisionXwithXYShift(Gear, 0, -4, Sign(Gear.dX)) then begin Gear.dX:= Gear.dX * 0.9; Gear.Y:= Gear.Y - 4 end else - if not TestCollisionXwithXYShift(Gear, 0, -5, Sign(Gear.dX)) then begin Gear.dX:= Gear.dX * 0.3; Gear.Y:= Gear.Y - 5 end else - if abs(Gear.dX) > 0.02 then Gear.dX:= -0.5 * Gear.dX - else begin - Gear.State:= Gear.State and not gstMoving; - Gear.dX:= 0.0000001 * Sign(Gear.dX) - end - else begin - Gear.State:= Gear.State and not gstMoving; - Gear.dX:= 0.0000001 * Sign(Gear.dX) - end - else Gear.dX:= -0.8 * Gear.dX; - -if ((Gear.State and gstFalling) = 0)and - (sqr(Gear.dX) + sqr(Gear.dY) < 0.0008) then - begin - Gear.State:= Gear.State and not gstMoving; - Gear.dX:= 0.0000001 * Sign(Gear.dX); - Gear.dY:= 0 - end else Gear.State:= Gear.State or gstMoving; - -if (Gear.State and gstMoving) <> 0 then - begin - Gear.X:= Gear.X + Gear.dX; - Gear.Y:= Gear.Y + Gear.dY - end else - if Gear.Health = 0 then - begin - if AllInactive then - begin - doMakeExplosion(round(Gear.X), round(Gear.Y), 30, EXPLAutoSound); - AddGear(round(Gear.X), round(Gear.Y), gtGrave, 0).Hedgehog:= Gear.Hedgehog; - DeleteGear(Gear); - SetAllToActive - end; - AllInactive:= false; (* почему этого тут не было? *) - exit - end; - -AllInactive:= false; - -if (not CheckGearDrowning(Gear)) and - ((Gear.State and gstMoving) = 0) then - begin - Gear.State:= 0; - Gear.Active:= false; - AddGearCR(Gear); - exit - end -end; - -//////////////////////////////////////////////////////////////////////////////// -procedure doStepHedgehog(Gear: PGear); -begin -if (Gear.Message and gm_Destroy) <> 0 then - begin - DeleteGear(Gear); - exit - end; -if Gear.CollIndex < High(Longword) then DeleteCR(Gear); -if (Gear.State and gstHHDriven) = 0 then doStepHedgehogFree(Gear) - else doStepHedgehogDriven(Gear) -end; +(* + * Hedgewars, a worms-like game + * Copyright (c) 2004, 2005 Andrey Korotaev + * + * 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 ffe4ad26a64c -r bcbd7adb4e4b hedgewars/Hedge.dpr --- a/hedgewars/Hedge.dpr Mon Aug 22 21:38:06 2005 +0000 +++ b/hedgewars/Hedge.dpr Tue Aug 23 16:17:53 2005 +0000 @@ -1,65 +1,65 @@ -(* - * Hedgewars, a worms-like game - * Copyright (c) 2004, 2005 Andrey Korotaev - * - * Distributed under the terms of the BSD-modified licence: - * - * Permission is hereby granted, free of charge, to any person obtaining a copy - * of this software and associated documentation files (the "Software"), to deal - * with the Software without restriction, including without limitation the - * rights to use, copy, modify, merge, publish, distribute, sublicense, and/or - * sell copies of the Software, and to permit persons to whom the Software is - * furnished to do so, subject to the following conditions: - * - * 1. Redistributions of source code must retain the above copyright notice, - * this list of conditions and the following disclaimer. - * 2. Redistributions in binary form must reproduce the above copyright notice, - * this list of conditions and the following disclaimer in the documentation - * and/or other materials provided with the distribution. - * 3. The name of the author may not be used to endorse or promote products - * derived from this software without specific prior written permission. - * - * THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR IMPLIED - * WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF - * MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO - * EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, - * SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, - * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; - * OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, - * WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR - * OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF - * ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. - *) - -program Hedge; - -uses - windows, - messages, - WinSock, - IniFiles, - SysUtils, - uRandom, - fNet in 'fNet.pas', - fGUI in 'fGUI.pas', - fConsts in 'fConsts.pas', - fIPC in 'fIPC.pas', - fMisc in 'fMisc.pas', - fGame in 'fGame.pas', - fOptionsGUI in 'fOptionsGUI.pas'; - -{$R Hedge.res} - -begin -DoCreateMainWindow; -DoCreateOptionsWindow; -InitWSA; -LoadGraphics; -DoCreateControls; -DoCreateOptionsControls; -DoInit; -repeat -ProcessMessages; -until isTerminated -end. - +(* + * Hedgewars, a worms-like game + * Copyright (c) 2004, 2005 Andrey Korotaev + * + * 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 ffe4ad26a64c -r bcbd7adb4e4b hedgewars/Makefile --- a/hedgewars/Makefile Mon Aug 22 21:38:06 2005 +0000 +++ b/hedgewars/Makefile Tue Aug 23 16:17:53 2005 +0000 @@ -1,3 +1,5 @@ fpc-compile: + ppc386 -Fl/usr/local/lib getrevnum.dpr + ./getrevnum < /dev/null > revision.inc ppc386 -B -Sd -Xs -OG -Or -O2 -Fl/usr/local/lib hw.dpr ppc386 -B -Sd -Xs -OG -Or -O2 -Fl/usr/local/lib runhelper.dpr \ No newline at end of file diff -r ffe4ad26a64c -r bcbd7adb4e4b hedgewars/SDLh.pas --- a/hedgewars/SDLh.pas Mon Aug 22 21:38:06 2005 +0000 +++ b/hedgewars/SDLh.pas Tue Aug 23 16:17:53 2005 +0000 @@ -1,384 +1,384 @@ -(* - * Hedgewars, a worms-like game - * Copyright (c) 2004, 2005 Andrey Korotaev - * - * Distributed under the terms of the BSD-modified licence: - * - * Permission is hereby granted, free of charge, to any person obtaining a copy - * of this software and associated documentation files (the "Software"), to deal - * with the Software without restriction, including without limitation the - * rights to use, copy, modify, merge, publish, distribute, sublicense, and/or - * sell copies of the Software, and to permit persons to whom the Software is - * furnished to do so, subject to the following conditions: - * - * 1. Redistributions of source code must retain the above copyright notice, - * this list of conditions and the following disclaimer. - * 2. Redistributions in binary form must reproduce the above copyright notice, - * this list of conditions and the following disclaimer in the documentation - * and/or other materials provided with the distribution. - * 3. The name of the author may not be used to endorse or promote products - * derived from this software without specific prior written permission. - * - * THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR IMPLIED - * WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF - * MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO - * EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, - * SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, - * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; - * OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, - * WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR - * OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF - * ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. - *) - -unit SDLh; -interface -{$IFDEF LINUX} -{$DEFINE UNIX} -{$ENDIF} -{$IFDEF FREEBSD} -{$DEFINE UNIX} -{$ENDIF} - -{$IFDEF UNIX} -{$linklib c} -{$linklib pthread} // кажется, это только для FreeBSD, не уверен -{$ENDIF} - -{$IFDEF FPC} - {$MODE Delphi} - {$PACKRECORDS 4} -{$ENDIF} - -(* SDL *) -const {$IFDEF WIN32} - SDLLibName = 'SDL.dll'; - {$ENDIF} - {$IFDEF UNIX} - SDLLibName = 'libSDL.so'; - {$ENDIF} - SDL_SWSURFACE = $00000000; - SDL_HWSURFACE = $00000001; - SDL_ASYNCBLIT = $00000004; - SDL_ANYFORMAT = $10000000; - SDL_HWPALETTE = $20000000; - SDL_DOUBLEBUF = $40000000; - SDL_FULLSCREEN = $80000000; - SDL_NOFRAME = $00000020; - SDL_HWACCEL = $00000100; - SDL_SRCCOLORKEY = $00001000; - SDL_RLEACCEL = $00004000; - - SDL_NOEVENT = 0; - SDL_KEYDOWN = 2; - SDL_KEYUP = 3; - SDL_QUITEV = 12; - - SDL_INIT_VIDEO = $00000020; -type PSDL_Rect = ^TSDL_Rect; - TSDL_Rect = record - x, y: SmallInt; - w, h: Word; - end; - - TPoint = record - x: Integer; - y: Integer; - end; - - PSDL_PixelFormat = ^TSDL_PixelFormat; - TSDL_PixelFormat = record - palette: Pointer; - BitsPerPixel : Byte; - BytesPerPixel: Byte; - Rloss : Byte; - Gloss : Byte; - Bloss : Byte; - Aloss : Byte; - Rshift: Byte; - Gshift: Byte; - Bshift: Byte; - Ashift: Byte; - RMask : Longword; - GMask : Longword; - BMask : Longword; - AMask : Longword; - colorkey: Longword; - alpha : Byte; - end; - - - PSDL_Surface = ^TSDL_Surface; - TSDL_Surface = record - flags : Longword; - format: PSDL_PixelFormat; - w, h : Integer; - pitch : Word; - pixels: Pointer; - offset: Integer; - hwdata: Pointer; - clip_rect: TSDL_Rect; - unused1, - locked : Longword; - Blitmap : Pointer; - format_version: Longword; - refcount : Integer; - end; - - PSDL_Color = ^TSDL_Color; - TSDL_Color = record - r: Byte; - g: Byte; - b: Byte; - a: Byte; - end; - - PSDL_RWops = ^TSDL_RWops; - TSeek = function( context: PSDL_RWops; offset: Integer; whence: Integer ): Integer; cdecl; - TRead = function( context: PSDL_RWops; Ptr: Pointer; size: Integer; maxnum : Integer ): Integer; cdecl; - TWrite = function( context: PSDL_RWops; Ptr: Pointer; size: Integer; num: Integer ): Integer; cdecl; - TClose = function( context: PSDL_RWops ): Integer; cdecl; - - TStdio = record - autoclose: Integer; - fp: pointer; - end; - - TMem = record - base: PByte; - here: PByte; - stop: PByte; - end; - - TUnknown = record - data1: Pointer; - end; - - TSDL_RWops = record - seek: TSeek; - read: TRead; - write: TWrite; - close: TClose; - type_: Longword; - case Byte of - 0: (stdio: TStdio); - 1: (mem: TMem); - 2: (unknown: TUnknown); - end; - - TSDL_KeySym = record - scancode: Byte; - sym, - modifier: Longword; - unicode: Word; - end; - - TSDL_KeyboardEvent = record - type_: Byte; - which: Byte; - state: Byte; - keysym: TSDL_KeySym; - end; - - TSDL_QuitEvent = record - type_: Byte; - end; - PSDL_Event = ^TSDL_Event; - TSDL_Event = record - case Byte of - SDL_NOEVENT: (type_: byte); - SDL_KEYDOWN, SDL_KEYUP: (key: TSDL_KeyboardEvent); - SDL_QUITEV: (quit: TSDL_QuitEvent); - end; - - PByteArray = ^TByteArray; - TByteArray = array[0..32767] of Byte; - -function SDL_Init(flags: Longword): Integer; cdecl; external SDLLibName; -procedure SDL_Quit; cdecl; external SDLLibName; - -procedure SDL_Delay(msec: Longword); cdecl; external SDLLibName; -function SDL_GetTicks: Longword; cdecl; external SDLLibName; - -function SDL_MustLock(Surface: PSDL_Surface): Boolean; -function SDL_LockSurface(Surface: PSDL_Surface): Integer; cdecl; external SDLLibName; -procedure SDL_UnlockSurface(Surface: PSDL_Surface); cdecl; external SDLLibName; - -function SDL_GetError: PChar; cdecl; external SDLLibName; - -function SDL_SetVideoMode(width, height, bpp: Integer; flags: Longword): PSDL_Surface; cdecl; external SDLLibName; -function SDL_CreateRGBSurface(flags: Longword; Width, Height, Depth: Integer; RMask, GMask, BMask, AMask: Longword): PSDL_Surface; cdecl; external SDLLibName; -function SDL_CreateRGBSurfaceFrom(pixels: Pointer; width, height, depth, pitch: Integer; RMask, GMask, BMask, AMask: Longword): PSDL_Surface; cdecl; external SDLLibName; -procedure SDL_FreeSurface(Surface: PSDL_Surface); cdecl; external SDLLibName; -function SDL_SetColorKey(surface: PSDL_Surface; flag, key: Longword): Integer; cdecl; external SDLLibName; - -function SDL_UpperBlit(src: PSDL_Surface; srcrect: PSDL_Rect; dst: PSDL_Surface; dstrect: PSDL_Rect): Integer; cdecl; external SDLLibName; -function SDL_FillRect(dst: PSDL_Surface; dstrect: PSDL_Rect; color: Longword): Integer; cdecl; external SDLLibName; -procedure SDL_UpdateRect(Screen: PSDL_Surface; x, y: Integer; w, h: Longword); cdecl; external SDLLibName; -function SDL_Flip(Screen: PSDL_Surface): Integer; cdecl; external SDLLibName; - -procedure SDL_GetRGB(pixel: Longword; fmt: PSDL_PixelFormat; r, g, b: PByte); cdecl; external SDLLibName; -function SDL_MapRGB(format: PSDL_PixelFormat; r, g, b: Byte): Integer; cdecl; external SDLLibName; - -function SDL_DisplayFormat(Surface: PSDL_Surface): PSDL_Surface; cdecl; external SDLLibName; - -function SDL_RWFromFile(filename, mode: PChar): PSDL_RWops; cdecl; external SDLLibName; -function SDL_SaveBMP_RW(surface: PSDL_Surface; dst: PSDL_RWops; freedst: Integer): Integer; cdecl; external SDLLibName; - -function SDL_GetKeyState(numkeys: PInteger): PByteArray; cdecl; external SDLLibName; -function SDL_GetMouseState(x, y: PInteger): Byte; cdecl; external SDLLibName; -function SDL_GetKeyName(key: Longword): PChar; cdecl; external SDLLibName; -procedure SDL_WarpMouse(x, y: Word); cdecl; external SDLLibName; - -function SDL_PollEvent(event: PSDL_Event): Integer; cdecl; external SDLLibName; - -function SDL_ShowCursor(toggle: Integer): Integer; cdecl; external SDLLibName; - -procedure SDL_WM_SetCaption(title: PChar; icon: PChar); cdecl; external SDLLibName; - -(* TTF *) - -const {$IFDEF WIN32} - SDL_TTFLibName = 'SDL_ttf.dll'; - {$ENDIF} - {$IFDEF UNIX} - SDL_TTFLibName = 'libSDL_ttf.so'; - {$ENDIF} - - -type PTTF_Font = ^TTTF_font; - TTTF_Font = record - end; - -function TTF_Init: integer; cdecl; external SDL_TTFLibName; -procedure TTF_Quit; cdecl; external SDL_TTFLibName; - - -function TTF_SizeText(font : PTTF_Font; const text: PChar; var w, h: integer): Integer; cdecl; external SDL_TTFLibName; -function TTF_RenderText_Solid(font : PTTF_Font; const text: PChar; fg: TSDL_Color): PSDL_Surface; cdecl; external SDL_TTFLibName; -function TTF_RenderText_Blended(font : PTTF_Font; const text: PChar; fg: TSDL_Color): PSDL_Surface; cdecl; external SDL_TTFLibName; -function TTF_OpenFont(const filename: Pchar; size: integer): PTTF_Font; cdecl; external SDL_TTFLibName; - -(* SDL_mixer *) - -const {$IFDEF WIN32} - SDL_MixerLibName = 'SDL_mixer.dll'; - {$ENDIF} - {$IFDEF UNIX} - SDL_MixerLibName = 'libSDL_mixer.so'; - {$ENDIF} - -type PMixChunk = ^TMixChunk; - TMixChunk = record - allocated: Longword; - abuf : PByte; - alen : Longword; - volume : PByte; - end; - TMusic = (MUS_CMD, MUS_WAV, MUS_MOD, MUS_MID, MUS_OGG, MUS_MP3); - TMix_Fading = (MIX_NO_FADING, MIX_FADING_OUT, MIX_FADING_IN); - - TMidiSong = record - samples : Integer; - events : pointer; - end; - - TMusicUnion = record - case Byte of - 0: ( midi : TMidiSong ); - 1: ( ogg : pointer); - end; - - PMixMusic = ^TMixMusic; - TMixMusic = record - type_ : TMusic; - data : TMusicUnion; - fading : TMix_Fading; - fade_volume, - fade_step, - fade_steps, - error : integer; - end; - -function Mix_OpenAudio(frequency: integer; format: Word; channels: integer; chunksize: integer): integer; cdecl; external SDL_MixerLibName; -procedure Mix_CloseAudio; cdecl; external SDL_MixerLibName; - -function Mix_VolumeMusic(volume: integer): integer; cdecl; external SDL_MixerLibName; - -procedure Mix_FreeChunk(chunk: PMixChunk); cdecl; external SDL_MixerLibName; -procedure Mix_FreeMusic(music: PMixMusic); cdecl; external SDL_MixerLibName; - -function Mix_LoadWAV_RW(src: PSDL_RWops; freesrc: integer): PMixChunk; cdecl; external SDL_MixerLibName; -function Mix_LoadMUS(const filename: PChar): PMixMusic; cdecl; external SDL_MixerLibName; - -function Mix_Playing(channel: integer): integer; cdecl; external SDL_MixerLibName; -function Mix_PlayingMusic: integer; cdecl; external SDL_MixerLibName; - -function Mix_PlayChannelTimed(channel: integer; chunk: PMixChunk; loops: integer; ticks: integer): integer; cdecl; external SDL_MixerLibName; -function Mix_PlayMusic(music: PMixMusic; loops: integer): integer; cdecl; external SDL_MixerLibName; -function Mix_HaltChannel(channel: integer): integer; cdecl; external SDL_MixerLibName; - -(* SDL_image *) - -const {$IFDEF WIN32} - SDL_ImageLibName = 'SDL_image.dll'; - {$ENDIF} - {$IFDEF UNIX} - SDL_ImageLibName = 'libSDL_image.so'; - {$ENDIF} - -function IMG_Load(const _file: PChar): PSDL_Surface; cdecl; external SDL_ImageLibName; - -(* SDL_net *) - -const {$IFDEF WIN32} - SDL_NetLibName = 'SDL_net.dll'; - {$ENDIF} - {$IFDEF UNIX} - SDL_NetLibName = 'libSDL_net.so'; - {$ENDIF} - -type TIPAddress = record - host: Longword; - port: Word; - end; - - PTCPSocket = ^TTCPSocket; - TTCPSocket = record - ready, - channel: integer; - remoteAddress, - localAddress: TIPaddress; - sflag: integer; - end; - PSDLNet_SocketSet = ^TSDLNet_SocketSet; - TSDLNet_SocketSet = record - numsockets, - maxsockets: integer; - sockets: PTCPSocket; - end; - -function SDLNet_Init: integer; cdecl; external SDL_NetLibName; -procedure SDLNet_Quit; cdecl; external SDL_NetLibName; - -function SDLNet_AllocSocketSet(maxsockets: integer): PSDLNet_SocketSet; cdecl; external SDL_NetLibName; -function SDLNet_ResolveHost(var address: TIPaddress; host: PCHar; port: Word): integer; cdecl; external SDL_NetLibName; -function SDLNet_TCP_Accept(server: PTCPsocket): PTCPSocket; cdecl; external SDL_NetLibName; -function SDLNet_TCP_Open(var ip: TIPaddress): PTCPSocket; cdecl; external SDL_NetLibName; -function SDLNet_TCP_Send(sock: PTCPsocket; data: Pointer; len: integer): integer; cdecl; external SDL_NetLibName; -function SDLNet_TCP_Recv(sock: PTCPsocket; data: Pointer; len: integer): integer; cdecl; external SDL_NetLibName; -procedure SDLNet_TCP_Close(sock: PTCPsocket); cdecl; external SDL_NetLibName; -procedure SDLNet_FreeSocketSet(_set: PSDLNet_SocketSet); cdecl; external SDL_NetLibName; -function SDLNet_AddSocket(_set: PSDLNet_SocketSet; sock: PTCPSocket): integer; cdecl; external SDL_NetLibName; -function SDLNet_CheckSockets(_set: PSDLNet_SocketSet; timeout: integer): integer; cdecl; external SDL_NetLibName; - - -implementation - -function SDL_MustLock(Surface: PSDL_Surface): Boolean; -begin -Result:= ( surface^.offset <> 0 ) - or(( surface^.flags and (SDL_HWSURFACE or SDL_ASYNCBLIT or SDL_RLEACCEL)) <> 0) -end; - -end. +(* + * Hedgewars, a worms-like game + * Copyright (c) 2004, 2005 Andrey Korotaev + * + * 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 ffe4ad26a64c -r bcbd7adb4e4b hedgewars/fConsts.pas --- a/hedgewars/fConsts.pas Mon Aug 22 21:38:06 2005 +0000 +++ b/hedgewars/fConsts.pas Tue Aug 23 16:17:53 2005 +0000 @@ -1,82 +1,82 @@ -(* - * Hedgewars, a worms-like game - * Copyright (c) 2004, 2005 Andrey Korotaev - * - * Distributed under the terms of the BSD-modified licence: - * - * Permission is hereby granted, free of charge, to any person obtaining a copy - * of this software and associated documentation files (the "Software"), to deal - * with the Software without restriction, including without limitation the - * rights to use, copy, modify, merge, publish, distribute, sublicense, and/or - * sell copies of the Software, and to permit persons to whom the Software is - * furnished to do so, subject to the following conditions: - * - * 1. Redistributions of source code must retain the above copyright notice, - * this list of conditions and the following disclaimer. - * 2. Redistributions in binary form must reproduce the above copyright notice, - * this list of conditions and the following disclaimer in the documentation - * and/or other materials provided with the distribution. - * 3. The name of the author may not be used to endorse or promote products - * derived from this software without specific prior written permission. - * - * THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR IMPLIED - * WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF - * MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO - * EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, - * SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, - * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; - * OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, - * WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR - * OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF - * ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. - *) - -unit fConsts; -interface - -const cAppName = '†Hedge Wars Logon†'; - cAppTitle = 'HEDGEWARS'; - cOptionsName = 'Team Options'; - cOptionsTitle = 'Team Options'; - cGFXPath = 'Data\front\'; - - cLocalGameBtn = 1001; - cNetGameBtn = 1002; - cDemoBtn = 1003; - cSettingsBtn = 1004; - cExitGameBtn = 1005; - - cNetIpEdit = 1021; - cNetIpStatic = 1022; - cNetNameEdit = 1023; - cNetNameStatic= 1024; - cNetConnStatic= 1024; - cNetJoinBtn = 1025; - cNetBeginBtn = 1026; - cNetBackBtn = 1027; - - cDemoList = 1031; - cDemoBeginBtn = 1032; - cDemoBackBtn = 1033; - cDemoAllBtn = 1034; - - cSetResEdit = 1041; - cSetFScrCheck = 1042; - cSetDemoCheck = 1043; - cSetSndCheck = 1044; - cSetSaveBtn = 1045; - cSetBackBtn = 1046; - cSetShowTeamOptions = 1047; - - cBGStatic = 1199; - cOptBGStatic = 1198; - - cOptTeamName = 1201; - cOptHedgeName : array[0..7] of integer = (1202,1203,1204,1205,1206,1207,1208,1209); - - cDemoSeedSeparator = #10; - - -implementation - -end. +(* + * Hedgewars, a worms-like game + * Copyright (c) 2004, 2005 Andrey Korotaev + * + * 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 ffe4ad26a64c -r bcbd7adb4e4b hedgewars/fGUI.pas --- a/hedgewars/fGUI.pas Mon Aug 22 21:38:06 2005 +0000 +++ b/hedgewars/fGUI.pas Tue Aug 23 16:17:53 2005 +0000 @@ -1,318 +1,318 @@ -(* - * Hedgewars, a worms-like game - * Copyright (c) 2004, 2005 Andrey Korotaev - * - * Distributed under the terms of the BSD-modified licence: - * - * Permission is hereby granted, free of charge, to any person obtaining a copy - * of this software and associated documentation files (the "Software"), to deal - * with the Software without restriction, including without limitation the - * rights to use, copy, modify, merge, publish, distribute, sublicense, and/or - * sell copies of the Software, and to permit persons to whom the Software is - * furnished to do so, subject to the following conditions: - * - * 1. Redistributions of source code must retain the above copyright notice, - * this list of conditions and the following disclaimer. - * 2. Redistributions in binary form must reproduce the above copyright notice, - * this list of conditions and the following disclaimer in the documentation - * and/or other materials provided with the distribution. - * 3. The name of the author may not be used to endorse or promote products - * derived from this software without specific prior written permission. - * - * THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR IMPLIED - * WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF - * MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO - * EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, - * SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, - * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; - * OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, - * WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR - * OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF - * ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. - *) - -unit fGUI; -interface -uses Windows; - -procedure ProcessMessages; -function GetWindowTextStr(hwnd: HWND): string; -procedure DoControlPress(wParam: WPARAM; lParam: LPARAM); -procedure DoDrawButton(idCtl: UINT; lpmis: PDrawItemStruct); -procedure LoadGraphics; -procedure DoDestroy; -procedure DoCreateControls; -procedure DoCreateMainWindow; - - -var hwndMain,hwndOptions: HWND; -var isTerminated: boolean = false; -var //main menu - bitmap ,optbmp ,localbmp ,netbmp ,demobmp ,exitbmp ,setsbmp : HBITMAP; - BackGroundDC ,OptBGroundDC ,DCLocalGame ,DCNetGame ,DCDemoPlay ,DCExitGame ,DCSettings : HDC; - HLocalGameBtn ,HNetGameBtm ,HDemoBtn ,HExitGameBtn ,HSettingsBtn, HBGStatic : HWND; - //other - HNetIPEdit,HNetIPStatic: HWND; - HNetNameEdit,HNetNameStatic,HNetConnectionStatic: HWND; - HNetJoinBtn,HNetBeginBtn,HNetBackBtn:HWND; - HDemoList,HDemoBeginBtn,HDemoBackBtn,HDemoAllBtn:HWND; - HSetResEdit,HFullScrCheck,HSetDemoCheck,HSetSndCheck,HSetSaveBtn,HSetBackBtn,HSetShowTeamOptionsBtn:HWND; - scrx, scry: real; - - -implementation -uses fConsts, Messages, SysUtils, uConsts, fGame, fNet, fMisc, fOptionsGUI; - -function GetWindowTextStr(hwnd: HWND): string; -var i: integer; -begin -i:= GetWindowTextLength(hwnd); -SetLength(Result, i); -GetWindowText(hwnd, PChar(Result), Succ(i)) -end; - - -procedure ProcessMessages; -var Message: Windows.MSG; -begin -if PeekMessage(Message,0,0,0,PM_REMOVE) then - if Message.message <> WM_QUIT then - begin - TranslateMessage(Message); - DispatchMessage(Message) - end else isTerminated:= true -end; - -procedure HideMain; -begin -ShowWindow(HLocalGameBtn,SW_HIDE); -ShowWindow(HNetGameBtm,SW_HIDE); -ShowWindow(HDemoBtn,SW_HIDE); -ShowWindow(HSettingsBtn,SW_HIDE); -ShowWindow(HExitGameBtn,SW_HIDE) -end; - -procedure ShowMain; -begin -ShowWindow(HLocalGameBtn,SW_SHOW); -ShowWindow(HNetGameBtm,SW_SHOW); -ShowWindow(HDemoBtn,SW_SHOW); -ShowWindow(HSettingsBtn,SW_SHOW); -ShowWindow(HExitGameBtn,SW_SHOW); -SetFocus(HLocalGameBtn) -end; - - - -procedure ShowNetGameMenu; -begin -HideMain; -ShowWindow(HNetIPStatic,SW_SHOW); -ShowWindow(HNetIPEdit,SW_SHOW); -ShowWindow(HNetNameStatic,SW_SHOW); -ShowWindow(HNetNameEdit,SW_SHOW); -ShowWindow(HNetConnectionStatic,SW_SHOW); -ShowWindow(HNetJoinBtn,SW_SHOW); -ShowWindow(HNetBeginBtn,SW_SHOW); -ShowWindow(HNetBackBtn,SW_SHOW); -SetFocus(HNetJoinBtn) -end; - - -procedure ShowMainFromNetMenu; -begin -ShowWindow(HNetIPEdit,SW_HIDE); -ShowWindow(HNetIPStatic,SW_HIDE); -ShowWindow(HNetNameEdit,SW_HIDE); -ShowWindow(HNetNameStatic,SW_HIDE); -ShowWindow(HNetConnectionStatic,SW_HIDE); -ShowWindow(HNetJoinBtn,SW_HIDE); -ShowWindow(HNetBeginBtn,SW_HIDE); -ShowWindow(HNetBackBtn,SW_HIDE); -ShowMain -end; - - -procedure ShowDemoMenu; -var i: integer; - sr: TSearchRec; -begin -SendMessage(HDemoList, LB_RESETCONTENT, 0, 0); -i:= FindFirst(format('%s*.hwd_%d',[Pathz[ptDemos], cNetProtoVersion]), faAnyFile and not faDirectory, sr); -while i = 0 do - begin - SendMessage(HDemoList, LB_ADDSTRING, 0, LPARAM(PChar(sr.Name))); - i:= FindNext(sr) - end; -FindClose(sr); - -HideMain; - -ShowWindow(HDemoList,SW_SHOW); -ShowWindow(HDemoBeginBtn,SW_SHOW); -ShowWindow(HDemoAllBtn,SW_SHOW); -ShowWindow(HDemoBackBtn,SW_SHOW); -SetFocus(HDemoList) -end; - -procedure ShowMainFromDemoMenu; -begin -ShowWindow(HDemoList,SW_HIDE); -ShowWindow(HDemoBeginBtn,SW_HIDE); -ShowWindow(HDemoAllBtn,SW_HIDE); -ShowWindow(HDemoBackBtn,SW_HIDE); -ShowMain -end; - -procedure ShowSettingsMenu; -begin -HideMain; -ShowWindow(HSetResEdit,SW_SHOW); -ShowWindow(HFullScrCheck,SW_SHOW); -ShowWindow(HSetDemoCheck,SW_SHOW); -ShowWindow(HSetSndCheck,SW_SHOW); -ShowWindow(HSetSaveBtn,SW_SHOW); -ShowWindow(HSetBackBtn,SW_SHOW); -ShowWindow(HSetShowTeamOptionsBtn,SW_SHOW); -SetFocus(HSetResEdit) -end; - -procedure ShowMainFromSettings; -begin -ShowWindow(HSetResEdit,SW_HIDE); -ShowWindow(HFullScrCheck,SW_HIDE); -ShowWindow(HSetDemoCheck,SW_HIDE); -ShowWindow(HSetSndCheck,SW_HIDE); -ShowWindow(HSetSaveBtn,SW_HIDE); -ShowWindow(HSetBackBtn,SW_HIDE); -ShowWindow(HSetShowTeamOptionsBtn,SW_HIDE); -ShowMain -end; - -procedure DoControlPress(wParam: WPARAM; lParam: LPARAM); -begin -case LOWORD(wParam) of - cLocalGameBtn : StartLocalGame; - cNetGameBtn : ShowNetGameMenu; - cDemoBtn : ShowDemoMenu; - cSettingsBtn : ShowSettingsMenu; - cExitGameBtn : Halt; - cNetBackBtn : ShowMainFromNetMenu; - cNetJoinBtn : NetConnect; - cNetBeginBtn : StartNetGame; - cDemoBackBtn : ShowMainFromDemoMenu; - cDemoAllBtn : MessageBeep(0);//PlayAllDemos; - cDemoBeginBtn : StartDemoView; - cSetSaveBtn : SaveSettings; - cSetBackBtn : ShowMainFromSettings; - cSetShowTeamOptions : ShowOptionsWindow; - end -end; - -procedure DoDrawButton(idCtl: UINT; lpmis: PDrawItemStruct); -begin -case lpmis.CtlID of - cLocalGameBtn: StretchBlt(lpmis.hDC,0,0,trunc(309*scrx),trunc(22*scry),DCLocalGame,0,0,309,22,SRCCOPY); - cNetGameBtn: StretchBlt(lpmis.hDC,0,0,trunc(272*scrx),trunc(22*scry),DCNetGame ,0,0,272,22,SRCCOPY); - cDemoBtn: StretchBlt(lpmis.hDC,0,0,trunc(181*scrx),trunc(22*scry),DCDemoPlay ,0,0,181,22,SRCCOPY); - cSettingsBtn: StretchBlt(lpmis.hDC,0,0,trunc(147*scrx),trunc(22*scry),DCSettings ,0,0,147,22,SRCCOPY); - cExitGameBtn: StretchBlt(lpmis.hDC,0,0,trunc(272*scrx),trunc(22*scry),DCExitGame ,0,0,272,22,SRCCOPY); - cBGStatic: StretchBlt(lpmis.hDC,0,0,trunc(1024*scrx),trunc(768*scry),BackGroundDC,0,0,1024,768,SRCCOPY); - cOptBGStatic: StretchBlt(lpmis.hDC,0,0,trunc(1024*scrx),trunc(768*scry),OptBGroundDC,0,0,1024,768,SRCCOPY); - end -end; - -procedure LoadGraphics; -begin -scrx := GetSystemMetrics(SM_CXSCREEN)/1024; -scry := GetSystemMetrics(SM_CYSCREEN)/768; -LoadOwnerBitmap(bitmap, cGFXPath + 'front.bmp', BackGroundDC,hwndMain); -LoadOwnerBitmap(optbmp, cGFXPath + 'TeamSettings.bmp',OptBGroundDC,hwndOptions); -LoadOwnerBitmap(localbmp,cGFXPath + 'startlocal.bmp', DCLocalGame,cLocalGameBtn); -LoadOwnerBitmap(netbmp, cGFXPath + 'startnet.bmp', DCNetGame, cNetGameBtn); -LoadOwnerBitmap(demobmp, cGFXPath + 'playdemo.bmp', DCDemoPlay, cDemoBtn); -LoadOwnerBitmap(setsbmp, cGFXPath + 'settings.bmp', DCSettings, cSettingsBtn); -LoadOwnerBitmap(exitbmp, cGFXPath + 'exit.bmp', DCExitGame, cExitGameBtn); -end; - -procedure DoDestroy; -begin -DeleteObject(localbmp); -DeleteObject(optbmp); -DeleteObject(bitmap); -DeleteObject(netbmp); -DeleteObject(demobmp); -DeleteObject(setsbmp); -DeleteObject(bitmap); -DeleteDC(DCLocalGame); -DeleteDC(DCNetGame); -DeleteDC(DCDemoPlay); -DeleteDC(DCSettings); -DeleteDC(BackGroundDC); -DeleteDC(OptBGroundDC) -end; - -procedure DoCreateControls; -begin -HBGStatic := CreateWindow('STATIC','bg image static' ,WS_CHILD or WS_VISIBLE or SS_OWNERDRAW, 0, 0, GetSystemMetrics(SM_CXSCREEN), GetSystemMetrics(SM_CYSCREEN), hwndMain, cBGStatic, HInstance, nil); -/// main menu /// -HLocalGameBtn := CreateWindow('button','local game button',WS_CHILD or WS_VISIBLE or BS_OWNERDRAW, trunc(510 * scrx), trunc(400 *scry), trunc(309* scrx) , trunc(22*scry) , hwndMain , cLocalGameBtn, HInstance, nil ); -HNetGameBtm := CreateWindow('button', 'net game button',WS_CHILD or WS_VISIBLE or BS_OWNERDRAW, trunc(530 * scrx), trunc(450 *scry), trunc(272* scrx) , trunc(22*scry) , hwndMain , cNetGameBtn, HInstance, nil ); -HDemoBtn := CreateWindow('button', 'play demo button',WS_CHILD or WS_VISIBLE or BS_OWNERDRAW, trunc(570 * scrx), trunc(500 *scry), trunc(181* scrx) , trunc(22*scry) , hwndMain , cDemoBtn, HInstance, nil ); -HSettingsBtn := CreateWindow('button', 'settings button',WS_CHILD or WS_VISIBLE or BS_OWNERDRAW, trunc(590 * scrx), trunc(550 *scry), trunc(147* scrx) , trunc(22*scry) , hwndMain , cSettingsBtn, HInstance, nil ); -HExitGameBtn := CreateWindow('button', 'exit game button',WS_CHILD or WS_VISIBLE or BS_OWNERDRAW, trunc(530 * scrx), trunc(600 *scry), trunc(272* scrx) , trunc(22*scry) , hwndMain , cExitGameBtn, HInstance, nil ); -/// local menu /// -/// net menu /// -HNetIPEdit := CreateWindow('EDIT', '255.255.255.255' ,WS_CHILD or WS_TABSTOP, trunc(570* scrx), trunc(400*scry) , 150 , 16 , hwndMain , cNetIpEdit, HInstance, nil ); -HNetIPStatic := CreateWindow('STATIC','IP :' ,WS_CHILD or SS_SIMPLE, trunc(520* scrx), trunc(400*scry) , 50 , 16 , hwndMain , cNetIpStatic, HInstance, nil ); -HNetNameEdit := CreateWindow('EDIT', 'Hedgewarrior' ,WS_CHILD or WS_TABSTOP, trunc(570* scrx), trunc(420*scry) , 150 , 16 , hwndMain , cNetNameEdit, HInstance, nil ); -HNetNameStatic := CreateWindow('STATIC','Name : ' ,WS_CHILD or SS_SIMPLE, trunc(520* scrx), trunc(420*scry) , 50 , 16 , hwndMain , cNetNameStatic, HInstance, nil ); -HNetConnectionStatic - := CreateWindow('STATIC','not connected' ,WS_CHILD, trunc(520* scrx), trunc(450*scry) , 90 , 16 , hwndMain , cNetConnStatic, HInstance, nil ); -HNetJoinBtn := CreateWindow('BUTTON','Join Game' ,WS_CHILD or BS_FLAT or WS_TABSTOP, trunc(520* scrx), trunc(550*scry) , 90 , 20 , hwndMain , cNetJoinBtn, HInstance, nil ); -HNetBeginBtn := CreateWindow('BUTTON','Begin Game' ,WS_CHILD or BS_FLAT or WS_TABSTOP, trunc(520* scrx), trunc(575*scry) , 90 , 20 , hwndMain , cNetBeginBtn, HInstance, nil ); -HNetBackBtn := CreateWindow('BUTTON','Back' ,WS_CHILD or BS_FLAT or WS_TABSTOP, trunc(520* scrx), trunc(600*scry) , 90 , 20 , hwndMain , cNetBackBtn, HInstance, nil ); -/// demo menu /// -HDemoList := CreateWindow('LISTBOX','' ,WS_CHILD or WS_TABSTOP, trunc(530* scrx), trunc(400*scry) , trunc(200* scrx), trunc(200*scry), hwndMain, cDemoList, HInstance, nil ); -HDemoBeginBtn := CreateWindow('BUTTON','Play demo' ,WS_CHILD or BS_FLAT or WS_TABSTOP, trunc(750* scrx), trunc(400*scry) , 100 , 20 , hwndMain , cDemoBeginBtn, HInstance, nil ); -HDemoAllBtn := CreateWindow('BUTTON','Play all demos' ,WS_CHILD or BS_FLAT or WS_TABSTOP, trunc(750* scrx), trunc(425*scry) , 100 , 20 , hwndMain , cDemoAllBtn, HInstance, nil ); -HDemoBackBtn := CreateWindow('BUTTON','Back' ,WS_CHILD or BS_FLAT or WS_TABSTOP, trunc(750* scrx), trunc(450*scry) , 100 , 20 , hwndMain , cDemoBackBtn, HInstance, nil ); - -/// settings menu /// -HSetResEdit := CreateWindow('COMBOBOX', '' ,WS_CHILD or CBS_DROPDOWNLIST or WS_TABSTOP, trunc(530* scrx), trunc(420*scry) , 150 , 100 , hwndMain , cSetResEdit, HInstance, nil ); - -SendMessage(HSetResEdit, CB_ADDSTRING, 0, LPARAM(PChar('640x480'))); -SendMessage(HSetResEdit, CB_ADDSTRING, 0, LPARAM(PChar('800x600'))); -SendMessage(HSetResEdit, CB_ADDSTRING, 0, LPARAM(PChar('1024x768'))); -SendMessage(HSetResEdit, CB_ADDSTRING, 0, LPARAM(PChar('1280x1024'))); - -HFullScrCheck := CreateWindow('BUTTON','Fullscreen' ,WS_CHILD or BS_AUTOCHECKBOX or WS_TABSTOP, trunc(530* scrx), trunc(450*scry) , 110 , 20 , hwndMain , cSetFScrCheck, HInstance, nil ); -HSetDemoCheck := CreateWindow('BUTTON','Record Demo' ,WS_CHILD or BS_AUTOCHECKBOX or WS_TABSTOP, trunc(530* scrx), trunc(475*scry) , 110 , 20 , hwndMain , cSetDemoCheck, HInstance, nil ); -HSetSndCheck := CreateWindow('BUTTON','Enable Sound' ,WS_CHILD or BS_AUTOCHECKBOX or WS_TABSTOP, trunc(530* scrx), trunc(500*scry) , 110 , 20 , hwndMain , cSetSndCheck, HInstance, nil ); -HSetSaveBtn := CreateWindow('BUTTON','Save Settings' ,WS_CHILD or BS_FLAT or WS_TABSTOP, trunc(530* scrx), trunc(580*scry) , 100 , 20 , hwndMain , cSetSaveBtn, HInstance, nil ); -HSetBackBtn := CreateWindow('BUTTON','Back' ,WS_CHILD or BS_FLAT or WS_TABSTOP, trunc(730* scrx), trunc(580*scry) , 90 , 20 , hwndMain , cSetBackBtn, HInstance, nil ); -HSetShowTeamOptionsBtn := CreateWindow('BUTTON','Show Team Options' ,WS_CHILD or BS_FLAT or WS_TABSTOP, trunc(700* scrx), trunc(420*scry) , 140 , 20 , hwndMain , cSetShowTeamOptions, HInstance, nil ); -end; - -procedure DoCreateMainWindow; -var wc: WNDCLASS; -begin -FillChar(wc, sizeof(wc), 0); -wc.style := CS_VREDRAW or CS_HREDRAW; -wc.hbrBackground := COLOR_BACKGROUND; -wc.lpfnWndProc := @MainWndProc; -wc.hInstance := hInstance; -wc.lpszClassName := cAppName; -wc.hCursor := LoadCursor(hwndMain,IDC_ARROW); -if RegisterClass(wc) = 0 then begin MessageBox(0,'RegisterClass failed for main wnd','Failed',MB_OK); halt; end; -hwndMain := CreateWindowEx( 0, cAppName, cAppTitle, WS_POPUP, - 0, 0, - GetSystemMetrics(SM_CXSCREEN), GetSystemMetrics(SM_CYSCREEN), - 0, 0, hInstance, nil); - -ShowWindow(hwndMain,SW_SHOW); -UpdateWindow(hwndMain) -end; - - -end. +(* + * Hedgewars, a worms-like game + * Copyright (c) 2004, 2005 Andrey Korotaev + * + * 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 ffe4ad26a64c -r bcbd7adb4e4b hedgewars/fGame.pas --- a/hedgewars/fGame.pas Mon Aug 22 21:38:06 2005 +0000 +++ b/hedgewars/fGame.pas Tue Aug 23 16:17:53 2005 +0000 @@ -1,232 +1,232 @@ -(* - * Hedgewars, a worms-like game - * Copyright (c) 2004, 2005 Andrey Korotaev - * - * Distributed under the terms of the BSD-modified licence: - * - * Permission is hereby granted, free of charge, to any person obtaining a copy - * of this software and associated documentation files (the "Software"), to deal - * with the Software without restriction, including without limitation the - * rights to use, copy, modify, merge, publish, distribute, sublicense, and/or - * sell copies of the Software, and to permit persons to whom the Software is - * furnished to do so, subject to the following conditions: - * - * 1. Redistributions of source code must retain the above copyright notice, - * this list of conditions and the following disclaimer. - * 2. Redistributions in binary form must reproduce the above copyright notice, - * this list of conditions and the following disclaimer in the documentation - * and/or other materials provided with the distribution. - * 3. The name of the author may not be used to endorse or promote products - * derived from this software without specific prior written permission. - * - * THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR IMPLIED - * WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF - * MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO - * EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, - * SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, - * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; - * OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, - * WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR - * OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF - * ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. - *) - -unit fGame; -interface -uses Windows; - -procedure GameStart; -procedure StartNetGame; -procedure StartDemoView; -procedure StartLocalGame; - -implementation -uses fMisc, fGUI, uConsts, uRandom, Messages, fConsts, SysUtils, fIPC, fNet; -const - fmCreate = $FFFF; - fmOpenRead = $0000; - fmOpenWrite = $0001; - fmOpenReadWrite = $0002; - -var - MapPoints: array[0..19] of TPoint; - -function GetNextLine(var f: textfile): string; -begin -repeat - Readln(f, Result) -until (Length(Result)>0)and(Result[1] <> '#') -end; - -function GetThemeBySeed: string; -var f: text; - i, n, t: integer; -begin -Result:= ''; -n:= 37; -for i:= 1 to Length(seed) do - n:= (n shl 1) xor byte(seed[i]) xor n; -FileMode:= fmOpenRead; -AssignFile(f, Pathz[ptThemes] + 'themes.cfg'); -{$I-} -Reset(f); -val(GetNextLine(f), i, t); -if i > 0 then - begin - n:= n mod i; - for i:= 0 to n do Result:= GetNextLine(f) - end; -CloseFile(f); -{$I+} -FileMode:= fmOpenReadWrite; -if IOResult <> 0 then - begin - MessageBox(hwndMain,PChar(String('Missing, corrupted or cannot access critical file'#13#10+Pathz[ptThemes] + 'themes.cfg')),'Ahctung!!!',MB_OK); - exit - end -end; - -function ExecAndWait(FileName:String; Visibility : integer): Cardinal; -var WorkDir: String; - StartupInfo:TStartupInfo; - ProcessInfo:TProcessInformation; -begin -GetDir(0, WorkDir); -FillChar(StartupInfo, Sizeof(StartupInfo), 0); -with StartupInfo do - begin - cb:= Sizeof(StartupInfo); - dwFlags:= STARTF_USESHOWWINDOW; - wShowWindow:= Visibility - end; -if not CreateProcess(nil, PChar(FileName), nil, nil, - false, CREATE_DEFAULT_ERROR_MODE or CREATE_NEW_CONSOLE or NORMAL_PRIORITY_CLASS, - nil, nil, StartupInfo, ProcessInfo) - then Result:= High(Cardinal) - else begin - while WaitforSingleObject(ProcessInfo.hProcess, 0) = WAIT_TIMEOUT do - begin - Sleep(10); - ProcessMessages; - end; - GetExitCodeProcess(ProcessInfo.hProcess, Result); - CloseHandle(ProcessInfo.hProcess); - CloseHandle(ProcessInfo.hThread) - end -end; - -procedure GameStart; -var sTheme:string; -begin -if seed = '' then - begin - MessageBox(hwndMain,'seed is unknown, but game started','Ahctung!!!',MB_OK); - exit - end; -sTheme:= GetThemeBySeed; -//if ExecAndWait('landgen.exe ' + sTheme + ' ' + seed, SW_HIDE) = 0 then - begin - ShowWindow(hwndMain, SW_MINIMIZE); - fWriteDemo:= SendMessage(HSetDemoCheck, BM_GETCHECK, 0, 0) = BST_CHECKED; - if fWriteDemo then - begin - AssignDemoFile('demo.hwd_1'); - inc(seed[0]); - seed[Length(seed)]:= cDemoSeedSeparator; - WriteStrToDemo(seed) - end; - case ExecAndWait(format('hw.exe %s %s %d %s %d',[Resolutions[SendMessage(HSetResEdit,CB_GETCURSEL,0,0)], sTheme, IN_IPC_PORT, seed, SendMessage(HFullScrCheck,BM_GETCHECK,0,0)]), SW_NORMAL) of - High(Cardinal): MessageBox(hwndMain,'error executing game','fuck!',MB_OK); - end; - if fWriteDemo then - CloseDemoFile; - seed:= ''; - ShowWindow(hwndMain, SW_RESTORE) - end {else begin - MessageBox(hwndMain,'error executing landgen','fuck!',MB_OK); - exit - end; } -end; - -procedure StartNetGame; -var i, ii: LongWord; - s: shortstring; - p: TPoint; - sbuf: string; -begin // totally broken -GenRandomSeed; -SendNet('z'+seed); -sbuf:= GetThemeBySeed; -if ExecAndWait(format('landgen.exe %s %s',[sbuf, seed]), SW_HIDE) <> 0 then - begin - MessageBox(hwndMain,'error executing landgen','error',MB_OK); - exit; - end; -SendNetAndWait('T'); -SendNet('K'); { -for i:= 1 to TeamCount do - begin - s[0]:= #9; - s[1]:= 'h'; - for ii:= 0 to 1 do - begin - p:= GetRandomMapPoint; - PLongWord(@s[2])^:= p.X; - PLongWord(@s[6])^:= p.Y; - SendNet(s); - end; - if i < TeamCount then SendNet('k'); - end; } -SendNet('G') -end; - -procedure StartDemoView; -const cBufSize = 32; -var f: file; - buf: array[0..pred(cBufSize)] of byte; - i, t: integer; -begin -if SendMessage(HDemoList,LB_GETCURSEL,0,0) = LB_ERR then//LBDemos.ItemIndex<0 then - begin - MessageBox(hwndMain,'Выбери демку слева','hint',MB_OK); - exit - end; -GameType:= gtDemo; -i:= SendMessage(HDemoList,LB_GETCURSEL,0,0); -t:= SendMessage(HDemoList, LB_GETTEXTLEN, i, 0); -SetLength(DemoFileName, t); -SendMessage(HDemoList,LB_GETTEXT, i, LPARAM(@DemoFileName[1])); -DemoFileName:= Pathz[ptDemos] + DemoFileName; -AssignFile(f, DemoFileName); -{$I-} -FileMode:= fmOpenRead; -Reset(f, 1); -FileMode:= fmOpenReadWrite; -if IOResult <> 0 then - begin - MessageBox(hwndMain,'file not found','error',MB_OK); - exit; - end; -BlockRead(f, buf, cBufSize, t); // вырезаем seed -seed:= ''; -i:= 0; -while (char(buf[i]) <> cDemoSeedSeparator)and (i < t) do - begin - seed:= seed + chr(buf[i]); - inc(i); - end; -CloseFile(f); -{$I+} -GameStart -end; - -procedure StartLocalGame; -begin -GenRandomSeed; -GameType:= gtLocal; -GameStart -end; - - - -end. +(* + * Hedgewars, a worms-like game + * Copyright (c) 2004, 2005 Andrey Korotaev + * + * 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 ffe4ad26a64c -r bcbd7adb4e4b hedgewars/fIPC.pas --- a/hedgewars/fIPC.pas Mon Aug 22 21:38:06 2005 +0000 +++ b/hedgewars/fIPC.pas Tue Aug 23 16:17:53 2005 +0000 @@ -1,62 +1,62 @@ -(* - * Hedgewars, a worms-like game - * Copyright (c) 2004, 2005 Andrey Korotaev - * - * Distributed under the terms of the BSD-modified licence: - * - * Permission is hereby granted, free of charge, to any person obtaining a copy - * of this software and associated documentation files (the "Software"), to deal - * with the Software without restriction, including without limitation the - * rights to use, copy, modify, merge, publish, distribute, sublicense, and/or - * sell copies of the Software, and to permit persons to whom the Software is - * furnished to do so, subject to the following conditions: - * - * 1. Redistributions of source code must retain the above copyright notice, - * this list of conditions and the following disclaimer. - * 2. Redistributions in binary form must reproduce the above copyright notice, - * this list of conditions and the following disclaimer in the documentation - * and/or other materials provided with the distribution. - * 3. The name of the author may not be used to endorse or promote products - * derived from this software without specific prior written permission. - * - * THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR IMPLIED - * WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF - * MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO - * EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, - * SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, - * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; - * OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, - * WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR - * OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF - * ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. - *) - -unit fIPC;{$J+} -interface -uses Messages, WinSock, Windows; -const - IN_IPC_PORT = 46631; - WM_ASYNC_IPCEVENT = WM_USER + 1; - -function InitIPCServer: boolean; -procedure SendIPC(s: shortstring); -procedure IPCEvent(sock: TSocket; lParam: LPARAM); - -var DemoFileName: string; - -implementation -uses fGUI, fMisc, fNet, uConsts, fGame, SysUtils, fConsts; - -var hIPCListenSockTCP : TSocket = INVALID_SOCKET; - hIPCServerSocket : TSocket = INVALID_SOCKET; - -function InitIPCServer: boolean; -var myaddrTCP: TSockAddrIn; - t: integer; -begin -Result:= false; -hIPCListenSockTCP:= socket(AF_INET, SOCK_STREAM, 0); -myaddrTCP.sin_family := AF_INET; +(* + * Hedgewars, a worms-like game + * Copyright (c) 2004, 2005 Andrey Korotaev + * + * Distributed under the terms of the BSD-modified licence: + * + * Permission is hereby granted, free of charge, to any person obtaining a copy + * of this software and associated documentation files (the "Software"), to deal + * with the Software without restriction, including without limitation the + * rights to use, copy, modify, merge, publish, distribute, sublicense, and/or + * sell copies of the Software, and to permit persons to whom the Software is + * furnished to do so, subject to the following conditions: + * + * 1. Redistributions of source code must retain the above copyright notice, + * this list of conditions and the following disclaimer. + * 2. Redistributions in binary form must reproduce the above copyright notice, + * this list of conditions and the following disclaimer in the documentation + * and/or other materials provided with the distribution. + * 3. The name of the author may not be used to endorse or promote products + * derived from this software without specific prior written permission. + * + * THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR IMPLIED + * WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF + * MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO + * EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, + * SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, + * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; + * OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, + * WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR + * OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF + * ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + *) + +unit fIPC;{$J+} +interface +uses Messages, WinSock, Windows; +const + IN_IPC_PORT = 46631; + WM_ASYNC_IPCEVENT = WM_USER + 1; + +function InitIPCServer: boolean; +procedure SendIPC(s: shortstring); +procedure IPCEvent(sock: TSocket; lParam: LPARAM); + +var DemoFileName: string; + +implementation +uses fGUI, fMisc, fNet, uConsts, fGame, SysUtils, fConsts; + +var hIPCListenSockTCP : TSocket = INVALID_SOCKET; + hIPCServerSocket : TSocket = INVALID_SOCKET; + +function InitIPCServer: boolean; +var myaddrTCP: TSockAddrIn; + t: integer; +begin +Result:= false; +hIPCListenSockTCP:= socket(AF_INET, SOCK_STREAM, 0); +myaddrTCP.sin_family := AF_INET; myaddrTCP.sin_addr.s_addr := $0100007F; myaddrTCP.sin_port := htons(IN_IPC_PORT); t:= sizeof(TSockAddrIn); @@ -64,121 +64,121 @@ if ( listen(hIPCListenSockTCP, 1) <> 0) then exit; WSAAsyncSelect(hIPCListenSockTCP, hwndMain, WM_ASYNC_IPCEVENT, FD_ACCEPT or FD_READ or FD_CLOSE); Result:= true -end; - -procedure SendIPC(s: shortstring); -begin -if hIPCServerSocket <> INVALID_SOCKET then - begin - send(hIPCServerSocket, s[0], Succ(byte(s[0])), 0); - if fWriteDemo then - if not((Length(s) > 5) and (copy(s, 1, 5) = 'ebind')) then - WriteRawToDemo(s) - end; -end; - -procedure SendConfig; -const cBufLength = $10000; -{$INCLUDE revision.inc} -var f: file; - buf: array[0..Pred(cBufLength)] of byte; - i, t: integer; - s: shortstring; - sbuf:string; -begin -SendIPC('WFrontend svn ' + cRevision); -SendIPC(format('e$sound %d',[SendMessage(HSetSndCheck, BM_GETCHECK, 0, 0)])); -case GameType of - gtLocal: begin - SendIPC(format('e$gmflags %d',[0])); - SendIPC('eaddteam'); - ExecCFG(Pathz[ptTeams] + 'unC0Rr.cfg'); - SendIPC('ecolor 65535'); - SendIPC('eadd hh0 0'); - SendIPC('eadd hh1 0'); - SendIPC('eadd hh2 0'); - SendIPC('eadd hh3 0'); - SendIPC('eaddteam'); - ExecCFG(Pathz[ptTeams] + 'test.cfg'); - SendIPC('eadd hh0 1'); - SendIPC('eadd hh1 1'); - SendIPC('eadd hh2 1'); - SendIPC('eadd hh3 1'); - SendIPC('ecolor 16776960'); - end; - gtDemo: begin - AssignFile(f, DemoFileName); - {$I-} - Reset(f, 1); - if IOResult <> 0 then - begin - SendIPC('ECannot open file: "' + Pathz[ptDemos] + sbuf + '"'); - exit; - end; - s:= 'TD'; - s[0]:= #6; - PLongWord(@s[3])^:= FileSize(f); - SendIPC(s); // посылаем тип игры - демо и размер демки - BlockRead(f, buf, cBufLength, t); // вырезаем seed - i:= 0; - while (chr(buf[i]) <> cDemoSeedSeparator)and (i < t) do inc(i); - inc(i); - // посылаем остаток файла - repeat - while i < t do - begin - CopyMemory(@s[0], @buf[i], Succ(buf[i])); - SendIPC(s); - inc(i, buf[i]); - inc(i) - end; - i:= 0; - BlockRead(f, buf, cBufLength, t); - until t = 0; - Closefile(f); - {$I+} - end; - gtNet: SendNet('C'); - end; -end; - -procedure ParseIPCCommand(s: shortstring); -begin -case s[1] of - '?': if GameType = gtNet then SendNet('?') else SendIPC('!'); - 'C': SendConfig; - else if GameType = gtNet then SendNet(s); - if fWriteDemo and (s[1] <> '+') then WriteRawToDemo(s) - end; -end; - -procedure IPCEvent(sock: TSocket; lParam: LPARAM); -const sipc: string = ''; -var WSAEvent: word; - i: integer; - buf: array[0..255] of byte; - s: shortstring absolute buf; -begin -WSAEvent:= WSAGETSELECTEVENT(lParam); -case WSAEvent of - FD_CLOSE: begin - closesocket(sock); - hIPCServerSocket:= INVALID_SOCKET; - exit - end; - FD_READ: begin - repeat - i:= recv(sock, buf[1], 255, 0); - if i > 0 then - begin - buf[0]:= i; - sipc:= sipc + s; - SplitStream2Commands(sipc, ParseIPCCommand); - end; - until i < 1; - end; - FD_ACCEPT: hIPCServerSocket:= accept(hIPCListenSockTCP, nil, nil); - end -end; - -end. +end; + +procedure SendIPC(s: shortstring); +begin +if hIPCServerSocket <> INVALID_SOCKET then + begin + send(hIPCServerSocket, s[0], Succ(byte(s[0])), 0); + if fWriteDemo then + if not((Length(s) > 5) and (copy(s, 1, 5) = 'ebind')) then + WriteRawToDemo(s) + end; +end; + +procedure SendConfig; +const cBufLength = $10000; +{$INCLUDE revision.inc} +var f: file; + buf: array[0..Pred(cBufLength)] of byte; + i, t: integer; + s: shortstring; + sbuf:string; +begin +SendIPC('WFrontend svn ' + cRevision); +SendIPC(format('e$sound %d',[SendMessage(HSetSndCheck, BM_GETCHECK, 0, 0)])); +case GameType of + gtLocal: begin + SendIPC(format('e$gmflags %d',[0])); + SendIPC('eaddteam'); + ExecCFG(Pathz[ptTeams] + 'unC0Rr.cfg'); + SendIPC('ecolor 65535'); + SendIPC('eadd hh0 0'); + SendIPC('eadd hh1 0'); + SendIPC('eadd hh2 0'); + SendIPC('eadd hh3 0'); + SendIPC('eaddteam'); + ExecCFG(Pathz[ptTeams] + 'test.cfg'); + SendIPC('eadd hh0 1'); + SendIPC('eadd hh1 1'); + SendIPC('eadd hh2 1'); + SendIPC('eadd hh3 1'); + SendIPC('ecolor 16776960'); + end; + gtDemo: begin + AssignFile(f, DemoFileName); + {$I-} + Reset(f, 1); + if IOResult <> 0 then + begin + SendIPC('ECannot open file: "' + Pathz[ptDemos] + sbuf + '"'); + exit; + end; + s:= 'TD'; + s[0]:= #6; + PLongWord(@s[3])^:= FileSize(f); + SendIPC(s); // посылаем тип игры - демо и размер демки + BlockRead(f, buf, cBufLength, t); // вырезаем seed + i:= 0; + while (chr(buf[i]) <> cDemoSeedSeparator)and (i < t) do inc(i); + inc(i); + // посылаем остаток файла + repeat + while i < t do + begin + CopyMemory(@s[0], @buf[i], Succ(buf[i])); + SendIPC(s); + inc(i, buf[i]); + inc(i) + end; + i:= 0; + BlockRead(f, buf, cBufLength, t); + until t = 0; + Closefile(f); + {$I+} + end; + gtNet: SendNet('C'); + end; +end; + +procedure ParseIPCCommand(s: shortstring); +begin +case s[1] of + '?': if GameType = gtNet then SendNet('?') else SendIPC('!'); + 'C': SendConfig; + else if GameType = gtNet then SendNet(s); + if fWriteDemo and (s[1] <> '+') then WriteRawToDemo(s) + end; +end; + +procedure IPCEvent(sock: TSocket; lParam: LPARAM); +const sipc: string = ''; +var WSAEvent: word; + i: integer; + buf: array[0..255] of byte; + s: shortstring absolute buf; +begin +WSAEvent:= WSAGETSELECTEVENT(lParam); +case WSAEvent of + FD_CLOSE: begin + closesocket(sock); + hIPCServerSocket:= INVALID_SOCKET; + exit + end; + FD_READ: begin + repeat + i:= recv(sock, buf[1], 255, 0); + if i > 0 then + begin + buf[0]:= i; + sipc:= sipc + s; + SplitStream2Commands(sipc, ParseIPCCommand); + end; + until i < 1; + end; + FD_ACCEPT: hIPCServerSocket:= accept(hIPCListenSockTCP, nil, nil); + end +end; + +end. diff -r ffe4ad26a64c -r bcbd7adb4e4b hedgewars/fMisc.pas --- a/hedgewars/fMisc.pas Mon Aug 22 21:38:06 2005 +0000 +++ b/hedgewars/fMisc.pas Tue Aug 23 16:17:53 2005 +0000 @@ -1,203 +1,203 @@ -(* - * Hedgewars, a worms-like game - * Copyright (c) 2004, 2005 Andrey Korotaev - * - * Distributed under the terms of the BSD-modified licence: - * - * Permission is hereby granted, free of charge, to any person obtaining a copy - * of this software and associated documentation files (the "Software"), to deal - * with the Software without restriction, including without limitation the - * rights to use, copy, modify, merge, publish, distribute, sublicense, and/or - * sell copies of the Software, and to permit persons to whom the Software is - * furnished to do so, subject to the following conditions: - * - * 1. Redistributions of source code must retain the above copyright notice, - * this list of conditions and the following disclaimer. - * 2. Redistributions in binary form must reproduce the above copyright notice, - * this list of conditions and the following disclaimer in the documentation - * and/or other materials provided with the distribution. - * 3. The name of the author may not be used to endorse or promote products - * derived from this software without specific prior written permission. - * - * THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR IMPLIED - * WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF - * MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO - * EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, - * SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, - * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; - * OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, - * WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR - * OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF - * ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. - *) - -unit fMisc; -{$J+} -interface -uses uConsts, Windows; -const - fWriteDemo: boolean = false; -type - TGameType = (gtLocal, gtNet, gtDemo); - TCommandHandler = procedure (s: shortstring); - -procedure ExecCFG(FileName: String); -procedure AssignDemoFile(Filename: shortstring); -procedure WriteRawToDemo(s: shortstring); -procedure WriteStrToDemo(s: shortstring); -procedure CloseDemoFile; -procedure GenRandomSeed; -procedure SaveSettings; -procedure SplitStream2Commands(var ss: string; Handler: TCommandHandler); -function MainWndProc(hwnd: HWND; Message: UINT; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall; -procedure LoadOwnerBitmap(var bmp: HBITMAP; name: string; var dc: HDC; owner:cardinal ); -procedure DoInit; -procedure InitWSA; - -var - seed: shortstring; - GameType: TGameType; - -implementation -uses fIPC, uRandom, IniFiles, SysUtils, Messages, fGUI, fNet, WinSock, fOptionsGUI; -var fDemo: file; - -procedure ExecCFG(FileName: String); -var f: textfile; - s: shortstring; -begin -AssignFile(f, FileName); -{$I-} -Reset(f); -{$I+} -if IOResult<>0 then SendIPC('ECannot open file: "' + FileName + '"'); -while not eof(f) do - begin - ReadLn(f, s); - if (s[0]<>#0)and(s[1]<>';') then SendIPC('e' + s); - end; -CloseFile(f) -end; - -procedure AssignDemoFile(Filename: shortstring); -begin -Assign(fDemo, Filename); -Rewrite(fDemo, 1) -end; - -procedure WriteRawToDemo(s: shortstring); -begin -if not fWriteDemo then exit; -BlockWrite(fDemo, s[0], Succ(byte(s[0]))) -end; - -procedure WriteStrToDemo(s: shortstring); -begin -if not fWriteDemo then exit; -BlockWrite(fDemo, s[1], byte(s[0])) -end; - -procedure CloseDemoFile; -begin -CloseFile(fDemo) -end; - -procedure GenRandomSeed; -var i: integer; -begin -seed[0]:= chr(7 + GetRandom(6)); -for i:= 1 to byte(seed[0]) do seed[i]:= chr(byte('A') + GetRandom(26)); -seed:= '('+seed+')' -end; - -procedure SaveSettings; -var inif: TIniFile; -begin -inif:= TIniFile.Create(ExtractFilePath(ParamStr(0))+'hw.ini'); -inif.WriteInteger('Misc', 'ResIndex', SendMessage(HSetResEdit, CB_GETCURSEL, 0, 0)); -inif.WriteInteger('Misc', 'EnableSound', SendMessage(HSetSndCheck, BM_GETCHECK, 0, 0)); -inif.WriteInteger('Misc', 'Fullscreen', SendMessage(HFullScrCheck, BM_GETCHECK, 0, 0)); -inif.UpdateFile; -inif.Free -end; - -procedure SplitStream2Commands(var ss: string; Handler: TCommandHandler); -var s: shortstring; -begin -while (Length(ss) > 1)and(Length(ss) > byte(ss[1])) do - begin - s:= copy(ss, 2, byte(ss[1])); - Delete(ss, 1, Succ(byte(ss[1]))); - Handler(s) - end; -end; - -function MainWndProc(hwnd: HWND; Message: UINT; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall; -begin -case Message of - WM_ASYNC_IPCEVENT: IPCEvent(wParam, lParam); - WM_ASYNC_NETEVENT: NetEvent(wParam, lParam); - WM_COMMAND : DoControlPress(wParam, lParam); - WM_DRAWITEM: DoDrawButton(wParam,PDRAWITEMSTRUCT(lParam)); - WM_CLOSE : PostQuitMessage(0); - WM_DESTROY : if hwnd = hwndMain then DoDestroy - end; -Result:= DefWindowProc(hwnd, Message, wParam,lParam) -end; - -procedure LoadOwnerBitmap(var bmp: HBITMAP; name: string; var dc: HDC; owner:cardinal ); -begin -bmp := LoadImage(0,PChar(name), IMAGE_BITMAP,0,0,LR_LOADFROMFILE); -if bmp = 0 then - begin - MessageBox(hwndMain, PChar(name + ' not found'), 'damn', MB_OK); - PostQuitMessage(0); - end; -dc:=CreateCompatibleDC(GetDC(owner)); -SelectObject(dc,bmp); -end; - -procedure DoInit; -var sr: TSearchRec; - i: integer; - inif: TIniFile; - p: TPoint; -begin -GetCursorPos(p); -SetRandomParams(IntToStr(GetTickCount), IntToStr(p.X)+'(сеху)'+IntToStr(p.Y)); -i:= FindFirst('Data\Maps\*', faDirectory, sr); -while i=0 do - begin - if sr.Name[1]<>'.' then ;//LBMaps.Items.Add(sr.Name); - i:= FindNext(sr) - end; -FindClose(sr); - -inif:= TIniFile.Create(ExtractFilePath(ParamStr(0))+'hw.ini'); -i:= inif.ReadInteger('Misc', 'ResIndex', 0); -if inif.ReadBool('Misc', 'EnableSound', true) then SendMessage(HSetSndCheck,BM_SETCHECK,BST_CHECKED,0); -if inif.ReadBool('Misc', 'Fullscreen', true) then SendMessage(HFullScrCheck,BM_SETCHECK,BST_CHECKED,0); -if (i>=0)and(i<=3) then SendMessage(HSetResEdit,CB_SETCURSEL,i,0); -SetWindowText(HNetIPEdit,PChar(inif.ReadString('Net','IP' , '' ))); -SetWindowText(HNetNameEdit,PChar(inif.ReadString('Net','Nick', 'Unnamed'))); -inif.Free; -SendMessage(HSetDemoCheck, BM_SETCHECK, BST_CHECKED, 0); -end; - -procedure InitWSA; -var stWSADataTCPIP: WSADATA; -begin -if WSAStartup($0101, stWSADataTCPIP)<>0 then - begin - MessageBox(0, 'WSAStartup error !', 'NET ERROR!!!', 0); - halt - end; -if not InitIPCServer then - begin - MessageBox(0, 'Error on init IPC server!', 'IPC Error', 0); - halt - end -end; - - -end. +(* + * Hedgewars, a worms-like game + * Copyright (c) 2004, 2005 Andrey Korotaev + * + * 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 ffe4ad26a64c -r bcbd7adb4e4b hedgewars/fNet.pas --- a/hedgewars/fNet.pas Mon Aug 22 21:38:06 2005 +0000 +++ b/hedgewars/fNet.pas Tue Aug 23 16:17:53 2005 +0000 @@ -1,165 +1,165 @@ -(* - * Hedgewars, a worms-like game - * Copyright (c) 2004, 2005 Andrey Korotaev - * - * Distributed under the terms of the BSD-modified licence: - * - * Permission is hereby granted, free of charge, to any person obtaining a copy - * of this software and associated documentation files (the "Software"), to deal - * with the Software without restriction, including without limitation the - * rights to use, copy, modify, merge, publish, distribute, sublicense, and/or - * sell copies of the Software, and to permit persons to whom the Software is - * furnished to do so, subject to the following conditions: - * - * 1. Redistributions of source code must retain the above copyright notice, - * this list of conditions and the following disclaimer. - * 2. Redistributions in binary form must reproduce the above copyright notice, - * this list of conditions and the following disclaimer in the documentation - * and/or other materials provided with the distribution. - * 3. The name of the author may not be used to endorse or promote products - * derived from this software without specific prior written permission. - * - * THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR IMPLIED - * WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF - * MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO - * EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, - * SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, - * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; - * OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, - * WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR - * OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF - * ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. - *) - -unit fNet;{$J+} -interface -uses Messages, WinSock, Windows; -const - NET_PORT = 46632; - WM_ASYNC_NETEVENT = WM_USER + 2; - -procedure SendNet(s: shortstring); -procedure SendNetAndWait(s: shortstring); -procedure NetConnect; -procedure NetEvent(sock: TSocket; lParam: LPARAM); - -var - TeamCount: LongWord; - -implementation -uses fGUI, fMisc, fGame, fIPC, uConsts, IniFiles, SysUtils; -var - hNetClientSocket: TSocket = INVALID_SOCKET; - isPonged: boolean; - -procedure SendNet(s: shortstring); -begin -if hNetClientSocket <> INVALID_SOCKET then - send(hNetClientSocket, s[0], Succ(byte(s[0])), 0) -end; - -procedure SendNetAndWait(s: shortstring); -begin -SendNet(s); -SendNet('?'); -isPonged:= false; -repeat - ProcessMessages; - sleep(1) -until isPonged -end; - -procedure ParseNetCommand(s: shortstring); -var sbuf : string; -begin -case s[1] of - '?': SendNet('!'); - 'i': begin - sbuf:= GetWindowTextStr(HNetNameEdit); - SendNet('n' + sbuf);; - end; - 'z': begin - seed:= copy(s, 2, length(s) - 1) - end; - 'G': begin - GameType:= gtNet; - GameStart - end; - '@': ExecCFG(Pathz[ptTeams] + 'unC0Rr.cfg'); - '!': begin - isPonged:= true; - SendIPC('!'); - end; - 'T': TeamCount:= PLongWord(@s[2])^ - else SendIPC(s) end; -end; - -procedure NetConnect; -var rmaddr: SOCKADDR_IN; - inif: TIniFile; - sbuf1,sbuf2: string; -begin -sbuf1:= GetWindowTextStr(HNetIPEdit); -inif:= TIniFile.Create(ExtractFilePath(ParamStr(0))+'hw.ini'); -inif.WriteString('Net','IP' , sbuf1); -sbuf2:= GetWindowTextStr(HNetNameEdit); -inif.WriteString('Net','Nick', sbuf2); -inif.Free; -SetWindowText(HNetConnectionStatic,'Connecting...'); -rmaddr.sin_family := AF_INET; -rmaddr.sin_addr.s_addr := inet_addr(PChar(sbuf1)); -rmaddr.sin_port := htons(NET_PORT); -hNetClientSocket:= socket(AF_INET, SOCK_STREAM, 0); -if INVALID_SOCKET = hNetClientSocket then - begin - MessageBox(hwndMain,'connect failed','failed',MB_OK); - SetWindowText(HNetConnectionStatic,'Error on connect'); - exit - end; -WSAAsyncSelect(hNetClientSocket, hwndMain, WM_ASYNC_NETEVENT, FD_CONNECT or FD_READ or FD_CLOSE); -connect(hNetClientSocket, rmaddr, sizeof(rmaddr)) -end; - -procedure NetEvent(sock: TSocket; lParam: LPARAM); -const snet: string = ''; -var WSAEvent: word; - i: integer; - buf: array[0..255] of byte; - s: shortstring absolute buf; -begin -WSAEvent:= WSAGETSELECTEVENT(lParam); -case WSAEvent of - FD_CLOSE: begin - closesocket(sock); -// hIPCServerSocket:= INVALID_SOCKET; гм-гм... FIXME: что-то тут должно быть имхо - SetWindowText(HNetConnectionStatic, 'Disconnected'); - GameType:= gtLocal - end; - FD_READ: begin - repeat - i:= recv(sock, buf[1], 255, 0); - if i > 0 then - begin - buf[0]:= i; - snet:= snet + s; - SplitStream2Commands(snet, ParseNetCommand); - end; - until i < 1 - end; - FD_CONNECT: begin - i:= WSAGETSELECTERROR(lParam); - if i<>0 then - begin - closesocket(sock); - MessageBox(hwndMain,'Error on connect', 'Error', MB_OK); - SetWindowText(HNetConnectionStatic, 'Error on connect') - end else - begin - SetWindowText(HNetConnectionStatic,'connected'); - GameType:= gtNet - end; - end - end -end; - -end. +(* + * Hedgewars, a worms-like game + * Copyright (c) 2004, 2005 Andrey Korotaev + * + * 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 ffe4ad26a64c -r bcbd7adb4e4b hedgewars/fOptionsGUI.pas --- a/hedgewars/fOptionsGUI.pas Mon Aug 22 21:38:06 2005 +0000 +++ b/hedgewars/fOptionsGUI.pas Tue Aug 23 16:17:53 2005 +0000 @@ -1,86 +1,86 @@ -(* - * Hedgewars, a worms-like game - * Copyright (c) 2004, 2005 Andrey Korotaev - * - * Distributed under the terms of the BSD-modified licence: - * - * Permission is hereby granted, free of charge, to any person obtaining a copy - * of this software and associated documentation files (the "Software"), to deal - * with the Software without restriction, including without limitation the - * rights to use, copy, modify, merge, publish, distribute, sublicense, and/or - * sell copies of the Software, and to permit persons to whom the Software is - * furnished to do so, subject to the following conditions: - * - * 1. Redistributions of source code must retain the above copyright notice, - * this list of conditions and the following disclaimer. - * 2. Redistributions in binary form must reproduce the above copyright notice, - * this list of conditions and the following disclaimer in the documentation - * and/or other materials provided with the distribution. - * 3. The name of the author may not be used to endorse or promote products - * derived from this software without specific prior written permission. - * - * THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR IMPLIED - * WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF - * MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO - * EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, - * SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, - * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; - * OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, - * WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR - * OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF - * ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. - *) - -unit fOptionsGUI; -interface -uses windows, - messages,SysUtils; - -procedure DoCreateOptionsWindow; -procedure ShowOptionsWindow; -procedure DoCreateOptionsControls; - -var HOptTeamName, HOptBGStatic : HWND; - HOptHedgeName : array[0..7] of HWND; - - - -implementation -uses fGUI, - fConsts, fMisc; - -procedure ShowOptionsWindow; -begin -ShowWindow(hwndOptions,SW_SHOW); -ShowWindow(hwndMain, SW_HIDE); -ShowWindow(HOptTeamName,SW_SHOW) -end; - -procedure DoCreateOptionsControls; -var i:integer; -begin -HOptBGStatic := CreateWindow('STATIC','opt bg img' ,WS_CHILD or WS_VISIBLE or SS_OWNERDRAW, 0, 0, GetSystemMetrics(SM_CXSCREEN), GetSystemMetrics(SM_CYSCREEN) , hwndOptions, cOptBGStatic, HInstance, nil); -HOptTeamName := CreateWindow('EDIT','Колючая Команда',WS_CHILD or WS_TABSTOP or WS_VISIBLE, trunc(260 * scrx), trunc(70 *scry), trunc(215* scrx) , trunc(28*scry) , hwndOptions, cOptTeamName, HInstance, nil); -for i := 0 to 7 do -HOptHedgeName[i] := CreateWindow('EDIT',PChar('Йож '+inttostr(i+1)),WS_CHILD or WS_TABSTOP or WS_VISIBLE, trunc(110 * scrx), trunc((102+i*28)*scry), trunc(260* scrx) , trunc(25*scry) , hwndOptions, cOptTeamName, HInstance, nil); -end; - -procedure DoCreateOptionsWindow; -var wc: WNDCLASS; -begin -FillChar(wc, sizeof(wc), 0); -wc.style := CS_VREDRAW or CS_HREDRAW; -wc.hbrBackground := COLOR_BACKGROUND; -wc.lpfnWndProc := @MainWndProc; -wc.hInstance := hInstance; -wc.lpszClassName := cOptionsName; -wc.hCursor := LoadCursor(hwndOptions,IDC_ARROW); -if RegisterClass(wc) = 0 then begin MessageBox(0,'RegisterClass failed for opts wnd','Failed',MB_OK); halt; end; -hwndOptions := CreateWindowEx(0, cOptionsName, cOptionsTitle, WS_POPUP, - 0, 0, - GetSystemMetrics(SM_CXSCREEN), GetSystemMetrics(SM_CYSCREEN), - 0, 0, hInstance, nil) -end; - - -end. +(* + * Hedgewars, a worms-like game + * Copyright (c) 2004, 2005 Andrey Korotaev + * + * 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 ffe4ad26a64c -r bcbd7adb4e4b hedgewars/getrevnum.dpr --- a/hedgewars/getrevnum.dpr Mon Aug 22 21:38:06 2005 +0000 +++ b/hedgewars/getrevnum.dpr Tue Aug 23 16:17:53 2005 +0000 @@ -1,52 +1,52 @@ -(* - * Hedgewars, a worms-like game - * Copyright (c) 2004, 2005 Andrey Korotaev - * - * Distributed under the terms of the BSD-modified licence: - * - * Permission is hereby granted, free of charge, to any person obtaining a copy - * of this software and associated documentation files (the "Software"), to deal - * with the Software without restriction, including without limitation the - * rights to use, copy, modify, merge, publish, distribute, sublicense, and/or - * sell copies of the Software, and to permit persons to whom the Software is - * furnished to do so, subject to the following conditions: - * - * 1. Redistributions of source code must retain the above copyright notice, - * this list of conditions and the following disclaimer. - * 2. Redistributions in binary form must reproduce the above copyright notice, - * this list of conditions and the following disclaimer in the documentation - * and/or other materials provided with the distribution. - * 3. The name of the author may not be used to endorse or promote products - * derived from this software without specific prior written permission. - * - * THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR IMPLIED - * WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF - * MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO - * EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, - * SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, - * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; - * OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, - * WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR - * OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF - * ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. - *) - -program getrevnum; -{$APPTYPE CONSOLE} -{$J+} -var s: shortstring = ''; - i: integer = 0; -begin -write('const cRevision ='''); -while not (eof or (i > 0)) do - begin - readln(s); - i:= Pos('revision="', s) - end; -if eof then write('rUNKNOWN') - else begin - Delete(s, 1, i + 9); - write('r',copy(s, 1, Pred(Pos('"', s)))) - end; -writeln(''';') -end. +(* + * Hedgewars, a worms-like game + * Copyright (c) 2004, 2005 Andrey Korotaev + * + * 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 ffe4ad26a64c -r bcbd7adb4e4b hedgewars/hw.dpr --- a/hedgewars/hw.dpr Mon Aug 22 21:38:06 2005 +0000 +++ b/hedgewars/hw.dpr Tue Aug 23 16:17:53 2005 +0000 @@ -1,225 +1,225 @@ -(* - * Hedgewars, a worms-like game - * Copyright (c) 2004, 2005 Andrey Korotaev - * - * Distributed under the terms of the BSD-modified licence: - * - * Permission is hereby granted, free of charge, to any person obtaining a copy - * of this software and associated documentation files (the "Software"), to deal - * with the Software without restriction, including without limitation the - * rights to use, copy, modify, merge, publish, distribute, sublicense, and/or - * sell copies of the Software, and to permit persons to whom the Software is - * furnished to do so, subject to the following conditions: - * - * 1. Redistributions of source code must retain the above copyright notice, - * this list of conditions and the following disclaimer. - * 2. Redistributions in binary form must reproduce the above copyright notice, - * this list of conditions and the following disclaimer in the documentation - * and/or other materials provided with the distribution. - * 3. The name of the author may not be used to endorse or promote products - * derived from this software without specific prior written permission. - * - * THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR IMPLIED - * WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF - * MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO - * EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, - * SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, - * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; - * OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, - * WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR - * OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF - * ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. - *) - -program hedgewars; -{$APPTYPE CONSOLE} -uses - SDLh, - uConsts in 'uConsts.pas', - uGame in 'uGame.pas', - uMisc in 'uMisc.pas', - uStore in 'uStore.pas', - uWorld in 'uWorld.pas', - uIO in 'uIO.pas', - uGears in 'uGears.pas', - uConsole in 'uConsole.pas', - uKeys in 'uKeys.pas', - uTeams in 'uTeams.pas', - uSound in 'uSound.pas', - uRandom in 'uRandom.pas', - uAI in 'uAI.pas', - uAIActions in 'uAIActions.pas', - uAIMisc in 'uAIMisc.pas', - uAIAmmoTests in 'uAIAmmoTests.pas', - uCollisions in 'uCollisions.pas', - uLand in 'uLand.pas'; - -{$INCLUDE options.inc} - -// also: GSHandlers.inc -// CCHandlers.inc -// HHHandlers.inc - - -procedure OnDestroy; forward; - -//////////////////////////////// -procedure DoTimer(Lag: integer); // - обработка таймера -const cCons: boolean = false; -var s: string; -begin -case GameState of - gsLandGen: begin - if (GameFlags and gfForts) = 0 then GenLandSurface - else MakeFortsMap; - GameState:= gsStart; - end; - gsStart: begin - AssignHHCoords; - AdjustColor(cColorNearBlack); - AdjustColor(cWhiteColor); - StoreLoad; - AdjustColor(cConsoleSplitterColor); - ResetKbd; - SoundLoad; - PlayMusic; - GameState:= gsGame - end; - gsGame : begin - ProcessKbd; - DoGameTick(Lag); - DrawWorld(Lag, SDLPrimSurface); - end; - gsConsole: begin - DoGameTick(Lag); - DrawWorld(Lag, SDLPrimSurface); - DrawConsole(SDLPrimSurface); - end; - gsExit : begin - OnDestroy; - end; - end; -SDL_Flip(SDLPrimSurface); -if flagMakeCapture then - begin - flagMakeCapture:= false; - s:= 'hw_' + ParamStr(5) + '_' + inttostr(GameTicks) + '.bmp'; - WriteLnToConsole('Saving ' + s); - SDL_SaveBMP_RW(SDLPrimSurface, SDL_RWFromFile(PChar(s), 'wb'), 1) - end; -end; - -//////////////////// -procedure OnDestroy; // - очищаем память -begin -{$IFDEF DEBUGFILE}AddFileLog('Freeing resources...');{$ENDIF} -if isSoundEnabled then ReleaseSound; -StoreRelease; -CloseIPC; -TTF_Quit; -SDL_Quit; -halt -end; - -/////////////////// -procedure MainLoop; -var PrevTime, - CurrTime: Cardinal; - event: TSDL_Event; -begin -PrevTime:= SDL_GetTicks; -repeat -while SDL_PollEvent(@event) <> 0 do - case event.type_ of - SDL_KEYDOWN: case GameState of - gsGame: if event.key.keysym.sym = 96 then - begin - cConsoleYAdd:= cConsoleHeight; - GameState:= gsConsole - end; - gsConsole: KeyPressConsole(event.key.keysym.sym); - end; - SDL_QUITEV: isTerminated:= true - end; -CurrTime:= SDL_GetTicks; -if PrevTime + cTimerInterval <= CurrTime then - begin - DoTimer(CurrTime - PrevTime); - PrevTime:= CurrTime - end else {sleep(1)}; -IPCCheckSock -until isTerminated -end; - -//////////////////// -procedure GetParams; -var c: integer; -{$IFDEF DEBUGFILE} - i: integer; -begin -for i:= 0 to ParamCount do - AddFileLog(inttostr(i) + ': ' + ParamStr(i)); -{$ELSE} -begin -{$ENDIF} -if ParamCount=6 then - begin - //TODO: сделать передачу через IPC - val(ParamStr(1), cScreenWidth, c); - val(ParamStr(2), cScreenHeight, c); - Pathz[ptThemeCurrent]:= Pathz[ptThemes] + ParamStr(3)+'/'; - val(ParamStr(4), ipcPort, c); - SetRandomParams(ParamStr(5), rndfillstr); - cFullScreen:= ParamStr(6)[1] = '1' - end else OutError(errmsgShouldntRun, true); -end; - -procedure ShowMainWindow; -var flags: Longword; -begin -flags:= SDL_HWSURFACE or SDL_DOUBLEBUF or SDL_HWACCEL; -if cFullScreen then flags:= flags or SDL_FULLSCREEN - else SDL_WM_SetCaption('Hedgewars', nil); -SDLPrimSurface:= SDL_SetVideoMode(cScreenWidth, cScreenHeight, cBits, flags); -TryDo(SDLPrimSurface <> nil, errmsgCreateSurface, true); -PixelFormat:= SDLPrimSurface.format; -SDL_ShowCursor(0); -end; -//////////////////////////////////////////////////////////////////////////////// -/////////////////////////////// m a i n //////////////////////////////////////// -//////////////////////////////////////////////////////////////////////////////// -{$INCLUDE revision.inc} - -begin -WriteLnToConsole('HedgeWars 0.1, svn '+cRevision); -WriteLnToConsole(' -= by unC0Rr =- '); -GetParams; -Randomize; -InitGears; - -WriteToConsole('Init SDL... '); -SDLTry(SDL_Init(SDL_INIT_VIDEO) >= 0, true); -WriteLnToConsole(msgOK); - -WriteToConsole('Init SDL_ttf... '); -SDLTry(TTF_Init >= 0, true); -WriteLnToConsole(msgOK); - -ShowMainWindow; - -InitKbdKeyTable; -InitIPC; -WriteLnToConsole(msgGettingConfig); -SendIPCAndWaitReply('C'); // запрос конфига игры -InitTeams; - -if isSoundEnabled then InitSound; -InitWorld; - -StoreInit; - -isDeveloperMode:= false; - -MainLoop - -end. +(* + * Hedgewars, a worms-like game + * Copyright (c) 2004, 2005 Andrey Korotaev + * + * Distributed under the terms of the BSD-modified licence: + * + * Permission is hereby granted, free of charge, to any person obtaining a copy + * of this software and associated documentation files (the "Software"), to deal + * with the Software without restriction, including without limitation the + * rights to use, copy, modify, merge, publish, distribute, sublicense, and/or + * sell copies of the Software, and to permit persons to whom the Software is + * furnished to do so, subject to the following conditions: + * + * 1. Redistributions of source code must retain the above copyright notice, + * this list of conditions and the following disclaimer. + * 2. Redistributions in binary form must reproduce the above copyright notice, + * this list of conditions and the following disclaimer in the documentation + * and/or other materials provided with the distribution. + * 3. The name of the author may not be used to endorse or promote products + * derived from this software without specific prior written permission. + * + * THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR IMPLIED + * WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF + * MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO + * EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, + * SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, + * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; + * OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, + * WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR + * OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF + * ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + *) + +program hedgewars; +{$APPTYPE CONSOLE} +uses + SDLh, + uConsts in 'uConsts.pas', + uGame in 'uGame.pas', + uMisc in 'uMisc.pas', + uStore in 'uStore.pas', + uWorld in 'uWorld.pas', + uIO in 'uIO.pas', + uGears in 'uGears.pas', + uConsole in 'uConsole.pas', + uKeys in 'uKeys.pas', + uTeams in 'uTeams.pas', + uSound in 'uSound.pas', + uRandom in 'uRandom.pas', + uAI in 'uAI.pas', + uAIActions in 'uAIActions.pas', + uAIMisc in 'uAIMisc.pas', + uAIAmmoTests in 'uAIAmmoTests.pas', + uCollisions in 'uCollisions.pas', + uLand in 'uLand.pas'; + +{$INCLUDE options.inc} + +// also: GSHandlers.inc +// CCHandlers.inc +// HHHandlers.inc + + +procedure OnDestroy; forward; + +//////////////////////////////// +procedure DoTimer(Lag: integer); // - обработка таймера +const cCons: boolean = false; +var s: string; +begin +case GameState of + gsLandGen: begin + if (GameFlags and gfForts) = 0 then GenLandSurface + else MakeFortsMap; + GameState:= gsStart; + end; + gsStart: begin + AssignHHCoords; + AdjustColor(cColorNearBlack); + AdjustColor(cWhiteColor); + StoreLoad; + AdjustColor(cConsoleSplitterColor); + ResetKbd; + SoundLoad; + PlayMusic; + GameState:= gsGame + end; + gsGame : begin + ProcessKbd; + DoGameTick(Lag); + DrawWorld(Lag, SDLPrimSurface); + end; + gsConsole: begin + DoGameTick(Lag); + DrawWorld(Lag, SDLPrimSurface); + DrawConsole(SDLPrimSurface); + end; + gsExit : begin + OnDestroy; + end; + end; +SDL_Flip(SDLPrimSurface); +if flagMakeCapture then + begin + flagMakeCapture:= false; + s:= 'hw_' + ParamStr(5) + '_' + inttostr(GameTicks) + '.bmp'; + WriteLnToConsole('Saving ' + s); + SDL_SaveBMP_RW(SDLPrimSurface, SDL_RWFromFile(PChar(s), 'wb'), 1) + end; +end; + +//////////////////// +procedure OnDestroy; // - очищаем память +begin +{$IFDEF DEBUGFILE}AddFileLog('Freeing resources...');{$ENDIF} +if isSoundEnabled then ReleaseSound; +StoreRelease; +CloseIPC; +TTF_Quit; +SDL_Quit; +halt +end; + +/////////////////// +procedure MainLoop; +var PrevTime, + CurrTime: Cardinal; + event: TSDL_Event; +begin +PrevTime:= SDL_GetTicks; +repeat +while SDL_PollEvent(@event) <> 0 do + case event.type_ of + SDL_KEYDOWN: case GameState of + gsGame: if event.key.keysym.sym = 96 then + begin + cConsoleYAdd:= cConsoleHeight; + GameState:= gsConsole + end; + gsConsole: KeyPressConsole(event.key.keysym.sym); + end; + SDL_QUITEV: isTerminated:= true + end; +CurrTime:= SDL_GetTicks; +if PrevTime + cTimerInterval <= CurrTime then + begin + DoTimer(CurrTime - PrevTime); + PrevTime:= CurrTime + end else {sleep(1)}; +IPCCheckSock +until isTerminated +end; + +//////////////////// +procedure GetParams; +var c: integer; +{$IFDEF DEBUGFILE} + i: integer; +begin +for i:= 0 to ParamCount do + AddFileLog(inttostr(i) + ': ' + ParamStr(i)); +{$ELSE} +begin +{$ENDIF} +if ParamCount=6 then + begin + //TODO: сделать передачу через IPC + val(ParamStr(1), cScreenWidth, c); + val(ParamStr(2), cScreenHeight, c); + Pathz[ptThemeCurrent]:= Pathz[ptThemes] + ParamStr(3)+'/'; + val(ParamStr(4), ipcPort, c); + SetRandomParams(ParamStr(5), rndfillstr); + cFullScreen:= ParamStr(6)[1] = '1' + end else OutError(errmsgShouldntRun, true); +end; + +procedure ShowMainWindow; +var flags: Longword; +begin +flags:= SDL_HWSURFACE or SDL_DOUBLEBUF or SDL_HWACCEL; +if cFullScreen then flags:= flags or SDL_FULLSCREEN + else SDL_WM_SetCaption('Hedgewars', nil); +SDLPrimSurface:= SDL_SetVideoMode(cScreenWidth, cScreenHeight, cBits, flags); +TryDo(SDLPrimSurface <> nil, errmsgCreateSurface, true); +PixelFormat:= SDLPrimSurface.format; +SDL_ShowCursor(0); +end; +//////////////////////////////////////////////////////////////////////////////// +/////////////////////////////// m a i n //////////////////////////////////////// +//////////////////////////////////////////////////////////////////////////////// +{$INCLUDE revision.inc} + +begin +WriteLnToConsole('HedgeWars 0.1, svn '+cRevision); +WriteLnToConsole(' -= by unC0Rr =- '); +GetParams; +Randomize; +InitGears; + +WriteToConsole('Init SDL... '); +SDLTry(SDL_Init(SDL_INIT_VIDEO) >= 0, true); +WriteLnToConsole(msgOK); + +WriteToConsole('Init SDL_ttf... '); +SDLTry(TTF_Init >= 0, true); +WriteLnToConsole(msgOK); + +ShowMainWindow; + +InitKbdKeyTable; +InitIPC; +WriteLnToConsole(msgGettingConfig); +SendIPCAndWaitReply('C'); // запрос конфига игры +InitTeams; + +if isSoundEnabled then InitSound; +InitWorld; + +StoreInit; + +isDeveloperMode:= false; + +MainLoop + +end. diff -r ffe4ad26a64c -r bcbd7adb4e4b hedgewars/hwserv.dpr --- a/hedgewars/hwserv.dpr Mon Aug 22 21:38:06 2005 +0000 +++ b/hedgewars/hwserv.dpr Tue Aug 23 16:17:53 2005 +0000 @@ -1,90 +1,90 @@ -(* - * Hedgewars, a worms-like game - * Copyright (c) 2004, 2005 Andrey Korotaev - * - * Distributed under the terms of the BSD-modified licence: - * - * Permission is hereby granted, free of charge, to any person obtaining a copy - * of this software and associated documentation files (the "Software"), to deal - * with the Software without restriction, including without limitation the - * rights to use, copy, modify, merge, publish, distribute, sublicense, and/or - * sell copies of the Software, and to permit persons to whom the Software is - * furnished to do so, subject to the following conditions: - * - * 1. Redistributions of source code must retain the above copyright notice, - * this list of conditions and the following disclaimer. - * 2. Redistributions in binary form must reproduce the above copyright notice, - * this list of conditions and the following disclaimer in the documentation - * and/or other materials provided with the distribution. - * 3. The name of the author may not be used to endorse or promote products - * derived from this software without specific prior written permission. - * - * THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR IMPLIED - * WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF - * MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO - * EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, - * SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, - * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; - * OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, - * WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR - * OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF - * ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. - *) - -program hwserv; -{$APPTYPE CONSOLE} -uses - Windows, - WinSock, - Messages, - uServerMisc in 'uServerMisc.pas', - uNet, - uPlayers in 'uPlayers.pas'; - -function MainWndProc(hwnd: HWND; Message: UINT; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall; -begin -case Message of - WM_CLOSE : begin - PostQuitMessage(0); - end; - WM_ASYNC_NETEVENT: NetSockEvent(wParam, lParam); - end; -Result:= DefWindowProc(hwnd, Message, wParam,lParam) -end; - -procedure DoCreateWindow; -var wc: WNDCLASS; -begin -FillChar(wc, sizeof(wc), 0); -wc.style := CS_VREDRAW or CS_HREDRAW; -wc.lpfnWndProc := @MainWndProc; -wc.hInstance := hInstance; -wc.lpszClassName := cAppName; -TryDo(RegisterClass(wc) <> 0, 'Cannot register window class'); -hwndMain := CreateWindowEx( 0, cAppName, cAppTitle, WS_POPUP, - 0, 0, - GetSystemMetrics(SM_CXSCREEN), GetSystemMetrics(SM_CYSCREEN), - 0, 0, hInstance, nil); -TryDo(hwndMain <> 0, 'Cannot create window') -end; - -procedure ProcessMessages; -var Message: Windows.MSG; -begin -if PeekMessage(Message,0,0,0,PM_REMOVE) then - if Message.message <> WM_QUIT then - begin - TranslateMessage(Message); - DispatchMessage(Message) - end else isTerminated:= true -end; - -begin -WriteLn('-= Hedgewars server =-'); -WriteLn('protocol version ', cProtVer); -DoCreateWindow; -InitServer; -repeat -ProcessMessages; -until isTerminated -end. +(* + * Hedgewars, a worms-like game + * Copyright (c) 2004, 2005 Andrey Korotaev + * + * 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 ffe4ad26a64c -r bcbd7adb4e4b hedgewars/options.inc --- a/hedgewars/options.inc Mon Aug 22 21:38:06 2005 +0000 +++ b/hedgewars/options.inc Tue Aug 23 16:17:53 2005 +0000 @@ -1,38 +1,38 @@ -(* - * Hedgewars, a worms-like game - * Copyright (c) 2004, 2005 Andrey Korotaev - * - * Distributed under the terms of the BSD-modified licence: - * - * Permission is hereby granted, free of charge, to any person obtaining a copy - * of this software and associated documentation files (the "Software"), to deal - * with the Software without restriction, including without limitation the - * rights to use, copy, modify, merge, publish, distribute, sublicense, and/or - * sell copies of the Software, and to permit persons to whom the Software is - * furnished to do so, subject to the following conditions: - * - * 1. Redistributions of source code must retain the above copyright notice, - * this list of conditions and the following disclaimer. - * 2. Redistributions in binary form must reproduce the above copyright notice, - * this list of conditions and the following disclaimer in the documentation - * and/or other materials provided with the distribution. - * 3. The name of the author may not be used to endorse or promote products - * derived from this software without specific prior written permission. - * - * THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR IMPLIED - * WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF - * MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO - * EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, - * SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, - * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; - * OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, - * WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR - * OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF - * ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. - *) - -{$J+} -{$DEFINE DEBUGFILE} -{ $DEFINE COUNTTICKS} -{ $DEFINE DUMP} - +(* + * Hedgewars, a worms-like game + * Copyright (c) 2004, 2005 Andrey Korotaev + * + * 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 ffe4ad26a64c -r bcbd7adb4e4b hedgewars/runhelper.dpr --- a/hedgewars/runhelper.dpr Mon Aug 22 21:38:06 2005 +0000 +++ b/hedgewars/runhelper.dpr Tue Aug 23 16:17:53 2005 +0000 @@ -1,155 +1,160 @@ -(* - * Hedgewars, a worms-like game - * Copyright (c) 2004, 2005 Andrey Korotaev - * - * Distributed under the terms of the BSD-modified licence: - * - * Permission is hereby granted, free of charge, to any person obtaining a copy - * of this software and associated documentation files (the "Software"), to deal - * with the Software without restriction, including without limitation the - * rights to use, copy, modify, merge, publish, distribute, sublicense, and/or - * sell copies of the Software, and to permit persons to whom the Software is - * furnished to do so, subject to the following conditions: - * - * 1. Redistributions of source code must retain the above copyright notice, - * this list of conditions and the following disclaimer. - * 2. Redistributions in binary form must reproduce the above copyright notice, - * this list of conditions and the following disclaimer in the documentation - * and/or other materials provided with the distribution. - * 3. The name of the author may not be used to endorse or promote products - * derived from this software without specific prior written permission. - * - * THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR IMPLIED - * WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF - * MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO - * EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, - * SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, - * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; - * OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, - * WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR - * OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF - * ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. - *) - -program runhelper; -{$APPTYPE CONSOLE} -{$J+} -uses SDLh; -var servsock, clsock: PTCPSocket; - ip: TIPAddress; - event: TSDL_Event; - -procedure Send(s: shortstring); -begin -SDLNet_TCP_Send(clsock, @s, succ(byte(s[0]))) -end; - -procedure SendConfig; -begin -Send('TL'); -Send('eaddteam'); -Send('ename team "C0CuCKAzZz"'); -Send('ename hh0 "Йожык"'); -Send('ename hh1 "Ёжик"'); -Send('ename hh2 "Ёжык"'); -Send('ename hh3 "Йожик"'); -Send('ename hh4 "Ёжик без ножек"'); -Send('ename hh5 "Just hedgehog"'); -Send('ename hh6 "Ёжик без головы"'); -Send('ename hh7 "Валасатый йож"'); -Send('ebind left "+left"'); -Send('ebind right "+right"'); -Send('ebind up "+up"'); -Send('ebind down "+down"'); -Send('ebind F1 "slot 1"'); -Send('ebind F2 "slot 2"'); -Send('ebind F3 "slot 3"'); -Send('ebind F4 "slot 4"'); -Send('ebind F5 "slot 5"'); -Send('ebind F6 "slot 6"'); -Send('ebind F7 "slot 7"'); -Send('ebind F8 "slot 8"'); -Send('ebind F10 "quit"'); -Send('ebind F11 "capture"'); -Send('ebind space "+attack"'); -Send('ebind return "ljump"'); -Send('ebind backspace "hjump"'); -Send('ebind tab "switch"'); -Send('ebind 1 "timer 1"'); -Send('ebind 2 "timer 2"'); -Send('ebind 3 "timer 3"'); -Send('ebind 4 "timer 4"'); -Send('ebind 5 "timer 5"'); -Send('ebind mousel "put"'); -Send('egrave "coffin"'); -Send('ecolor 65535'); -Send('eadd hh0 0'); -Send('eadd hh1 0'); -Send('eadd hh2 0'); -Send('eadd hh3 0'); -Send('eaddteam'); -Send('ename team "-= ЕЖЫ =-"'); -Send('ename hh0 "Маленький"'); -Send('ename hh1 "Удаленький"'); -Send('ename hh2 "Игольчатый"'); -Send('ename hh3 "Стреляный"'); -Send('ename hh4 "Ежиха"'); -Send('ename hh5 "Ежонок"'); -Send('ename hh6 "Инфернальный"'); -Send('ename hh7 "X"'); -Send('egrave Bone'); -Send('ecolor 16776960'); -Send('eadd hh0 1'); -Send('eadd hh1 1'); -Send('eadd hh2 1'); -Send('eadd hh3 1'); -end; - -procedure ParseCmd(s: shortstring); -begin -case s[1] of - '?': Send('!'); - 'C': SendConfig; - end; -end; - -procedure DoIt; -const ss: string = ''; -var s: shortstring; - i: integer; -begin -i:= SDLNet_TCP_Recv(clsock, @s[1], 255); -if i = -2 then - begin - SDLNet_TCP_Close(clsock); - clsock:= nil; - ss:= ''; - exit - end; -byte(s[0]):= i; -ss:= ss + s; -while (Length(ss) > 1)and(Length(ss) > byte(ss[1])) do - begin - s:= copy(ss, 2, byte(ss[1])); - Delete(ss, 1, Succ(byte(ss[1]))); - ParseCmd(s) - end; -end; - -begin -WriteLn('run hw 640 480 avematan 46631 (CVSKGIHSVHX) 1'); -SDL_Init(0); -SDLNet_Init; -ip.host:= 0; -ip.port:= $27B6; -servsock:= SDLNet_TCP_Open(ip); -repeat - if clsock = nil then - clsock:= SDLNet_TCP_Accept(servsock); - if clsock <> nil then - DoIt; - SDL_PollEvent(@event); -until event.type_ = SDL_QUITEV; -SDLNet_Quit; -SDL_Quit -end. +(* + * Hedgewars, a worms-like game + * Copyright (c) 2004, 2005 Andrey Korotaev + * + * Distributed under the terms of the BSD-modified licence: + * + * Permission is hereby granted, free of charge, to any person obtaining a copy + * of this software and associated documentation files (the "Software"), to deal + * with the Software without restriction, including without limitation the + * rights to use, copy, modify, merge, publish, distribute, sublicense, and/or + * sell copies of the Software, and to permit persons to whom the Software is + * furnished to do so, subject to the following conditions: + * + * 1. Redistributions of source code must retain the above copyright notice, + * this list of conditions and the following disclaimer. + * 2. Redistributions in binary form must reproduce the above copyright notice, + * this list of conditions and the following disclaimer in the documentation + * and/or other materials provided with the distribution. + * 3. The name of the author may not be used to endorse or promote products + * derived from this software without specific prior written permission. + * + * THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR IMPLIED + * WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF + * MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO + * EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, + * SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, + * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; + * OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, + * WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR + * OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF + * ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + *) + +program runhelper; +{$APPTYPE CONSOLE} +{$J+} +uses SDLh; +var servsock, clsock: PTCPSocket; + ip: TIPAddress; + event: TSDL_Event; + +procedure Send(s: shortstring); +begin +SDLNet_TCP_Send(clsock, @s, succ(byte(s[0]))) +end; + +procedure SendConfig; +begin +Send('TL'); +Send('e$gmflags 1'); +Send('eaddteam'); +Send('ename team "C0CuCKAzZz"'); +Send('ename hh0 "Йожык"'); +Send('ename hh1 "Ёжик"'); +Send('ename hh2 "Ёжык"'); +Send('ename hh3 "Йожик"'); +Send('ename hh4 "Ёжик без ножек"'); +Send('ename hh5 "Just hedgehog"'); +Send('ename hh6 "Ёжик без головы"'); +Send('ename hh7 "Валасатый йож"'); +Send('ebind left "+left"'); +Send('ebind right "+right"'); +Send('ebind up "+up"'); +Send('ebind down "+down"'); +Send('ebind F1 "slot 1"'); +Send('ebind F2 "slot 2"'); +Send('ebind F3 "slot 3"'); +Send('ebind F4 "slot 4"'); +Send('ebind F5 "slot 5"'); +Send('ebind F6 "slot 6"'); +Send('ebind F7 "slot 7"'); +Send('ebind F8 "slot 8"'); +Send('ebind F10 "quit"'); +Send('ebind F11 "capture"'); +Send('ebind space "+attack"'); +Send('ebind return "ljump"'); +Send('ebind backspace "hjump"'); +Send('ebind tab "switch"'); +Send('ebind 1 "timer 1"'); +Send('ebind 2 "timer 2"'); +Send('ebind 3 "timer 3"'); +Send('ebind 4 "timer 4"'); +Send('ebind 5 "timer 5"'); +Send('ebind mousel "put"'); +Send('egrave "coffin"'); +Send('efort "Barrelhouse"'); +Send('ecolor 65535'); +Send('eadd hh0 0'); +Send('eadd hh1 0'); +Send('eadd hh2 0'); +Send('eadd hh3 0'); +Send('eaddteam'); +Send('ename team "-= ЕЖЫ =-"'); +Send('ename hh0 "Маленький"'); +Send('ename hh1 "Удаленький"'); +Send('ename hh2 "Игольчатый"'); +Send('ename hh3 "Стреляный"'); +Send('ename hh4 "Ежиха"'); +Send('ename hh5 "Ежонок"'); +Send('ename hh6 "Инфернальный"'); +Send('ename hh7 "X"'); +Send('egrave Bone'); +Send('ecolor 16776960'); +Send('eadd hh0 1'); +Send('eadd hh1 1'); +Send('eadd hh2 1'); +Send('eadd hh3 1'); +Send('efort Barrelhouse'); +end; + +procedure ParseCmd(s: shortstring); +begin +case s[1] of + '?': Send('!'); + 'C': SendConfig; + end; +end; + +procedure DoIt; +const ss: string = ''; +var s: shortstring; + i: integer; +begin +i:= SDLNet_TCP_Recv(clsock, @s[1], 255); +if i <= 0 then + begin + if i = -1 then exit; + SDLNet_TCP_Close(clsock); + clsock:= nil; + ss:= ''; + exit + end; +byte(s[0]):= i; +ss:= ss + s; +while (Length(ss) > 1)and(Length(ss) > byte(ss[1])) do + begin + s:= copy(ss, 2, byte(ss[1])); + Delete(ss, 1, Succ(byte(ss[1]))); + ParseCmd(s) + end; +end; + +begin +WriteLn('run hw 640 480 avematan 46631 (CVSKGIHSVHX) 1'); +SDL_Init(0); +SDLNet_Init; +ip.host:= 0; +ip.port:= $27B6; +servsock:= SDLNet_TCP_Open(ip); +repeat + if clsock = nil then + clsock:= SDLNet_TCP_Accept(servsock); + if clsock <> nil then + DoIt; + SDL_PollEvent(@event); + SDL_Delay(1) +until event.type_ = SDL_QUITEV; +SDLNet_Quit; +SDL_Quit +end. diff -r ffe4ad26a64c -r bcbd7adb4e4b hedgewars/uAI.pas --- a/hedgewars/uAI.pas Mon Aug 22 21:38:06 2005 +0000 +++ b/hedgewars/uAI.pas Tue Aug 23 16:17:53 2005 +0000 @@ -1,167 +1,167 @@ -(* - * Hedgewars, a worms-like game - * Copyright (c) 2005 Andrey Korotaev - * - * Distributed under the terms of the BSD-modified licence: - * - * Permission is hereby granted, free of charge, to any person obtaining a copy - * of this software and associated documentation files (the "Software"), to deal - * with the Software without restriction, including without limitation the - * rights to use, copy, modify, merge, publish, distribute, sublicense, and/or - * sell copies of the Software, and to permit persons to whom the Software is - * furnished to do so, subject to the following conditions: - * - * 1. Redistributions of source code must retain the above copyright notice, - * this list of conditions and the following disclaimer. - * 2. Redistributions in binary form must reproduce the above copyright notice, - * this list of conditions and the following disclaimer in the documentation - * and/or other materials provided with the distribution. - * 3. The name of the author may not be used to endorse or promote products - * derived from this software without specific prior written permission. - * - * THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR IMPLIED - * WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF - * MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO - * EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, - * SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, - * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; - * OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, - * WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR - * OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF - * ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. - *) - -unit uAI; -interface -{$INCLUDE options.inc} -procedure ProcessBot; - -implementation -uses uAIActions, uAIMisc, uMisc, uTeams, uConsts, uAIAmmoTests, uGears, SDLh; - -function Go(Gear: PGear; Times: Longword): boolean; -begin -Result:= false -end; - -procedure Think; -var Targets: TTargets; - Angle, Power: integer; - Time: Longword; - - procedure FindTarget(Flags: Longword); - var t: integer; - a, aa: TAmmoType; - Me: TPoint; - begin - t:= 0; - with CurrentTeam.Hedgehogs[CurrentTeam.CurrHedgehog] do - begin - Me.X:= round(Gear.X); - Me.Y:= round(Gear.Y); - end; - repeat - if isInMultiShoot then with CurrentTeam.Hedgehogs[CurrentTeam.CurrHedgehog] do - a:= Ammo[CurSlot, CurAmmo].AmmoType - else a:= TAmmoType(random(ord(High(TAmmoType)))); - aa:= a; - repeat - if Assigned(AmmoTests[a].Test) - and ((Flags = 0) or ((Flags and AmmoTests[a].Flags) <> 0)) then - if AmmoTests[a].Test(Me, Targets.ar[t], Flags, Time, Angle, Power) then - begin - AddAction(aia_Weapon, ord(a), 1000); - if Time <> 0 then AddAction(aia_Timer, Time div 1000, 400); - exit - end; - if a = High(TAmmoType) then a:= Low(TAmmoType) - else inc(a) - until isInMultiShoot or (a = aa); - inc(t) - until (t >= Targets.Count) - end; - - procedure TryGo(lvl, Flags: Longword); - var tmpGear: TGear; - i, t: integer; - begin - with CurrentTeam.Hedgehogs[CurrentTeam.CurrHedgehog] do - for t:= aia_Left to aia_Right do - if IsActionListEmpty then - begin - tmpGear:= Gear^; - i:= 0; - Gear.Message:= t; - while HHGo(Gear) do - begin - if (i mod 5 = 0) then - begin - FindTarget(Flags); - if not IsActionListEmpty then - begin - if i > 0 then - begin - AddAction(t, aim_push, 1000); - AddAction(aia_WaitX, round(Gear.X), 0); - AddAction(t, aim_release, 0) - end; - Gear^:= tmpGear; - exit - end - end; - inc(i) - end; - Gear^:= tmpGear - end - end; - -begin -with CurrentTeam.Hedgehogs[CurrentTeam.CurrHedgehog] do - if ((Gear.State and (gstAttacked or gstAttacking or gstMoving or gstFalling)) <> 0) then exit; - -FillTargets(Targets); - -TryGo(0, 0); - -if IsActionListEmpty then - TryGo(0, ctfNotFull); -if IsActionListEmpty then - TryGo(0, ctfBreach); - -if IsActionListEmpty then - begin - AddAction(aia_Weapon, ord(amSkip), 1000); - AddAction(aia_Attack, aim_push, 1000); - exit - end; - -with CurrentTeam.Hedgehogs[CurrentTeam.CurrHedgehog] do - begin - if (Angle > 0) then AddAction(aia_LookRight, 0, 200) - else if (Angle < 0) then AddAction(aia_LookLeft, 0, 200); - Angle:= integer(Gear.Angle) - Abs(Angle); - if Angle > 0 then - begin - AddAction(aia_Up, aim_push, 500); - AddAction(aia_Up, aim_release, Angle) - end else if Angle < 0 then - begin - AddAction(aia_Down, aim_push, 500); - AddAction(aia_Down, aim_release, -Angle) - end; - AddAction(aia_attack, aim_push, 300); - AddAction(aia_attack, aim_release, Power); - end -end; - -procedure ProcessBot; -begin -with CurrentTeam.Hedgehogs[CurrentTeam.CurrHedgehog] do - if (Gear <> nil)and((Gear.State and gstHHDriven) <> 0) then - begin - if IsActionListEmpty then Think; - ProcessAction - end -end; - -end. +(* + * Hedgewars, a worms-like game + * Copyright (c) 2005 Andrey Korotaev + * + * 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 ffe4ad26a64c -r bcbd7adb4e4b hedgewars/uAIActions.pas --- a/hedgewars/uAIActions.pas Mon Aug 22 21:38:06 2005 +0000 +++ b/hedgewars/uAIActions.pas Tue Aug 23 16:17:53 2005 +0000 @@ -1,187 +1,187 @@ -(* - * Hedgewars, a worms-like game - * Copyright (c) 2005 Andrey Korotaev - * - * Distributed under the terms of the BSD-modified licence: - * - * Permission is hereby granted, free of charge, to any person obtaining a copy - * of this software and associated documentation files (the "Software"), to deal - * with the Software without restriction, including without limitation the - * rights to use, copy, modify, merge, publish, distribute, sublicense, and/or - * sell copies of the Software, and to permit persons to whom the Software is - * furnished to do so, subject to the following conditions: - * - * 1. Redistributions of source code must retain the above copyright notice, - * this list of conditions and the following disclaimer. - * 2. Redistributions in binary form must reproduce the above copyright notice, - * this list of conditions and the following disclaimer in the documentation - * and/or other materials provided with the distribution. - * 3. The name of the author may not be used to endorse or promote products - * derived from this software without specific prior written permission. - * - * THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR IMPLIED - * WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF - * MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO - * EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, - * SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, - * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; - * OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, - * WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR - * OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF - * ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. - *) - -unit uAIActions; -interface -{$INCLUDE options.inc} -const aia_none = 0; - aia_Left = 1; - aia_Right = 2; - aia_Timer = 3; - aia_Slot = 4; - aia_attack = 5; - aia_Up = 6; - aia_Down = 7; - - aia_Weapon = $80000000; - aia_WaitX = $80000001; - aia_WaitY = $80000002; - aia_LookLeft = $80000003; - aia_LookRight = $80000004; - - aim_push = $80000000; - aim_release = $80000001; - ai_specmask = $80000000; - -type PAction = ^TAction; - TAction = record - Action, Param: Longword; - Time: Longword; - Next: PAction; - end; - -function AddAction(Action, Param, TimeDelta: Longword): PAction; -procedure FreeActionsList; -function IsActionListEmpty: boolean; -procedure ProcessAction; - -implementation -uses uMisc, uConsts, uConsole, uTeams; - -const ActionIdToStr: array[0..7] of string[16] = ( -{aia_none} '', -{aia_Left} 'left', -{aia_Right} 'right', -{aia_Timer} 'timer', -{aia_slot} 'slot', -{aia_attack} 'attack', -{aia_Up} 'up', -{aia_Down} 'down' - ); - - -var ActionList, - FinAction: PAction; - -function AddAction(Action, Param, TimeDelta: Longword): PAction; -begin -New(Result); -TryDo(Result <> nil, errmsgDynamicVar, true); -FillChar(Result^, sizeof(TAction), 0); -Result.Action:= Action; -Result.Param:= Param; -if ActionList = nil then - begin - Result.Time:= GameTicks + TimeDelta; - ActionList:= Result; - FinAction := Result - end else - begin - Result.Time:= TimeDelta; - FinAction.Next:= Result; - FinAction:= Result - end -end; - -procedure DeleteCurrAction; -var t: PAction; -begin -t:= ActionList; -ActionList:= ActionList.Next; -if ActionList = nil then FinAction:= nil - else inc(ActionList.Time, t.Time); -Dispose(t) -end; - -function IsActionListEmpty: boolean; -begin -Result:= ActionList = nil -end; - -procedure FreeActionsList; -begin -while ActionList <> nil do DeleteCurrAction; -end; - -procedure SetWeapon(weap: Longword); -var t: integer; -begin -t:= 0; -with CurrentTeam^ do - with Hedgehogs[CurrHedgehog] do - while Ammo[CurSlot, CurAmmo].AmmoType <> TAmmotype(weap) do - begin - ParseCommand('/slot ' + chr(49 + Ammoz[TAmmoType(weap)].Slot)); - inc(t); - if t > 10 then OutError('AI: incorrect try to change weapon!', true) - end -end; - -procedure ProcessAction; -var s: shortstring; -begin -if ActionList = nil then exit; -with ActionList^ do - begin - if Time > GameTicks then exit; - if (Action and ai_specmask) <> 0 then - case Action of - aia_Weapon: SetWeapon(Param); - aia_WaitX: with CurrentTeam^ do - with Hedgehogs[CurrHedgehog] do - if round(Gear.X) = Param then Time:= GameTicks - else exit; - aia_WaitY: with CurrentTeam^ do - with Hedgehogs[CurrHedgehog] do - if round(Gear.Y) = Param then Time:= GameTicks - else exit; - aia_LookLeft: with CurrentTeam^ do - with Hedgehogs[CurrHedgehog] do - if Gear.dX >= 0 then - begin - ParseCommand('+left'); - exit - end else ParseCommand('-left'); - aia_LookRight: with CurrentTeam^ do - with Hedgehogs[CurrHedgehog] do - if Gear.dX < 0 then - begin - ParseCommand('+right'); - exit - end else ParseCommand('-right'); - end else - begin - s:= ActionIdToStr[Action]; - if (Param and ai_specmask) <> 0 then - case Param of - aim_push: s:= '+' + s; - aim_release: s:= '-' + s; - end - else if Param <> 0 then s:= s + ' ' + inttostr(Param); - ParseCommand(s) - end - end; -DeleteCurrAction -end; - -end. +(* + * Hedgewars, a worms-like game + * Copyright (c) 2005 Andrey Korotaev + * + * 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 ffe4ad26a64c -r bcbd7adb4e4b hedgewars/uAIAmmoTests.pas --- a/hedgewars/uAIAmmoTests.pas Mon Aug 22 21:38:06 2005 +0000 +++ b/hedgewars/uAIAmmoTests.pas Tue Aug 23 16:17:53 2005 +0000 @@ -1,196 +1,196 @@ -(* - * Hedgewars, a worms-like game - * Copyright (c) 2005 Andrey Korotaev - * - * Distributed under the terms of the BSD-modified licence: - * - * Permission is hereby granted, free of charge, to any person obtaining a copy - * of this software and associated documentation files (the "Software"), to deal - * with the Software without restriction, including without limitation the - * rights to use, copy, modify, merge, publish, distribute, sublicense, and/or - * sell copies of the Software, and to permit persons to whom the Software is - * furnished to do so, subject to the following conditions: - * - * 1. Redistributions of source code must retain the above copyright notice, - * this list of conditions and the following disclaimer. - * 2. Redistributions in binary form must reproduce the above copyright notice, - * this list of conditions and the following disclaimer in the documentation - * and/or other materials provided with the distribution. - * 3. The name of the author may not be used to endorse or promote products - * derived from this software without specific prior written permission. - * - * THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR IMPLIED - * WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF - * MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO - * EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, - * SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, - * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; - * OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, - * WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR - * OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF - * ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. - *) - -unit uAIAmmoTests; -interface -uses uConsts, SDLh; -{$INCLUDE options.inc} -const ctfNotFull = $00000001; - ctfBreach = $00000002; - -function TestGrenade(Me, Targ: TPoint; Flags: Longword; out Time: Longword; out Angle, Power: integer): boolean; -function TestBazooka(Me, Targ: TPoint; Flags: Longword; out Time: Longword; out Angle, Power: integer): boolean; -function TestShotgun(Me, Targ: TPoint; Flags: Longword; out Time: Longword; out Angle, Power: integer): boolean; - -type TAmmoTestProc = function (Me, Targ: TPoint; Flags: Longword; out Time: Longword; out Angle, Power: integer): boolean; -const AmmoTests: array[TAmmoType] of - record - Test: TAmmoTestProc; - Flags: Longword; - end = ( - ( Test: TestGrenade; - Flags: ctfNotFull; - ), - ( Test: TestBazooka; - Flags: ctfNotFull or ctfBreach; - ), - ( Test: nil; - Flags: 0; - ), - ( Test: TestShotgun; - Flags: ctfBreach; - ), - ( Test: nil; - Flags: 0; - ), - ( Test: nil; - Flags: 0; - ), - ( Test: nil; - Flags: 0; - ) - ); - -implementation -uses uMisc, uAIMisc; - -function TestGrenade(Me, Targ: TPoint; Flags: Longword; out Time: Longword; out Angle, Power: integer): boolean; -var Vx, Vy, r: real; - flHasTrace: boolean; - - function CheckTrace: boolean; - var x, y, dY: real; - t: integer; - begin - x:= Me.X; - y:= Me.Y; - dY:= -Vy; - Result:= false; - if (Flags and ctfNotFull) = 0 then t:= Time - else t:= Time - 100; - repeat - x:= x + Vx; - y:= y + dY; - dY:= dY + cGravity; - if TestColl(round(x), round(y), 5) then exit; - dec(t); - until t <= 0; - Result:= true - end; - -begin -Result:= false; -Time:= 0; -flHasTrace:= false; -repeat - inc(Time, 1000); - Vx:= (Targ.X - Me.X) / Time; - Vy:= cGravity*(Time div 2) - (Targ.Y - Me.Y) / Time; - r:= sqr(Vx) + sqr(Vy); - if r <= 1 then flHasTrace:= CheckTrace - else exit -until flHasTrace or (Time = 5000); -if not flHasTrace then exit; -r:= sqrt(r); -Angle:= DxDy2Angle(Vx, Vy); -Power:= round(r * cMaxPower); -Result:= true -end; - -function TestBazooka(Me, Targ: TPoint; Flags: Longword; out Time: Longword; out Angle, Power: integer): boolean; -var Vx, Vy, r: real; - rTime: real; - flHasTrace: boolean; - - function CheckTrace: boolean; - var x, y, dX, dY: real; - t: integer; - begin - x:= Me.X + Vx*20; - y:= Me.Y + Vy*20; - dX:= Vx; - dY:= -Vy; - Result:= false; - if (Flags and ctfNotFull) = 0 then t:= trunc(rTime) - else t:= trunc(rTime) - 100; - repeat - x:= x + dX; - y:= y + dY; - dX:= dX + cWindSpeed; - dY:= dY + cGravity; - if TestColl(round(x), round(y), 5) then - begin - if (Flags and ctfBreach) <> 0 then - Result:= NoMyHHNear(round(x), round(y), 110); - exit - end; - dec(t) - until t <= 0; - Result:= true - end; - -begin -Time:= 0; -Result:= false; -rTime:= 10; -flHasTrace:= false; -repeat - rTime:= rTime + 100 + random*300; - Vx:= - cWindSpeed * rTime / 2 + (Targ.X - Me.X) / rTime; - Vy:= cGravity * rTime / 2 - (Targ.Y - Me.Y) / rTime; - r:= sqr(Vx) + sqr(Vy); - if r <= 1 then flHasTrace:= CheckTrace -until flHasTrace or (rTime >= 5000); -if not flHasTrace then exit; -r:= sqrt(r); -Angle:= DxDy2Angle(Vx, Vy); -Power:= round(r * cMaxPower); -Result:= true -end; - -function TestShotgun(Me, Targ: TPoint; Flags: Longword; out Time: Longword; out Angle, Power: integer): boolean; -var Vx, Vy, x, y: real; -begin -Time:= 0; -Power:= 1; -Vx:= (Targ.X - Me.X)/1024; -Vy:= (Targ.Y - Me.Y)/1024; -x:= Me.X; -y:= Me.Y; -Angle:= DxDy2Angle(Vx, -Vy); -repeat - x:= x + vX; - y:= y + vY; - if TestColl(round(x), round(y), 2) then - begin - if (Flags and ctfBreach) <> 0 then - Result:= NoMyHHNear(round(x), round(y), 27) - else Result:= false; - exit - end -until (abs(Targ.X - x) + abs(Targ.Y - y) < 4) or (x < 0) or (y < 0) or (x > 2048) or (y > 1024); -Result:= true -end; - - -end. +(* + * Hedgewars, a worms-like game + * Copyright (c) 2005 Andrey Korotaev + * + * 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 ffe4ad26a64c -r bcbd7adb4e4b hedgewars/uAIMisc.pas --- a/hedgewars/uAIMisc.pas Mon Aug 22 21:38:06 2005 +0000 +++ b/hedgewars/uAIMisc.pas Tue Aug 23 16:17:53 2005 +0000 @@ -1,271 +1,271 @@ -(* - * Hedgewars, a worms-like game - * Copyright (c) 2005 Andrey Korotaev - * - * Distributed under the terms of the BSD-modified licence: - * - * Permission is hereby granted, free of charge, to any person obtaining a copy - * of this software and associated documentation files (the "Software"), to deal - * with the Software without restriction, including without limitation the - * rights to use, copy, modify, merge, publish, distribute, sublicense, and/or - * sell copies of the Software, and to permit persons to whom the Software is - * furnished to do so, subject to the following conditions: - * - * 1. Redistributions of source code must retain the above copyright notice, - * this list of conditions and the following disclaimer. - * 2. Redistributions in binary form must reproduce the above copyright notice, - * this list of conditions and the following disclaimer in the documentation - * and/or other materials provided with the distribution. - * 3. The name of the author may not be used to endorse or promote products - * derived from this software without specific prior written permission. - * - * THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR IMPLIED - * WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF - * MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO - * EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, - * SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, - * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; - * OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, - * WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR - * OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF - * ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. - *) - -unit uAIMisc; -interface -uses uConsts, uGears, SDLh; -{$INCLUDE options.inc} - -type TTargets = record - Count: integer; - ar: array[0..cMaxHHIndex*5] of TPoint; - end; - -procedure FillTargets(var Targets: TTargets); -function DxDy2Angle(const _dY, _dX: Extended): integer; -function TestColl(x, y, r: integer): boolean; -function NoMyHHNear(x, y, r: integer): boolean; -function HHGo(Gear: PGear): boolean; - -implementation -uses uTeams, uStore, uMisc, uLand, uCollisions; - -procedure FillTargets(var Targets: TTargets); -var t: PTeam; - i, k: integer; - r: integer; - MaxHealth: integer; - score: array[0..cMaxHHIndex*5] of integer; - - procedure qSort(iLo, iHi: Integer); - var - Lo, Hi, Mid, T: Integer; - P: TPoint; - begin - Lo := iLo; - Hi := iHi; - Mid := score[(Lo + Hi) div 2]; - repeat - while score[Lo] > Mid do Inc(Lo); - while score[Hi] < Mid do Dec(Hi); - if Lo <= Hi then - begin - T := score[Lo]; - score[Lo] := score[Hi]; - score[Hi] := T; - P := Targets.ar[Lo]; - Targets.ar[Lo] := Targets.ar[Hi]; - Targets.ar[Hi] := P; - Inc(Lo); - Dec(Hi) - end; - until Lo > Hi; - if Hi > iLo then qSort(iLo, Hi); - if Lo < iHi then qSort(Lo, iHi); - end; - -begin -Targets.Count:= 0; -t:= TeamsList; -MaxHealth:= 0; -while t <> nil do - begin - if t <> CurrentTeam then - for i:= 0 to cMaxHHIndex do - if t.Hedgehogs[i].Gear <> nil then - begin - with Targets.ar[Targets.Count], t.Hedgehogs[i] do - begin - X:= Round(Gear.X); - Y:= Round(Gear.Y); - if integer(Gear.Health) > MaxHealth then MaxHealth:= Gear.Health; - score[Targets.Count]:= random(3) - integer(Gear.Health div 5) - end; - inc(Targets.Count) - end; - t:= t.Next - end; -// выставляем оценку за попадание в ёжика: -// - если есть соседи-противники, то оценка увеличивается -// - чем меньше хелса у ёжика, тем больше оценка (код см. выше) -// - если есть соседи-"свои", то уменьшается -with Targets do - for i:= 0 to Targets.Count - 1 do - begin - for k:= Succ(i) to Pred(Targets.Count) do - begin - r:= 100 - round(sqrt(sqr(ar[i].X - ar[k].X) + sqr(ar[i].Y - ar[k].Y))); - if r > 0 then - begin - inc(score[i], r); - inc(score[k], r) - end; - end; - for k:= 0 to cMaxHHIndex do - with CurrentTeam.Hedgehogs[k] do - if Gear <> nil then - begin - r:= 100 - round(sqrt(sqr(ar[i].X - round(Gear.X)) + sqr(ar[i].Y - round(Gear.Y)))); - if r > 0 then dec(score[i], (r * 3) div 2 + MaxHealth + 5 - integer(Gear.Health)); - end; - end; -// сортируем по убыванию согласно оценке -if Targets.Count >= 2 then qSort(0, Pred(Targets.Count)); -end; - -function DxDy2Angle(const _dY, _dX: Extended): integer; -const piDIVMaxAngle: Extended = pi/cMaxAngle; -asm - fld _dY - fld _dX - fpatan - fld piDIVMaxAngle - fdiv - sub esp, 4 - fistp dword ptr [esp] - pop eax -end; - -function TestColl(x, y, r: integer): boolean; -begin -Result:=(((x-r) and $FFFFF800) = 0)and(((y-r) and $FFFFFC00) = 0) and (Land[y-r, x-r] <> 0); -if Result then exit; -Result:=(((x-r) and $FFFFF800) = 0)and(((y+r) and $FFFFFC00) = 0) and (Land[y+r, x-r] <> 0); -if Result then exit; -Result:=(((x+r) and $FFFFF800) = 0)and(((y-r) and $FFFFFC00) = 0) and (Land[y-r, x+r] <> 0); -if Result then exit; -Result:=(((x+r) and $FFFFF800) = 0)and(((y+r) and $FFFFFC00) = 0) and (Land[y+r, x+r] <> 0); -end; - -function NoMyHHNear(x, y, r: integer): boolean; -var i: integer; -begin -i:= 0; -r:= sqr(r); -Result:= true; -repeat - with CurrentTeam.Hedgehogs[i] do - if Gear <> nil then - if sqr(Gear.X - x) + sqr(Gear.Y - y) <= r then - begin - Result:= false; - exit - end; -inc(i) -until i > cMaxHHIndex -end; - -function HHGo(Gear: PGear): boolean; // false если нельзя двигаться -var pX, pY: integer; -begin -Result:= false; -repeat -pX:= round(Gear.X); -pY:= round(Gear.Y); -if pY + cHHHalfHeight >= cWaterLine then exit; -if (Gear.State and gstFalling) <> 0 then - begin - Gear.dY:= Gear.dY + cGravity; - if Gear.dY > 0.35 then exit; - Gear.Y:= Gear.Y + Gear.dY; - if HHTestCollisionYwithGear(Gear, 1) then - begin - Gear.State:= Gear.State and not (gstFalling or gstHHJumping); - Gear.dY:= 0 - end; - continue - end; - {if ((Gear.Message and gm_LJump )<>0) then - begin - Gear.Message:= 0; - if not HHTestCollisionYwithGear(Gear, -1) then - if not TestCollisionXwithXYShift(Gear, 0, -2, Sign(Gear.dX)) then Gear.Y:= Gear.Y - 2 else - if not TestCollisionXwithXYShift(Gear, 0, -1, Sign(Gear.dX)) then Gear.Y:= Gear.Y - 1; - if not (TestCollisionXwithGear(Gear, Sign(Gear.dX)) - or HHTestCollisionYwithGear(Gear, -1)) then - begin - Gear.dY:= -0.15; - Gear.dX:= Sign(Gear.dX) * 0.15; - Gear.State:= Gear.State or gstFalling or gstHHJumping; - exit - end; - end;} - if (Gear.Message and gm_Left )<>0 then Gear.dX:= -1.0 else - if (Gear.Message and gm_Right )<>0 then Gear.dX:= 1.0 else exit; - if TestCollisionXwithGear(Gear, Sign(Gear.dX)) then - begin - if not (TestCollisionXwithXYShift(Gear, 0, -6, Sign(Gear.dX)) - or HHTestCollisionYwithGear(Gear, -1)) then Gear.Y:= Gear.Y - 1; - if not (TestCollisionXwithXYShift(Gear, 0, -5, Sign(Gear.dX)) - or HHTestCollisionYwithGear(Gear, -1)) then Gear.Y:= Gear.Y - 1; - if not (TestCollisionXwithXYShift(Gear, 0, -4, Sign(Gear.dX)) - or HHTestCollisionYwithGear(Gear, -1)) then Gear.Y:= Gear.Y - 1; - if not (TestCollisionXwithXYShift(Gear, 0, -3, Sign(Gear.dX)) - or HHTestCollisionYwithGear(Gear, -1)) then Gear.Y:= Gear.Y - 1; - if not (TestCollisionXwithXYShift(Gear, 0, -2, Sign(Gear.dX)) - or HHTestCollisionYwithGear(Gear, -1)) then Gear.Y:= Gear.Y - 1; - if not (TestCollisionXwithXYShift(Gear, 0, -1, Sign(Gear.dX)) - or HHTestCollisionYwithGear(Gear, -1)) then Gear.Y:= Gear.Y - 1; - end; - - if not TestCollisionXwithGear(Gear, Sign(Gear.dX)) then Gear.X:= Gear.X + Gear.dX; - if not HHTestCollisionYwithGear(Gear, 1) then - begin - Gear.Y:= Gear.Y + 1; - if not HHTestCollisionYwithGear(Gear, 1) then - begin - Gear.Y:= Gear.Y + 1; - if not HHTestCollisionYwithGear(Gear, 1) then - begin - Gear.Y:= Gear.Y + 1; - if not HHTestCollisionYwithGear(Gear, 1) then - begin - Gear.Y:= Gear.Y + 1; - if not HHTestCollisionYwithGear(Gear, 1) then - begin - Gear.Y:= Gear.Y + 1; - if not HHTestCollisionYwithGear(Gear, 1) then - begin - Gear.Y:= Gear.Y + 1; - if not HHTestCollisionYwithGear(Gear, 1) then - begin - Gear.Y:= Gear.Y - 6; - Gear.dY:= 0; - Gear.dX:= 0.0000001 * Sign(Gear.dX); - Gear.State:= Gear.State or gstFalling - end - end - end - end - end - end - end; -if (pX <> round(Gear.X))and ((Gear.State and gstFalling) = 0) then - begin - Result:= true; - exit - end; -until (pX = round(Gear.X)) and (pY = round(Gear.Y)) and ((Gear.State and gstFalling) = 0); -end; - -end. +(* + * Hedgewars, a worms-like game + * Copyright (c) 2005 Andrey Korotaev + * + * 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 ffe4ad26a64c -r bcbd7adb4e4b hedgewars/uCollisions.pas --- a/hedgewars/uCollisions.pas Mon Aug 22 21:38:06 2005 +0000 +++ b/hedgewars/uCollisions.pas Tue Aug 23 16:17:53 2005 +0000 @@ -1,252 +1,252 @@ -(* - * Hedgewars, a worms-like game - * Copyright (c) 2005 Andrey Korotaev - * - * Distributed under the terms of the BSD-modified licence: - * - * Permission is hereby granted, free of charge, to any person obtaining a copy - * of this software and associated documentation files (the "Software"), to deal - * with the Software without restriction, including without limitation the - * rights to use, copy, modify, merge, publish, distribute, sublicense, and/or - * sell copies of the Software, and to permit persons to whom the Software is - * furnished to do so, subject to the following conditions: - * - * 1. Redistributions of source code must retain the above copyright notice, - * this list of conditions and the following disclaimer. - * 2. Redistributions in binary form must reproduce the above copyright notice, - * this list of conditions and the following disclaimer in the documentation - * and/or other materials provided with the distribution. - * 3. The name of the author may not be used to endorse or promote products - * derived from this software without specific prior written permission. - * - * THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR IMPLIED - * WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF - * MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO - * EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, - * SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, - * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; - * OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, - * WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR - * OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF - * ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. - *) - -unit uCollisions; -interface -uses uGears; -{$INCLUDE options.inc} - -type TCollisionEntry = record - X, Y, HWidth, HHeight: integer; - cGear: PGear; - end; - -procedure AddGearCR(Gear: PGear); -procedure UpdateCR(NewX, NewY: integer; Index: Longword); -procedure DeleteCR(Gear: PGear); -function CheckGearsCollision(Gear: PGear; Dir: integer; forX: boolean): boolean; -function HHTestCollisionYwithGear(Gear: PGear; Dir: integer): boolean; -function TestCollisionXwithGear(Gear: PGear; Dir: integer): boolean; -function TestCollisionYwithGear(Gear: PGear; Dir: integer): boolean; -function TestCollisionXwithXYShift(Gear: PGear; ShiftX, ShiftY: integer; Dir: integer): boolean; -function TestCollisionYwithXYShift(Gear: PGear; ShiftX, ShiftY: integer; Dir: integer): boolean; -function TestCollisionY(Gear: PGear; Dir: integer): boolean; - -implementation -uses uMisc, uConsts, uLand; - -const MAXRECTSINDEX = 255; -var Count: Longword = 0; - crects: array[0..MAXRECTSINDEX] of TCollisionEntry; - -procedure AddGearCR(Gear: PGear); -begin -{$IFDEF DEBUGFILE}AddFileLog('AddCR crects count = ' + inttostr(Count));{$ENDIF} -TryDo(Count <= MAXRECTSINDEX, 'Collision rects array overflow', true); -with crects[Count] do - begin - X:= round(Gear.X); - Y:= round(Gear.Y); - HWidth:= Gear.HalfWidth; - HHeight:= Gear.HalfHeight; - cGear:= Gear - end; -Gear.CollIndex:= Count; -inc(Count) -end; - -procedure UpdateCR(NewX, NewY: integer; Index: Longword); -begin -with crects[Index] do - begin - X:= NewX; - Y:= NewY - end -end; - -procedure DeleteCR(Gear: PGear); -begin -{$IFDEF DEBUGFILE}AddFileLog('DelCR crects count = ' + inttostr(Count) + ' deleting ' + inttostr(Gear.CollIndex));{$ENDIF} -if Gear.CollIndex < Pred(Count) then - begin - crects[Gear.CollIndex]:= crects[Pred(Count)]; - crects[Gear.CollIndex].cGear.CollIndex:= Gear.CollIndex - end; -Gear.CollIndex:= High(Longword); -dec(Count) -end; - -function CheckGearsCollision(Gear: PGear; Dir: integer; forX: boolean): boolean; -var x1, x2, y1, y2: integer; - i: Longword; -begin -x1:= round(Gear.X); -y1:= round(Gear.Y); -{if (Gear.State and gstOutOfHH) = 0 then - begin - p:= PHedgehog(Gear.Hedgehog)^.Gear; - if (p <> nil) and - ((x1 + Gear.HalfWidth < round(p.X) - p.HalfWidth) - or (x1 - Gear.HalfWidth > round(p.X) + p.HalfWidth) - or (y1 - Gear.HalfHeight > round(p.Y) + p.HalfHeight) - or (y1 + Gear.HalfHeight < round(p.Y) - p.HalfHeight)) then Gear.State:= Gear.State or gstOutOfHH; - end; } -Result:= false; -if forX then - begin - x1:= x1 + Dir*Gear.HalfWidth; - x2:= x1; - y2:= y1 + Gear.HalfHeight - 1; - y1:= y1 - Gear.HalfHeight + 1 - end else - begin - y1:= y1 + Dir*Gear.HalfHeight; - y2:= y1; - x2:= x1 + Gear.HalfWidth - 1; - x1:= x1 - Gear.HalfWidth + 1 - end; - -for i:= 0 to Pred(Count) do - with crects[i] do - if (Gear.CollIndex <> i) -// if ((p.Kind = gtHedgehog) and ((p.Hedgehog <> Gear.Hedgehog) or ((Gear.State and gstOutOfHH) <> 0))) - and (x1 <= X + HWidth) - and (x2 >= X - HWidth) - and (y1 <= Y + HHeight) - and (y2 >= Y - HHeight) then - begin - Result:= true; - exit - end; -end; - -function HHTestCollisionYwithGear(Gear: PGear; Dir: integer): boolean; -var x, y, i: integer; -begin -Result:= false; -y:= round(Gear.Y); -if Dir < 0 then y:= y - Gear.HalfHeight - else y:= y + Gear.HalfHeight; - -if ((y - Dir) and $FFFFFC00) = 0 then - begin - x:= round(Gear.X); - if (((x - Gear.HalfWidth) and $FFFFF800) = 0)and(Land[y - Dir, x - Gear.HalfWidth] <> 0) - or(((x + Gear.HalfWidth) and $FFFFF800) = 0)and(Land[y - Dir, x + Gear.HalfWidth] <> 0) then - begin - Result:= true; - exit - end - end; - -if (y and $FFFFFC00) = 0 then - begin - x:= round(Gear.X) - Gear.HalfWidth + 1; - i:= x + Gear.HalfWidth * 2 - 2; - repeat - if (x and $FFFFF800) = 0 then Result:= Land[y, x]<>0; - inc(x) - until (x > i) or Result; - if Result then exit; - - Result:= CheckGearsCollision(Gear, Dir, false) - end -end; - -function TestCollisionXwithGear(Gear: PGear; Dir: integer): boolean; -var x, y, i: integer; -begin -Result:= false; -x:= round(Gear.X); -if Dir < 0 then x:= x - Gear.HalfWidth - else x:= x + Gear.HalfWidth; -if (x and $FFFFF800) = 0 then - begin - y:= round(Gear.Y) - Gear.HalfHeight + 1; {*} - i:= y + Gear.HalfHeight * 2 - 2; {*} - repeat - if (y and $FFFFFC00) = 0 then Result:= Land[y, x]<>0; - inc(y) - until (y > i) or Result; - if Result then exit; - Result:= CheckGearsCollision(Gear, Dir, true) - end -end; - -function TestCollisionXwithXYShift(Gear: PGear; ShiftX, ShiftY: integer; Dir: integer): boolean; -begin -Gear.X:= Gear.X + ShiftX; -Gear.Y:= Gear.Y + ShiftY; -Result:= TestCollisionXwithGear(Gear, Dir); -Gear.X:= Gear.X - ShiftX; -Gear.Y:= Gear.Y - ShiftY -end; - -function TestCollisionYwithGear(Gear: PGear; Dir: integer): boolean; -var x, y, i: integer; -begin -Result:= false; -y:= round(Gear.Y); -if Dir < 0 then y:= y - Gear.HalfHeight - else y:= y + Gear.HalfHeight; -if (y and $FFFFFC00) = 0 then - begin - x:= round(Gear.X) - Gear.HalfWidth + 1; {*} - i:= x + Gear.HalfWidth * 2 - 2; {*} - repeat - if (x and $FFFFF800) = 0 then Result:= Land[y, x]<>0; - inc(x) - until (x > i) or Result; - if Result then exit; - Result:= CheckGearsCollision(Gear, Dir, false); - end -end; - -function TestCollisionY(Gear: PGear; Dir: integer): boolean; -var x, y, i: integer; -begin -Result:= false; -y:= round(Gear.Y); -if Dir < 0 then y:= y - Gear.HalfHeight - else y:= y + Gear.HalfHeight; -if (y and $FFFFFC00) = 0 then - begin - x:= round(Gear.X) - Gear.HalfWidth + 1; {*} - i:= x + Gear.HalfWidth * 2 - 2; {*} - repeat - if (x and $FFFFF800) = 0 then Result:= Land[y, x]<>0; - inc(x) - until (x > i) or Result; - end -end; - -function TestCollisionYwithXYShift(Gear: PGear; ShiftX, ShiftY: integer; Dir: integer): boolean; -begin -Gear.X:= Gear.X + ShiftX; -Gear.Y:= Gear.Y + ShiftY; -Result:= TestCollisionYwithGear(Gear, Dir); -Gear.X:= Gear.X - ShiftX; -Gear.Y:= Gear.Y - ShiftY -end; - -end. +(* + * Hedgewars, a worms-like game + * Copyright (c) 2005 Andrey Korotaev + * + * 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 ffe4ad26a64c -r bcbd7adb4e4b hedgewars/uConsole.pas --- a/hedgewars/uConsole.pas Mon Aug 22 21:38:06 2005 +0000 +++ b/hedgewars/uConsole.pas Tue Aug 23 16:17:53 2005 +0000 @@ -1,297 +1,297 @@ -(* - * Hedgewars, a worms-like game - * Copyright (c) 2004, 2005 Andrey Korotaev - * - * Distributed under the terms of the BSD-modified licence: - * - * Permission is hereby granted, free of charge, to any person obtaining a copy - * of this software and associated documentation files (the "Software"), to deal - * with the Software without restriction, including without limitation the - * rights to use, copy, modify, merge, publish, distribute, sublicense, and/or - * sell copies of the Software, and to permit persons to whom the Software is - * furnished to do so, subject to the following conditions: - * - * 1. Redistributions of source code must retain the above copyright notice, - * this list of conditions and the following disclaimer. - * 2. Redistributions in binary form must reproduce the above copyright notice, - * this list of conditions and the following disclaimer in the documentation - * and/or other materials provided with the distribution. - * 3. The name of the author may not be used to endorse or promote products - * derived from this software without specific prior written permission. - * - * THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR IMPLIED - * WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF - * MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO - * EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, - * SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, - * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; - * OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, - * WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR - * OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF - * ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. - *) - -unit uConsole; -interface -uses SDLh; -{$INCLUDE options.inc} -const isDeveloperMode: boolean = true; -type TVariableType = (vtCommand, vtInteger, vtReal, vtBoolean); - TCommandHandler = procedure (var params: shortstring); - -procedure DrawConsole(Surface: PSDL_Surface); -procedure WriteToConsole(s: shortstring); -procedure WriteLnToConsole(s: shortstring); -procedure KeyPressConsole(Key: Longword); -procedure ParseCommand(CmdStr: shortstring); -procedure AfterAttack; // экспортируется только для вызова из CurrAmmoGear - -implementation -{$J+} -uses uMisc, uStore, Types, uConsts, uGears, uTeams, uIO, uKeys, uSound, uWorld, uLand; -const cLineWidth: integer = 0; - cLinesCount = 256; - -type PVariable = ^TVariable; - TVariable = record - Next: PVariable; - Name: string[15]; - VType: TVariableType; - Handler: pointer; - end; - -var ConsoleLines: array[byte] of ShortString; - CurrLine: integer = 0; - InputStr: shortstring; - Variables: PVariable = nil; - -function RegisterVariable(Name: string; VType: TVariableType; p: pointer): PVariable; -begin -try - New(Result); -except Result:= nil; OutError(errmsgDynamicVar, true) end; -FillChar(Result^, sizeof(TVariable), 0); -Result.Name:= Name; -Result.VType:= VType; -Result.Handler:= p; -if Variables = nil then Variables:= Result - else begin - Result.Next:= Variables; - Variables:= Result - end -end; - -procedure FreeVariablesList; -var t, tt: PVariable; -begin -tt:= Variables; -Variables:= nil; -while tt<>nil do - begin - t:= tt; - tt:= tt.Next; - try - Dispose(t) - except OutError(errmsgDynamicVar) end; - end; -end; - -procedure SplitBySpace(var a, b: shortstring); -var i, t: integer; -begin -i:= Pos(' ', a); -if i>0 then - begin - for t:= 1 to Pred(i) do - if (a[t] >= 'A')and(a[t] <= 'Z') then Inc(a[t], 32); - b:= copy(a, i + 1, Length(a) - i); - while (b[0]<>#0) and (b[1]=#32) do Delete(b, 1, 1); - byte(a[0]):= Pred(i) - end else b:= ''; -end; - -procedure DrawConsole(Surface: PSDL_Surface); -var x, y: integer; - r: TSDL_Rect; -begin -with r do - begin - x:= 0; - y:= cConsoleHeight; - w:= cScreenWidth; - h:= 4; - end; -SDL_FillRect(Surface, @r, cConsoleSplitterColor); -for y:= 0 to cConsoleHeight div 256 + 1 do - for x:= 0 to cScreenWidth div 256 + 1 do - DrawGear(sConsoleBG, x * 256, cConsoleHeight - 256 - y * 256, Surface); -for y:= 0 to cConsoleHeight div Fontz[fnt16].Height do - DXOutText(4, cConsoleHeight - (y + 2) * (Fontz[fnt16].Height + 2), fnt16, ConsoleLines[(CurrLine - 1 - y + cLinesCount) mod cLinesCount], Surface); -DXOutText(4, cConsoleHeight - Fontz[fnt16].Height - 2, fnt16, '> '+InputStr, Surface); -end; - -procedure WriteToConsole(s: shortstring); -var Len: integer; -begin -{$IFDEF DEBUGFILE}AddFileLog('Console write: ' + s);{$ENDIF} -Write(s); -repeat -Len:= cLineWidth - Length(ConsoleLines[CurrLine]); -ConsoleLines[CurrLine]:= ConsoleLines[CurrLine] + copy(s, 1, Len); -Delete(s, 1, Len); -if byte(ConsoleLines[CurrLine][0])=cLineWidth then - begin - inc(CurrLine); - if CurrLine = cLinesCount then CurrLine:= 0; - PLongWord(@ConsoleLines[CurrLine])^:= 0 - end; -until Length(s) = 0 -end; - -procedure WriteLnToConsole(s: shortstring); -begin -WriteToConsole(s); -WriteLn; -inc(CurrLine); -if CurrLine = cLinesCount then CurrLine:= 0; -PLongWord(@ConsoleLines[CurrLine])^:= 0 -end; - -procedure InitConsole; -var i: integer; -begin -cLineWidth:= cScreenWidth div 10; -if cLineWidth > 255 then cLineWidth:= 255; -for i:= 0 to Pred(cLinesCount) do PLongWord(@ConsoleLines[i])^:= 0 -end; - -procedure ParseCommand(CmdStr: shortstring); -type PReal = ^real; -var i, ii: integer; - s: shortstring; - t: PVariable; - c: char; -begin -//WriteLnToConsole(CmdStr); -if CmdStr[0]=#0 then exit; -{$IFDEF DEBUGFILE}AddFileLog('ParseCommand "' + CmdStr + '"');{$ENDIF} -c:= CmdStr[1]; -if c in ['/', '$'] then Delete(CmdStr, 1, 1) else c:= '/'; -SplitBySpace(CmdStr, s); -t:= Variables; -while t <> nil do - begin - if t.Name = CmdStr then - begin - case t.VType of - vtCommand: if c='/' then - begin - TCommandHandler(t.Handler)(s); - end; - vtInteger: if c='$' then - if s[0]=#0 then - begin - str(PInteger(t.Handler)^, s); - WriteLnToConsole('$' + CmdStr + ' is "' + s + '"'); - end else val(s, PInteger(t.Handler)^, i); - vtReal: if c='$' then - if s[0]=#0 then - begin - str(PReal(t.Handler)^:4:6, s); - WriteLnToConsole('$' + CmdStr + ' is "' + s + '"'); - end else val(s, PReal(t.Handler)^ , i); - vtBoolean: if c='$' then - if s[0]=#0 then - begin - str(ord(boolean(t.Handler^)), s); - WriteLnToConsole('$' + CmdStr + ' is "' + s + '"'); - end else - begin - val(s, ii, i); - boolean(t.Handler^):= not (ii = 0) - end; - end; - exit - end else t:= t.Next - end; -case c of - '$': WriteLnToConsole(errmsgUnknownVariable + ': "$' + CmdStr + '"') - else WriteLnToConsole(errmsgUnknownCommand + ': "/' + CmdStr + '"') end -end; - -procedure KeyPressConsole(Key: Longword); -begin -case Key of - 8: if Length(InputStr)>0 then dec(InputStr[0]); - 13,271: begin - ParseCommand('/say ' + InputStr); - InputStr:= '' - end; - 96: begin - GameState:= gsGame; - cConsoleYAdd:= 0; - ResetKbd - end; - else InputStr:= InputStr + char(Key) - end -end; - -{$INCLUDE CCHandlers.inc} - -procedure AfterAttack; -begin -with CurrentTeam.Hedgehogs[CurrentTeam.CurrHedgehog].Gear^, - CurrentTeam.Hedgehogs[CurrentTeam.CurrHedgehog] do - begin - Inc(AttacksNum); - State:= State and not gstAttacking; - if Ammo[CurSlot, CurAmmo].NumPerTurn >= AttacksNum then isInMultiShoot:= true - else begin - TurnTimeLeft:= Ammoz[Ammo[CurSlot, CurAmmo].AmmoType].TimeAfterTurn; - State:= State or gstAttacked; - OnUsedAmmo(Ammo) - end; - AttackBar:= 0 - end -end; - -initialization -InitConsole; -RegisterVariable('quit' , vtCommand, @chQuit ); -RegisterVariable('capture' , vtCommand, @chCapture ); -RegisterVariable('addteam' , vtCommand, @chAddTeam ); -RegisterVariable('rdriven' , vtCommand, @chTeamLocal ); -//RegisterVariable('gravity' , vtReal , @cGravity ); гравитация не должна быть доступна вообще -RegisterVariable('c_height', vtInteger, @cConsoleHeight ); -RegisterVariable('gmflags' , vtInteger, @GameFlags ); -RegisterVariable('showfps' , vtBoolean, @cShowFPS ); -RegisterVariable('sound' , vtBoolean, @isSoundEnabled ); -RegisterVariable('name' , vtCommand, @chName ); -RegisterVariable('fort' , vtCommand, @chFort ); -RegisterVariable('grave' , vtCommand, @chGrave ); -RegisterVariable('bind' , vtCommand, @chBind ); -RegisterVariable('add' , vtCommand, @chAdd ); -RegisterVariable('say' , vtCommand, @chSay ); -RegisterVariable('+left' , vtCommand, @chLeft_p ); -RegisterVariable('-left' , vtCommand, @chLeft_m ); -RegisterVariable('+right' , vtCommand, @chRight_p ); -RegisterVariable('-right' , vtCommand, @chRight_m ); -RegisterVariable('+up' , vtCommand, @chUp_p ); -RegisterVariable('-up' , vtCommand, @chUp_m ); -RegisterVariable('+down' , vtCommand, @chDown_p ); -RegisterVariable('-down' , vtCommand, @chDown_m ); -RegisterVariable('+attack' , vtCommand, @chAttack_p ); -RegisterVariable('-attack' , vtCommand, @chAttack_m ); -RegisterVariable('color' , vtCommand, @chColor ); -RegisterVariable('switch' , vtCommand, @chSwitch ); -RegisterVariable('nextturn', vtCommand, @chNextTurn ); -RegisterVariable('timer' , vtCommand, @chTimer ); -RegisterVariable('slot' , vtCommand, @chSlot ); -RegisterVariable('put' , vtCommand, @chPut ); -RegisterVariable('ljump' , vtCommand, @chLJump ); -RegisterVariable('hjump' , vtCommand, @chHJump ); - -finalization -FreeVariablesList - -end. +(* + * Hedgewars, a worms-like game + * Copyright (c) 2004, 2005 Andrey Korotaev + * + * Distributed under the terms of the BSD-modified licence: + * + * Permission is hereby granted, free of charge, to any person obtaining a copy + * of this software and associated documentation files (the "Software"), to deal + * with the Software without restriction, including without limitation the + * rights to use, copy, modify, merge, publish, distribute, sublicense, and/or + * sell copies of the Software, and to permit persons to whom the Software is + * furnished to do so, subject to the following conditions: + * + * 1. Redistributions of source code must retain the above copyright notice, + * this list of conditions and the following disclaimer. + * 2. Redistributions in binary form must reproduce the above copyright notice, + * this list of conditions and the following disclaimer in the documentation + * and/or other materials provided with the distribution. + * 3. The name of the author may not be used to endorse or promote products + * derived from this software without specific prior written permission. + * + * THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR IMPLIED + * WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF + * MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO + * EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, + * SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, + * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; + * OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, + * WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR + * OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF + * ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + *) + +unit uConsole; +interface +uses SDLh; +{$INCLUDE options.inc} +const isDeveloperMode: boolean = true; +type TVariableType = (vtCommand, vtInteger, vtReal, vtBoolean); + TCommandHandler = procedure (var params: shortstring); + +procedure DrawConsole(Surface: PSDL_Surface); +procedure WriteToConsole(s: shortstring); +procedure WriteLnToConsole(s: shortstring); +procedure KeyPressConsole(Key: Longword); +procedure ParseCommand(CmdStr: shortstring); +procedure AfterAttack; // экспортируется только для вызова из CurrAmmoGear + +implementation +{$J+} +uses uMisc, uStore, Types, uConsts, uGears, uTeams, uIO, uKeys, uSound, uWorld, uLand; +const cLineWidth: integer = 0; + cLinesCount = 256; + +type PVariable = ^TVariable; + TVariable = record + Next: PVariable; + Name: string[15]; + VType: TVariableType; + Handler: pointer; + end; + +var ConsoleLines: array[byte] of ShortString; + CurrLine: integer = 0; + InputStr: shortstring; + Variables: PVariable = nil; + +function RegisterVariable(Name: string; VType: TVariableType; p: pointer): PVariable; +begin +try + New(Result); +except Result:= nil; OutError(errmsgDynamicVar, true) end; +FillChar(Result^, sizeof(TVariable), 0); +Result.Name:= Name; +Result.VType:= VType; +Result.Handler:= p; +if Variables = nil then Variables:= Result + else begin + Result.Next:= Variables; + Variables:= Result + end +end; + +procedure FreeVariablesList; +var t, tt: PVariable; +begin +tt:= Variables; +Variables:= nil; +while tt<>nil do + begin + t:= tt; + tt:= tt.Next; + try + Dispose(t) + except OutError(errmsgDynamicVar) end; + end; +end; + +procedure SplitBySpace(var a, b: shortstring); +var i, t: integer; +begin +i:= Pos(' ', a); +if i>0 then + begin + for t:= 1 to Pred(i) do + if (a[t] >= 'A')and(a[t] <= 'Z') then Inc(a[t], 32); + b:= copy(a, i + 1, Length(a) - i); + while (b[0]<>#0) and (b[1]=#32) do Delete(b, 1, 1); + byte(a[0]):= Pred(i) + end else b:= ''; +end; + +procedure DrawConsole(Surface: PSDL_Surface); +var x, y: integer; + r: TSDL_Rect; +begin +with r do + begin + x:= 0; + y:= cConsoleHeight; + w:= cScreenWidth; + h:= 4; + end; +SDL_FillRect(Surface, @r, cConsoleSplitterColor); +for y:= 0 to cConsoleHeight div 256 + 1 do + for x:= 0 to cScreenWidth div 256 + 1 do + DrawGear(sConsoleBG, x * 256, cConsoleHeight - 256 - y * 256, Surface); +for y:= 0 to cConsoleHeight div Fontz[fnt16].Height do + DXOutText(4, cConsoleHeight - (y + 2) * (Fontz[fnt16].Height + 2), fnt16, ConsoleLines[(CurrLine - 1 - y + cLinesCount) mod cLinesCount], Surface); +DXOutText(4, cConsoleHeight - Fontz[fnt16].Height - 2, fnt16, '> '+InputStr, Surface); +end; + +procedure WriteToConsole(s: shortstring); +var Len: integer; +begin +{$IFDEF DEBUGFILE}AddFileLog('Console write: ' + s);{$ENDIF} +Write(s); +repeat +Len:= cLineWidth - Length(ConsoleLines[CurrLine]); +ConsoleLines[CurrLine]:= ConsoleLines[CurrLine] + copy(s, 1, Len); +Delete(s, 1, Len); +if byte(ConsoleLines[CurrLine][0])=cLineWidth then + begin + inc(CurrLine); + if CurrLine = cLinesCount then CurrLine:= 0; + PLongWord(@ConsoleLines[CurrLine])^:= 0 + end; +until Length(s) = 0 +end; + +procedure WriteLnToConsole(s: shortstring); +begin +WriteToConsole(s); +WriteLn; +inc(CurrLine); +if CurrLine = cLinesCount then CurrLine:= 0; +PLongWord(@ConsoleLines[CurrLine])^:= 0 +end; + +procedure InitConsole; +var i: integer; +begin +cLineWidth:= cScreenWidth div 10; +if cLineWidth > 255 then cLineWidth:= 255; +for i:= 0 to Pred(cLinesCount) do PLongWord(@ConsoleLines[i])^:= 0 +end; + +procedure ParseCommand(CmdStr: shortstring); +type PReal = ^real; +var i, ii: integer; + s: shortstring; + t: PVariable; + c: char; +begin +//WriteLnToConsole(CmdStr); +if CmdStr[0]=#0 then exit; +{$IFDEF DEBUGFILE}AddFileLog('ParseCommand "' + CmdStr + '"');{$ENDIF} +c:= CmdStr[1]; +if c in ['/', '$'] then Delete(CmdStr, 1, 1) else c:= '/'; +SplitBySpace(CmdStr, s); +t:= Variables; +while t <> nil do + begin + if t.Name = CmdStr then + begin + case t.VType of + vtCommand: if c='/' then + begin + TCommandHandler(t.Handler)(s); + end; + vtInteger: if c='$' then + if s[0]=#0 then + begin + str(PInteger(t.Handler)^, s); + WriteLnToConsole('$' + CmdStr + ' is "' + s + '"'); + end else val(s, PInteger(t.Handler)^, i); + vtReal: if c='$' then + if s[0]=#0 then + begin + str(PReal(t.Handler)^:4:6, s); + WriteLnToConsole('$' + CmdStr + ' is "' + s + '"'); + end else val(s, PReal(t.Handler)^ , i); + vtBoolean: if c='$' then + if s[0]=#0 then + begin + str(ord(boolean(t.Handler^)), s); + WriteLnToConsole('$' + CmdStr + ' is "' + s + '"'); + end else + begin + val(s, ii, i); + boolean(t.Handler^):= not (ii = 0) + end; + end; + exit + end else t:= t.Next + end; +case c of + '$': WriteLnToConsole(errmsgUnknownVariable + ': "$' + CmdStr + '"') + else WriteLnToConsole(errmsgUnknownCommand + ': "/' + CmdStr + '"') end +end; + +procedure KeyPressConsole(Key: Longword); +begin +case Key of + 8: if Length(InputStr)>0 then dec(InputStr[0]); + 13,271: begin + ParseCommand('/say ' + InputStr); + InputStr:= '' + end; + 96: begin + GameState:= gsGame; + cConsoleYAdd:= 0; + ResetKbd + end; + else InputStr:= InputStr + char(Key) + end +end; + +{$INCLUDE CCHandlers.inc} + +procedure AfterAttack; +begin +with CurrentTeam.Hedgehogs[CurrentTeam.CurrHedgehog].Gear^, + CurrentTeam.Hedgehogs[CurrentTeam.CurrHedgehog] do + begin + Inc(AttacksNum); + State:= State and not gstAttacking; + if Ammo[CurSlot, CurAmmo].NumPerTurn >= AttacksNum then isInMultiShoot:= true + else begin + TurnTimeLeft:= Ammoz[Ammo[CurSlot, CurAmmo].AmmoType].TimeAfterTurn; + State:= State or gstAttacked; + OnUsedAmmo(Ammo) + end; + AttackBar:= 0 + end +end; + +initialization +InitConsole; +RegisterVariable('quit' , vtCommand, @chQuit ); +RegisterVariable('capture' , vtCommand, @chCapture ); +RegisterVariable('addteam' , vtCommand, @chAddTeam ); +RegisterVariable('rdriven' , vtCommand, @chTeamLocal ); +//RegisterVariable('gravity' , vtReal , @cGravity ); гравитация не должна быть доступна вообще +RegisterVariable('c_height', vtInteger, @cConsoleHeight ); +RegisterVariable('gmflags' , vtInteger, @GameFlags ); +RegisterVariable('showfps' , vtBoolean, @cShowFPS ); +RegisterVariable('sound' , vtBoolean, @isSoundEnabled ); +RegisterVariable('name' , vtCommand, @chName ); +RegisterVariable('fort' , vtCommand, @chFort ); +RegisterVariable('grave' , vtCommand, @chGrave ); +RegisterVariable('bind' , vtCommand, @chBind ); +RegisterVariable('add' , vtCommand, @chAdd ); +RegisterVariable('say' , vtCommand, @chSay ); +RegisterVariable('+left' , vtCommand, @chLeft_p ); +RegisterVariable('-left' , vtCommand, @chLeft_m ); +RegisterVariable('+right' , vtCommand, @chRight_p ); +RegisterVariable('-right' , vtCommand, @chRight_m ); +RegisterVariable('+up' , vtCommand, @chUp_p ); +RegisterVariable('-up' , vtCommand, @chUp_m ); +RegisterVariable('+down' , vtCommand, @chDown_p ); +RegisterVariable('-down' , vtCommand, @chDown_m ); +RegisterVariable('+attack' , vtCommand, @chAttack_p ); +RegisterVariable('-attack' , vtCommand, @chAttack_m ); +RegisterVariable('color' , vtCommand, @chColor ); +RegisterVariable('switch' , vtCommand, @chSwitch ); +RegisterVariable('nextturn', vtCommand, @chNextTurn ); +RegisterVariable('timer' , vtCommand, @chTimer ); +RegisterVariable('slot' , vtCommand, @chSlot ); +RegisterVariable('put' , vtCommand, @chPut ); +RegisterVariable('ljump' , vtCommand, @chLJump ); +RegisterVariable('hjump' , vtCommand, @chHJump ); + +finalization +FreeVariablesList + +end. diff -r ffe4ad26a64c -r bcbd7adb4e4b hedgewars/uConsts.pas --- a/hedgewars/uConsts.pas Mon Aug 22 21:38:06 2005 +0000 +++ b/hedgewars/uConsts.pas Tue Aug 23 16:17:53 2005 +0000 @@ -1,305 +1,305 @@ -(* - * Hedgewars, a worms-like game - * Copyright (c) 2004, 2005 Andrey Korotaev - * - * Distributed under the terms of the BSD-modified licence: - * - * Permission is hereby granted, free of charge, to any person obtaining a copy - * of this software and associated documentation files (the "Software"), to deal - * with the Software without restriction, including without limitation the - * rights to use, copy, modify, merge, publish, distribute, sublicense, and/or - * sell copies of the Software, and to permit persons to whom the Software is - * furnished to do so, subject to the following conditions: - * - * 1. Redistributions of source code must retain the above copyright notice, - * this list of conditions and the following disclaimer. - * 2. Redistributions in binary form must reproduce the above copyright notice, - * this list of conditions and the following disclaimer in the documentation - * and/or other materials provided with the distribution. - * 3. The name of the author may not be used to endorse or promote products - * derived from this software without specific prior written permission. - * - * THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR IMPLIED - * WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF - * MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO - * EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, - * SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, - * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; - * OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, - * WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR - * OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF - * ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. - *) - -unit uConsts; -interface -uses SDLh; -{$INCLUDE options.inc} -type TStuff = (sHorizont, sSky, sConsoleBG, sPowerBar, sQuestion); - TGameState = (gsLandGen, gsStart, gsGame, gsConsole, gsExit); - TGameType = (gmtLocal, gmtDemo, gmtNet); - TPathType = (ptData, ptGraphics, ptThemes, ptThemeCurrent, ptTeams, ptMaps, - ptMapCurrent, ptDemos, ptSounds, ptGraves, ptFonts, ptForts); - TSprite = (sprWater, sprCloud, sprBomb, sprBigDigit, sprFrame, - sprLag, sprArrow, sprGrenade, sprTargetP, sprUFO, - sprSmokeTrace, sprRopeHook); - TGearType = (gtCloud, gtAmmo_Bomb, gtHedgehog, gtAmmo_Grenade, gtHealthTag, - gtGrave, gtUFO, gtShotgunShot, gtActionTimer, gtPickHammer, gtRope, - gtSmokeTrace); - TSound = (sndGrenadeImpact, sndExplosion, sndThrowPowerUp, sndThrowRelease, sndSplash, - sndShotgunReload, sndShotgunFire, sndGraveImpact); - TAmmoType = (amGrenade, amBazooka, amUFO, amShotgun, amPickHammer, amSkip, amRope); - THWFont = (fnt16, fntBig); - THHFont = record - Handle: PTTF_Font; - Height: integer; - Name: string[15]; - end; - TAmmo = record - Propz: LongWord; - Count: LongWord; - NumPerTurn: LongWord; - Timer: LongWord; - AmmoType: TAmmoType; - end; - - -resourcestring - errmsgCreateSurface = 'Error creating DirectDraw7 surface'; - errmsgNoDesc = 'Unknown error'; - errmsgTransparentSet = 'Error setting transparent color'; - errmsgDynamicVar = 'Error working with dynamic memory'; - errmsgUnknownCommand = 'Unknown command'; - errmsgUnknownVariable = 'Unknown variable'; - errmsgIncorrectUse = 'Incorrect use'; - errmsgShouldntRun = 'This program shouldn''t be run manually'; - - msgLoading = 'Loading '; - msgOK = 'ok'; - msgFailed = 'failed'; - msgGettingConfig = 'Getting game config...'; - -const - cAppName = 'hw'; - cAppTitle = 'hw'; - cNetProtoVersion = 1; - - rndfillstr = 'hw'; - - cTransparentColor: Cardinal = $000000; - - cMaxHHIndex = 9; - cMaxHHs = 20; - cHHSurfaceWidth = 512; - cHHSurfaceHeigth = 256; - - cHHHalfHeight = 11; - - cKeyMaxIndex = 322; - - cMaxCaptions = 4; - - cInactDelay = 1500; - - gfForts = $00000001; - - gstDrowning = $00000001; - gstHHDriven = $00000002; - gstMoving = $00000004; - gstAttacked = $00000008; - gstAttacking = $00000010; - gstCollision = $00000020; - gstHHChooseTarget = $00000040; - gstFalling = $00000080; - gstHHJumping = $00000100; - gsttmpFlag = $00000200; - gstOutOfHH = $00000400; - gstHHThinking = $00000800; - - gtsStartGame = 1; - - gm_Left = $00000001; - gm_Right = $00000002; - gm_Up = $00000004; - gm_Down = $00000008; - gm_Switch = $00000010; - gm_Attack = $00000020; - gm_LJump = $00000040; - gm_HJump = $00000080; - gm_Destroy= $00000100; - - cMaxSlot = 4; - cMaxSlotAmmo = 1; - - ammoprop_Timerable = $00000001; - ammoprop_Power = $00000002; - ammoprop_NeedTarget = $00000004; - ammoprop_ForwMsgs = $00000008; - ammoprop_AttackInFall = $00000010; - ammoprop_AttackInJump = $00000020; - AMMO_INFINITE = High(LongWord); - - capgrpStartGame = 0; - capgrpAmmoinfo = 1; - capgrpNetSay = 2; - - EXPLAllDamageInRadius = 1; - EXPLAutoSound = 2; - EXPLNoDamage = 4; - - cToggleConsoleKey = 39; - - NoPointX = Low(Integer); // константа для TargetPoint, показывает, что цель не указана - - cLandFileName = 'Land.bmp'; - cHHFileName = 'Hedgehog.png'; - cCHFileName = 'Crosshair.png'; - cThemeCFGFilename = 'theme.cfg'; - - Fontz: array[THWFont] of THHFont = ( - (Height: 12; - Name: 'UN1251N.TTF'), - (Height: 24; - Name: 'UN1251N.TTF') - ); - - Pathz: array[TPathType] of string[ 64] = ( - 'Data/', // ptData - 'Data/Graphics/', // ptGraphics - 'Data/Themes/', // ptThemes - 'Data/Themes/Default/', // ptThemeCurrent - 'Data/Teams/', // ptTeams - 'Data/Maps/', // ptMaps - 'Data/Maps/Current/', // ptMapCurrent - 'Data/Demos/', // ptDemos - 'Data/Sounds/', // ptSounds - 'Data/Graphics/Graves/', // ptGraves - 'Data/Fonts/', // ptFonts - 'Data/Forts/' // ptForts - ); - - StuffLoadData: array[TStuff] of record - FileName: String[31]; - Path : TPathType; - end = ( - (FileName: 'horizont.png'; Path: ptThemeCurrent ), // sHorizont - (FileName: 'Sky.png'; Path: ptThemeCurrent ), // sSky - (FileName: 'Console.png'; Path: ptGraphics ), // sConsoleBG - (FileName: 'PowerBar.png'; Path: ptGraphics ), // sPowerBar - (FileName: 'thinking.png'; Path: ptGraphics ) // sQuestion - ); - StuffPoz: array[TStuff] of TSDL_Rect = ( - (x: 0; y: 0; w: 512; h: 256), // sHorizont - (x: 512; y: 0; w: 64; h:1024), // sSky - (x: 256; y: 256; w: 256; h: 256), // sConsoleBG - (x: 256; y: 768; w: 256; h: 32), // sPowerBar - (x: 256; y: 512; w: 32; h: 32) // sQuestion - ); - SpritesData: array[TSprite] of record - FileName: String[31]; - Path : TPathType; - Surface : PSDL_Surface; - Width, Height: integer; - end = ( - (FileName: 'BlueWater.png'; Path: ptGraphics; Width: 256; Height: 48),// sprWater - (FileName: 'Clouds.png'; Path: ptGraphics; Width: 256; Height:128),// sprCloud - (FileName: 'Bomb.png'; Path: ptGraphics; Width: 16; Height: 16),// sprBomb - (FileName: 'BigDigits.png'; Path: ptGraphics; Width: 32; Height: 32),// sprBigDigit - (FileName: 'Frame.png'; Path: ptGraphics; Width: 4; Height: 32),// sprFrame - (FileName: 'Lag.png'; Path: ptGraphics; Width: 64; Height: 64),// sprLag - (FileName: 'Arrow.png'; Path: ptGraphics; Width: 16; Height: 16),// sprCursor - (FileName: 'Grenade.png'; Path: ptGraphics; Width: 32; Height: 32),// sprGrenade - (FileName: 'Targetp.png'; Path: ptGraphics; Width: 32; Height: 32),// sprTargetP - (FileName: 'UFO.png'; Path: ptGraphics; Width: 32; Height: 32),// sprUFO - (FileName:'SmokeTrace.png'; Path: ptGraphics; Width: 32; Height: 32),// sprSmokeTrace - (FileName: 'RopeHook.png'; Path: ptGraphics; Width: 32; Height: 32) // sprRopeHook - ); - Soundz: array[TSound] of record - FileName: String[31]; - Path : TPathType; - id : PMixChunk; - end = ( - (FileName: 'grenadeimpact.ogg'; Path: ptSounds ),// sndGrenadeImpact - (FileName: 'explosion.ogg'; Path: ptSounds ),// sndExplosion - (FileName: 'throwpowerup.ogg'; Path: ptSounds ),// sndThrowPowerUp - (FileName: 'throwrelease.ogg'; Path: ptSounds ),// sndThrowRelease - (FileName: 'splash.ogg'; Path: ptSounds ),// sndSplash - (FileName: 'shotgunreload.ogg'; Path: ptSounds ),// sndShotgunReload - (FileName: 'shotgunfire.ogg'; Path: ptSounds ),// sndShotgunFire - (FileName: 'graveimpact.ogg'; Path: ptSounds ) // sndGraveImpact - ); - - Ammoz: array [TAmmoType] of record - Name: string[32]; - Ammo: TAmmo; - Slot: Longword; - TimeAfterTurn: Longword; - end = ( - (Name: 'Grenade'; - Ammo: (Propz: ammoprop_Timerable or ammoprop_Power; - Count: AMMO_INFINITE; - NumPerTurn: 0; - Timer: 3000; - AmmoType: amGrenade); - Slot: 0; - TimeAfterTurn: 3000), - (Name: 'Bazooka'; - Ammo: (Propz: ammoprop_Power; - Count: AMMO_INFINITE; - NumPerTurn: 0; - Timer: 0; - AmmoType: amBazooka); - Slot: 1; - TimeAfterTurn: 3000), - (Name: 'UFO'; - Ammo: (Propz: ammoprop_Power or ammoprop_NeedTarget; - Count: 4; - NumPerTurn: 0; - Timer: 0; - AmmoType: amUFO); - Slot: 0; - TimeAfterTurn: 3000), - (Name: 'Shotgun'; - Ammo: (Propz: 0; - Count: AMMO_INFINITE; - NumPerTurn: 1; - Timer: 0; - AmmoType: amShotgun); - Slot: 2; - TimeAfterTurn: 3000), - (Name: 'Pneumatic pick'; - Ammo: (Propz: ammoprop_ForwMsgs or ammoprop_AttackInFall or ammoprop_AttackInJump; - Count: 2; - NumPerTurn: 0; - Timer: 0; - AmmoType: amPickHammer); - Slot: 3; - TimeAfterTurn: 0), - (Name: 'Skip turn'; - Ammo: (Propz: 0; - Count: AMMO_INFINITE; - NumPerTurn: 0; - Timer: 0; - AmmoType: amSkip); - Slot: 4; - TimeAfterTurn: 0), - (Name: 'Rope'; - Ammo: (Propz: ammoprop_ForwMsgs or ammoprop_AttackInFall or ammoprop_AttackInJump; - Count: 5; - NumPerTurn: 0; - Timer: 0; - AmmoType: amRope); - Slot: 3; - TimeAfterTurn: 0) - ); - - Resolutions: array[0..3] of String = ( - '640 480', - '800 600', - '1024 768', - '1280 1024' - ); - -implementation - -end. +(* + * Hedgewars, a worms-like game + * Copyright (c) 2004, 2005 Andrey Korotaev + * + * Distributed under the terms of the BSD-modified licence: + * + * Permission is hereby granted, free of charge, to any person obtaining a copy + * of this software and associated documentation files (the "Software"), to deal + * with the Software without restriction, including without limitation the + * rights to use, copy, modify, merge, publish, distribute, sublicense, and/or + * sell copies of the Software, and to permit persons to whom the Software is + * furnished to do so, subject to the following conditions: + * + * 1. Redistributions of source code must retain the above copyright notice, + * this list of conditions and the following disclaimer. + * 2. Redistributions in binary form must reproduce the above copyright notice, + * this list of conditions and the following disclaimer in the documentation + * and/or other materials provided with the distribution. + * 3. The name of the author may not be used to endorse or promote products + * derived from this software without specific prior written permission. + * + * THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR IMPLIED + * WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF + * MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO + * EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, + * SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, + * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; + * OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, + * WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR + * OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF + * ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + *) + +unit uConsts; +interface +uses SDLh; +{$INCLUDE options.inc} +type TStuff = (sHorizont, sSky, sConsoleBG, sPowerBar, sQuestion); + TGameState = (gsLandGen, gsStart, gsGame, gsConsole, gsExit); + TGameType = (gmtLocal, gmtDemo, gmtNet); + TPathType = (ptData, ptGraphics, ptThemes, ptThemeCurrent, ptTeams, ptMaps, + ptMapCurrent, ptDemos, ptSounds, ptGraves, ptFonts, ptForts); + TSprite = (sprWater, sprCloud, sprBomb, sprBigDigit, sprFrame, + sprLag, sprArrow, sprGrenade, sprTargetP, sprUFO, + sprSmokeTrace, sprRopeHook); + TGearType = (gtCloud, gtAmmo_Bomb, gtHedgehog, gtAmmo_Grenade, gtHealthTag, + gtGrave, gtUFO, gtShotgunShot, gtActionTimer, gtPickHammer, gtRope, + gtSmokeTrace); + TSound = (sndGrenadeImpact, sndExplosion, sndThrowPowerUp, sndThrowRelease, sndSplash, + sndShotgunReload, sndShotgunFire, sndGraveImpact); + TAmmoType = (amGrenade, amBazooka, amUFO, amShotgun, amPickHammer, amSkip, amRope); + THWFont = (fnt16, fntBig); + THHFont = record + Handle: PTTF_Font; + Height: integer; + Name: string[15]; + end; + TAmmo = record + Propz: LongWord; + Count: LongWord; + NumPerTurn: LongWord; + Timer: LongWord; + AmmoType: TAmmoType; + end; + + +resourcestring + errmsgCreateSurface = 'Error creating DirectDraw7 surface'; + errmsgNoDesc = 'Unknown error'; + errmsgTransparentSet = 'Error setting transparent color'; + errmsgDynamicVar = 'Error working with dynamic memory'; + errmsgUnknownCommand = 'Unknown command'; + errmsgUnknownVariable = 'Unknown variable'; + errmsgIncorrectUse = 'Incorrect use'; + errmsgShouldntRun = 'This program shouldn''t be run manually'; + + msgLoading = 'Loading '; + msgOK = 'ok'; + msgFailed = 'failed'; + msgGettingConfig = 'Getting game config...'; + +const + cAppName = 'hw'; + cAppTitle = 'hw'; + cNetProtoVersion = 1; + + rndfillstr = 'hw'; + + cTransparentColor: Cardinal = $000000; + + cMaxHHIndex = 9; + cMaxHHs = 20; + cHHSurfaceWidth = 512; + cHHSurfaceHeigth = 256; + + cHHHalfHeight = 11; + + cKeyMaxIndex = 322; + + cMaxCaptions = 4; + + cInactDelay = 1500; + + gfForts = $00000001; + + gstDrowning = $00000001; + gstHHDriven = $00000002; + gstMoving = $00000004; + gstAttacked = $00000008; + gstAttacking = $00000010; + gstCollision = $00000020; + gstHHChooseTarget = $00000040; + gstFalling = $00000080; + gstHHJumping = $00000100; + gsttmpFlag = $00000200; + gstOutOfHH = $00000400; + gstHHThinking = $00000800; + + gtsStartGame = 1; + + gm_Left = $00000001; + gm_Right = $00000002; + gm_Up = $00000004; + gm_Down = $00000008; + gm_Switch = $00000010; + gm_Attack = $00000020; + gm_LJump = $00000040; + gm_HJump = $00000080; + gm_Destroy= $00000100; + + cMaxSlot = 4; + cMaxSlotAmmo = 1; + + ammoprop_Timerable = $00000001; + ammoprop_Power = $00000002; + ammoprop_NeedTarget = $00000004; + ammoprop_ForwMsgs = $00000008; + ammoprop_AttackInFall = $00000010; + ammoprop_AttackInJump = $00000020; + AMMO_INFINITE = High(LongWord); + + capgrpStartGame = 0; + capgrpAmmoinfo = 1; + capgrpNetSay = 2; + + EXPLAllDamageInRadius = 1; + EXPLAutoSound = 2; + EXPLNoDamage = 4; + + cToggleConsoleKey = 39; + + NoPointX = Low(Integer); // константа для TargetPoint, показывает, что цель не указана + + cLandFileName = 'Land.bmp'; + cHHFileName = 'Hedgehog.png'; + cCHFileName = 'Crosshair.png'; + cThemeCFGFilename = 'theme.cfg'; + + Fontz: array[THWFont] of THHFont = ( + (Height: 12; + Name: 'UN1251N.TTF'), + (Height: 24; + Name: 'UN1251N.TTF') + ); + + Pathz: array[TPathType] of string[ 64] = ( + 'Data/', // ptData + 'Data/Graphics/', // ptGraphics + 'Data/Themes/', // ptThemes + 'Data/Themes/Default/', // ptThemeCurrent + 'Data/Teams/', // ptTeams + 'Data/Maps/', // ptMaps + 'Data/Maps/Current/', // ptMapCurrent + 'Data/Demos/', // ptDemos + 'Data/Sounds/', // ptSounds + 'Data/Graphics/Graves/', // ptGraves + 'Data/Fonts/', // ptFonts + 'Data/Forts/' // ptForts + ); + + StuffLoadData: array[TStuff] of record + FileName: String[31]; + Path : TPathType; + end = ( + (FileName: 'horizont.png'; Path: ptThemeCurrent ), // sHorizont + (FileName: 'Sky.png'; Path: ptThemeCurrent ), // sSky + (FileName: 'Console.png'; Path: ptGraphics ), // sConsoleBG + (FileName: 'PowerBar.png'; Path: ptGraphics ), // sPowerBar + (FileName: 'thinking.png'; Path: ptGraphics ) // sQuestion + ); + StuffPoz: array[TStuff] of TSDL_Rect = ( + (x: 0; y: 0; w: 512; h: 256), // sHorizont + (x: 512; y: 0; w: 64; h:1024), // sSky + (x: 256; y: 256; w: 256; h: 256), // sConsoleBG + (x: 256; y: 768; w: 256; h: 32), // sPowerBar + (x: 256; y: 512; w: 32; h: 32) // sQuestion + ); + SpritesData: array[TSprite] of record + FileName: String[31]; + Path : TPathType; + Surface : PSDL_Surface; + Width, Height: integer; + end = ( + (FileName: 'BlueWater.png'; Path: ptGraphics; Width: 256; Height: 48),// sprWater + (FileName: 'Clouds.png'; Path: ptGraphics; Width: 256; Height:128),// sprCloud + (FileName: 'Bomb.png'; Path: ptGraphics; Width: 16; Height: 16),// sprBomb + (FileName: 'BigDigits.png'; Path: ptGraphics; Width: 32; Height: 32),// sprBigDigit + (FileName: 'Frame.png'; Path: ptGraphics; Width: 4; Height: 32),// sprFrame + (FileName: 'Lag.png'; Path: ptGraphics; Width: 64; Height: 64),// sprLag + (FileName: 'Arrow.png'; Path: ptGraphics; Width: 16; Height: 16),// sprCursor + (FileName: 'Grenade.png'; Path: ptGraphics; Width: 32; Height: 32),// sprGrenade + (FileName: 'Targetp.png'; Path: ptGraphics; Width: 32; Height: 32),// sprTargetP + (FileName: 'UFO.png'; Path: ptGraphics; Width: 32; Height: 32),// sprUFO + (FileName:'SmokeTrace.png'; Path: ptGraphics; Width: 32; Height: 32),// sprSmokeTrace + (FileName: 'RopeHook.png'; Path: ptGraphics; Width: 32; Height: 32) // sprRopeHook + ); + Soundz: array[TSound] of record + FileName: String[31]; + Path : TPathType; + id : PMixChunk; + end = ( + (FileName: 'grenadeimpact.ogg'; Path: ptSounds ),// sndGrenadeImpact + (FileName: 'explosion.ogg'; Path: ptSounds ),// sndExplosion + (FileName: 'throwpowerup.ogg'; Path: ptSounds ),// sndThrowPowerUp + (FileName: 'throwrelease.ogg'; Path: ptSounds ),// sndThrowRelease + (FileName: 'splash.ogg'; Path: ptSounds ),// sndSplash + (FileName: 'shotgunreload.ogg'; Path: ptSounds ),// sndShotgunReload + (FileName: 'shotgunfire.ogg'; Path: ptSounds ),// sndShotgunFire + (FileName: 'graveimpact.ogg'; Path: ptSounds ) // sndGraveImpact + ); + + Ammoz: array [TAmmoType] of record + Name: string[32]; + Ammo: TAmmo; + Slot: Longword; + TimeAfterTurn: Longword; + end = ( + (Name: 'Grenade'; + Ammo: (Propz: ammoprop_Timerable or ammoprop_Power; + Count: AMMO_INFINITE; + NumPerTurn: 0; + Timer: 3000; + AmmoType: amGrenade); + Slot: 0; + TimeAfterTurn: 3000), + (Name: 'Bazooka'; + Ammo: (Propz: ammoprop_Power; + Count: AMMO_INFINITE; + NumPerTurn: 0; + Timer: 0; + AmmoType: amBazooka); + Slot: 1; + TimeAfterTurn: 3000), + (Name: 'UFO'; + Ammo: (Propz: ammoprop_Power or ammoprop_NeedTarget; + Count: 4; + NumPerTurn: 0; + Timer: 0; + AmmoType: amUFO); + Slot: 0; + TimeAfterTurn: 3000), + (Name: 'Shotgun'; + Ammo: (Propz: 0; + Count: AMMO_INFINITE; + NumPerTurn: 1; + Timer: 0; + AmmoType: amShotgun); + Slot: 2; + TimeAfterTurn: 3000), + (Name: 'Pneumatic pick'; + Ammo: (Propz: ammoprop_ForwMsgs or ammoprop_AttackInFall or ammoprop_AttackInJump; + Count: 2; + NumPerTurn: 0; + Timer: 0; + AmmoType: amPickHammer); + Slot: 3; + TimeAfterTurn: 0), + (Name: 'Skip turn'; + Ammo: (Propz: 0; + Count: AMMO_INFINITE; + NumPerTurn: 0; + Timer: 0; + AmmoType: amSkip); + Slot: 4; + TimeAfterTurn: 0), + (Name: 'Rope'; + Ammo: (Propz: ammoprop_ForwMsgs or ammoprop_AttackInFall or ammoprop_AttackInJump; + Count: 5; + NumPerTurn: 0; + Timer: 0; + AmmoType: amRope); + Slot: 3; + TimeAfterTurn: 0) + ); + + Resolutions: array[0..3] of String = ( + '640 480', + '800 600', + '1024 768', + '1280 1024' + ); + +implementation + +end. diff -r ffe4ad26a64c -r bcbd7adb4e4b hedgewars/uGame.pas --- a/hedgewars/uGame.pas Mon Aug 22 21:38:06 2005 +0000 +++ b/hedgewars/uGame.pas Tue Aug 23 16:17:53 2005 +0000 @@ -1,92 +1,92 @@ -(* - * Hedgewars, a worms-like game - * Copyright (c) 2004, 2005 Andrey Korotaev - * - * Distributed under the terms of the BSD-modified licence: - * - * Permission is hereby granted, free of charge, to any person obtaining a copy - * of this software and associated documentation files (the "Software"), to deal - * with the Software without restriction, including without limitation the - * rights to use, copy, modify, merge, publish, distribute, sublicense, and/or - * sell copies of the Software, and to permit persons to whom the Software is - * furnished to do so, subject to the following conditions: - * - * 1. Redistributions of source code must retain the above copyright notice, - * this list of conditions and the following disclaimer. - * 2. Redistributions in binary form must reproduce the above copyright notice, - * this list of conditions and the following disclaimer in the documentation - * and/or other materials provided with the distribution. - * 3. The name of the author may not be used to endorse or promote products - * derived from this software without specific prior written permission. - * - * THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR IMPLIED - * WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF - * MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO - * EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, - * SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, - * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; - * OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, - * WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR - * OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF - * ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. - *) - -unit uGame; -interface -uses SDLh; -{$INCLUDE options.inc} - -procedure DoGameTick(Lag: integer); - -//////////////////// - implementation -//////////////////// -uses uMisc, uConsts, uWorld, uKeys, uTeams, uIO, uAI, uGears; - -procedure DoGameTick(Lag: integer); -const SendEmptyPacketTicks: LongWord = 0; -var i: integer; -begin -if CurrentTeam.ExtDriven then - begin - if (GameType = gmtDemo) then - ProcessKbdDemo; - end - else begin - NetGetNextCmd; // на случай, если что-то сказано - if SendEmptyPacketTicks >= cSendEmptyPacketTime then - begin - SendIPC('+'); - SendEmptyPacketTicks:= 0 - end; - inc(SendEmptyPacketTicks, Lag) - end; - -if Lag > 100 then Lag:= 100; - -for i:= 1 to Lag do - if not CurrentTeam.ExtDriven then - begin - with CurrentTeam^ do - if Hedgehogs[CurrHedgehog].BotLevel <> 0 then ProcessBot; - ProcessGears - end else - begin - NetGetNextCmd; - if isInLag then - case GameType of - gmtNet: break; - gmtDemo: begin - SendIPC('q'); - GameState:= gsExit; - exit - end - end - else ProcessGears - end; -if not CurrentTeam.ExtDriven then isInLag:= false; - -MoveWorld -end; - -end. +(* + * Hedgewars, a worms-like game + * Copyright (c) 2004, 2005 Andrey Korotaev + * + * Distributed under the terms of the BSD-modified licence: + * + * Permission is hereby granted, free of charge, to any person obtaining a copy + * of this software and associated documentation files (the "Software"), to deal + * with the Software without restriction, including without limitation the + * rights to use, copy, modify, merge, publish, distribute, sublicense, and/or + * sell copies of the Software, and to permit persons to whom the Software is + * furnished to do so, subject to the following conditions: + * + * 1. Redistributions of source code must retain the above copyright notice, + * this list of conditions and the following disclaimer. + * 2. Redistributions in binary form must reproduce the above copyright notice, + * this list of conditions and the following disclaimer in the documentation + * and/or other materials provided with the distribution. + * 3. The name of the author may not be used to endorse or promote products + * derived from this software without specific prior written permission. + * + * THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR IMPLIED + * WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF + * MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO + * EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, + * SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, + * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; + * OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, + * WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR + * OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF + * ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + *) + +unit uGame; +interface +uses SDLh; +{$INCLUDE options.inc} + +procedure DoGameTick(Lag: integer); + +//////////////////// + implementation +//////////////////// +uses uMisc, uConsts, uWorld, uKeys, uTeams, uIO, uAI, uGears; + +procedure DoGameTick(Lag: integer); +const SendEmptyPacketTicks: LongWord = 0; +var i: integer; +begin +if CurrentTeam.ExtDriven then + begin + if (GameType = gmtDemo) then + ProcessKbdDemo; + end + else begin + NetGetNextCmd; // на случай, если что-то сказано + if SendEmptyPacketTicks >= cSendEmptyPacketTime then + begin + SendIPC('+'); + SendEmptyPacketTicks:= 0 + end; + inc(SendEmptyPacketTicks, Lag) + end; + +if Lag > 100 then Lag:= 100; + +for i:= 1 to Lag do + if not CurrentTeam.ExtDriven then + begin + with CurrentTeam^ do + if Hedgehogs[CurrHedgehog].BotLevel <> 0 then ProcessBot; + ProcessGears + end else + begin + NetGetNextCmd; + if isInLag then + case GameType of + gmtNet: break; + gmtDemo: begin + SendIPC('q'); + GameState:= gsExit; + exit + end + end + else ProcessGears + end; +if not CurrentTeam.ExtDriven then isInLag:= false; + +MoveWorld +end; + +end. diff -r ffe4ad26a64c -r bcbd7adb4e4b hedgewars/uGears.pas --- a/hedgewars/uGears.pas Mon Aug 22 21:38:06 2005 +0000 +++ b/hedgewars/uGears.pas Tue Aug 23 16:17:53 2005 +0000 @@ -1,508 +1,508 @@ -(* - * Hedgewars, a worms-like game - * Copyright (c) 2004, 2005 Andrey Korotaev - * - * Distributed under the terms of the BSD-modified licence: - * - * Permission is hereby granted, free of charge, to any person obtaining a copy - * of this software and associated documentation files (the "Software"), to deal - * with the Software without restriction, including without limitation the - * rights to use, copy, modify, merge, publish, distribute, sublicense, and/or - * sell copies of the Software, and to permit persons to whom the Software is - * furnished to do so, subject to the following conditions: - * - * 1. Redistributions of source code must retain the above copyright notice, - * this list of conditions and the following disclaimer. - * 2. Redistributions in binary form must reproduce the above copyright notice, - * this list of conditions and the following disclaimer in the documentation - * and/or other materials provided with the distribution. - * 3. The name of the author may not be used to endorse or promote products - * derived from this software without specific prior written permission. - * - * THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR IMPLIED - * WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF - * MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO - * EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, - * SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, - * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; - * OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, - * WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR - * OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF - * ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. - *) - -unit uGears; -interface -uses SDLh, uConsts; -{$INCLUDE options.inc} -const AllInactive: boolean = false; - -type PGear = ^TGear; - TGearStepProcedure = procedure (Gear: PGear); - TGear = record - NextGear, PrevGear: PGear; - Active: Boolean; - State : Cardinal; - X : Real; - Y : Real; - dX: Real; - dY: Real; - Kind : TGearType; - doStep: TGearStepProcedure; - HalfWidth, HalfHeight: integer; - Angle, Power : Cardinal; - DirAngle: real; - Timer : LongWord; - Elasticity: Real; - Friction : Real; - Message : Longword; - Hedgehog: pointer; - Health, Damage: LongWord; - CollIndex: Longword; - Tag: Longword; - end; - -function AddGear(X, Y: integer; Kind: TGearType; State: Cardinal; const dX: real=0.0; dY: real=0.0; Timer: LongWord=0): PGear; -procedure ProcessGears; -procedure SetAllToActive; -procedure SetAllHHToActive; -procedure DrawGears(Surface: PSDL_Surface); -procedure FreeGearsList; -procedure InitGears; -procedure AssignHHCoords; - -var CurAmmoGear: PGear = nil; - -implementation -uses uWorld, uMisc, uStore, uConsole, uSound, uTeams, uRandom, uCollisions, uLand; -var GearsList: PGear = nil; - RopePoints: record - Count: Longword; - HookAngle: integer; - ar: array[0..300] of record - X, Y: real; - dLen: real; - b: boolean; - end; - end; - -procedure DeleteGear(Gear: PGear); forward; -procedure doMakeExplosion(X, Y, Radius: integer; Mask: LongWord); forward; - -{$INCLUDE GSHandlers.inc} -{$INCLUDE HHHandlers.inc} - -const doStepHandlers: array[TGearType] of TGearStepProcedure = ( - doStepCloud, - doStepBomb, - doStepHedgehog, - doStepGrenade, - doStepHealthTag, - doStepGrave, - doStepUFO, - doStepShotgunShot, - doStepActionTimer, - doStepPickHammer, - doStepRope, - doStepSmokeTrace - ); - -function AddGear(X, Y: integer; Kind: TGearType; State: Cardinal; const dX: real=0.0; dY: real=0.0; Timer: LongWord=0): PGear; -begin -{$IFDEF DEBUGFILE}AddFileLog('AddGear: ('+inttostr(x)+','+inttostr(y)+')');{$ENDIF} -New(Result); -{$IFDEF DEBUGFILE}AddFileLog('AddGear: handle = '+inttostr(integer(Result)));{$ENDIF} -FillChar(Result^, sizeof(TGear), 0); -Result.X:= X; -Result.Y:= Y; -Result.Kind := Kind; -Result.State:= State; -Result.Active:= true; -Result.dX:= dX; -Result.dY:= dY; -Result.doStep:= doStepHandlers[Kind]; -Result.CollIndex:= High(Longword); -if CurrentTeam <> nil then - Result.Hedgehog:= @CurrentTeam.Hedgehogs[CurrentTeam.CurrHedgehog]; -case Kind of - gtAmmo_Bomb: begin - Result.HalfWidth:= 4; - Result.HalfHeight:= 4; - Result.Elasticity:= 0.6; - Result.Friction:= 0.995; - Result.Timer:= Timer - end; - gtHedgehog: begin - Result.HalfWidth:= 6; - Result.HalfHeight:= cHHHalfHeight; - Result.Elasticity:= 0.002; - Result.Friction:= 0.999; - end; -gtAmmo_Grenade: begin - Result.HalfWidth:= 4; - Result.HalfHeight:= 4; - end; - gtHealthTag: begin - Result.Timer:= 1500; - end; - gtGrave: begin - Result.HalfWidth:= 10; - Result.HalfHeight:= 10; - Result.Elasticity:= 0.6; - end; - gtUFO: begin - Result.HalfWidth:= 5; - Result.HalfHeight:= 2; - Result.Timer:= 500; - Result.Elasticity:= 0.9 - end; - gtShotgunShot: begin - Result.Timer:= 900; - Result.HalfWidth:= 2; - Result.HalfHeight:= 2 - end; - gtActionTimer: begin - Result.Timer:= Timer - end; - gtPickHammer: begin - Result.HalfWidth:= 10; - Result.HalfHeight:= 2; - Result.Timer:= 4000 - end; - gtSmokeTrace: begin - Result.Tag:= 8 - end; - gtRope: begin - Result.HalfWidth:= 3; - Result.HalfHeight:= 3; - Result.Friction:= 500; - RopePoints.Count:= 0; - end; - end; -if GearsList = nil then GearsList:= Result - else begin - GearsList.PrevGear:= Result; - Result.NextGear:= GearsList; - GearsList:= Result - end -end; - -procedure DeleteGear(Gear: PGear); -begin -if Gear.CollIndex < High(Longword) then DeleteCR(Gear); -if Gear.Kind = gtHedgehog then - if CurAmmoGear <> nil then - begin - {$IFDEF DEBUGFILE}AddFileLog('DeleteGear: Sending gm_Destroy, hh handle = '+inttostr(integer(Gear)));{$ENDIF} - Gear.Message:= gm_Destroy; - CurAmmoGear.Message:= gm_Destroy; - exit - end else PHedgehog(Gear.Hedgehog).Gear:= nil; -if CurAmmoGear = Gear then - CurAmmoGear:= nil; -if FollowGear = Gear then FollowGear:= nil; -{$IFDEF DEBUGFILE}AddFileLog('DeleteGear: handle = '+inttostr(integer(Gear)));{$ENDIF} -if Gear.NextGear <> nil then Gear.NextGear.PrevGear:= Gear.PrevGear; -if Gear.PrevGear <> nil then Gear.PrevGear.NextGear:= Gear.NextGear - else begin - GearsList:= Gear^.NextGear; - if GearsList <> nil then GearsList.PrevGear:= nil - end; -Dispose(Gear) -end; - -function CheckNoDamage: boolean; // returns TRUE in case of no damaged hhs -var Gear: PGear; -begin -Result:= true; -Gear:= GearsList; -while Gear <> nil do - begin - if Gear.Kind = gtHedgehog then - if Gear.Damage <> 0 then - begin - Result:= false; - if Gear.Health < Gear.Damage then Gear.Health:= 0 - else dec(Gear.Health, Gear.Damage); - AddGear(Round(Gear.X), Round(Gear.Y) - 32, gtHealthTag, Gear.Damage).Hedgehog:= Gear.Hedgehog; - RenderHealth(PHedgehog(Gear.Hedgehog)^); - - Gear.Damage:= 0 - end; - Gear:= Gear.NextGear - end; -end; - -procedure ProcessGears; -const delay: integer = cInactDelay; -var Gear, t: PGear; -{$IFDEF COUNTTICKS} - tickcntA, tickcntB: LongWord; -const cntSecTicks: LongWord = 0; -{$ENDIF} -begin -{$IFDEF COUNTTICKS} -asm - push eax - push edx - rdtsc - mov tickcntA, eax - mov tickcntB, edx - pop edx - pop eax -end; -{$ENDIF} -AllInactive:= true; -t:= GearsList; -while t<>nil do - begin - Gear:= t; - t:= Gear.NextGear; - if Gear.Active then Gear.doStep(Gear); - end; -if AllInactive then - if (delay > 0)and not isInMultiShoot then - begin - if delay = cInactDelay then SetAllToActive; - dec(delay) - end - else begin - delay:= cInactDelay; - if CheckNoDamage then - if isInMultiShoot then isInMultiShoot:= false - else ParseCommand('/nextturn'); - end; -if TurnTimeLeft > 0 then - if CurrentTeam <> nil then - if CurrentTeam.Hedgehogs[CurrentTeam.CurrHedgehog].Gear <> nil then - if ((CurrentTeam.Hedgehogs[CurrentTeam.CurrHedgehog].Gear.State and gstAttacking) = 0) - and not isInMultiShoot then dec(TurnTimeLeft); -inc(GameTicks); -{$IFDEF COUNTTICKS} -asm - push eax - push edx - rdtsc - sub eax, [tickcntA] - sbb edx, [tickcntB] - add [cntSecTicks], eax - pop edx - pop eax -end; -if (GameTicks and 1023) = 0 then - begin - cntTicks:= cntSecTicks shr 10; - {$IFDEF DEBUGFILE} - AddFileLog('<' + inttostr(cntTicks) + '>x1024 ticks'); - {$ENDIF} - cntSecTicks:= 0 - end; -{$ENDIF} -end; - -procedure SetAllToActive; -var t: PGear; -begin -AllInactive:= false; -t:= GearsList; -while t<>nil do - begin - t.Active:= true; - t:= t.NextGear - end -end; - -procedure SetAllHHToActive; -var t: PGear; -begin -AllInactive:= false; -t:= GearsList; -while t<>nil do - begin - if t.Kind = gtHedgehog then t.Active:= true; - t:= t.NextGear - end -end; - -procedure DrawGears(Surface: PSDL_Surface); -var Gear: PGear; - i: Longword; - - procedure DrawRopeLine(X1, Y1, X2, Y2: integer); - var i: integer; - t, k: real; - r: TSDL_Rect; - begin - if abs(X1 - X2) > abs(Y1 - Y2) then - begin - if X1 > X2 then - begin - i:= X1; - X1:= X2; - X2:= i; - i:= Y1; - Y1:= Y2; - Y2:= i - end; - k:= (Y2 - Y1) / (X2 - X1); - if X1 < 0 then - begin - t:= Y1 - 2 - k * X1; - X1:= 0 - end else t:= Y1 - 2; - if X2 > cScreenWidth then X2:= cScreenWidth; - r.x:= X1; - while r.x <= X2 do - begin - r.y:= round(t); - r.w:= 4; - r.h:= 4; - SDL_FillRect(Surface, @r, cWhiteColor); - t:= t + k*3; - inc(r.x, 3) - end; - end else - begin - if Y1 > Y2 then - begin - i:= X1; - X1:= X2; - X2:= i; - i:= Y1; - Y1:= Y2; - Y2:= i - end; - k:= (X2 - X1) / (Y2 - Y1); - if Y1 < 0 then - begin - t:= X1 - 2 - k * Y1; - Y1:= 0 - end else t:= X1 - 2; - if Y2 > cScreenHeight then Y2:= cScreenHeight; - r.y:= Y1; - while r.y <= Y2 do - begin - r.x:= round(t); - r.w:= 4; - r.h:= 4; - SDL_FillRect(Surface, @r, cWhiteColor); - t:= t + k*3; - inc(r.y, 3) - end; - end - end; - -begin -Gear:= GearsList; -while Gear<>nil do - begin - case Gear.Kind of - gtCloud: DrawSprite(sprCloud , Round(Gear.X) + WorldDx, Round(Gear.Y) + WorldDy, Gear.State, Surface); - gtAmmo_Bomb: DrawSprite(sprBomb , Round(Gear.X) - 8 + WorldDx, Round(Gear.Y) - 8 + WorldDy, trunc(Gear.DirAngle), Surface); - gtHedgehog: DrawHedgehog(Round(Gear.X) - 14 + WorldDx, Round(Gear.Y) - 18 + WorldDy, Sign(Gear.dX), - 0, PHedgehog(Gear.Hedgehog).visStepPos div 2, - Surface); - gtAmmo_Grenade: DrawSprite(sprGrenade , Round(Gear.X) - 16 + WorldDx, Round(Gear.Y) - 16 + WorldDy, DxDy2Angle32(Gear.dY, Gear.dX), Surface); - gtHealthTag: DrawCaption(Round(Gear.X) + WorldDx, Round(Gear.Y) + WorldDy, PHedgehog(Gear.Hedgehog).HealthTagRect, Surface, true); - gtGrave: DrawSpriteFromRect(PHedgehog(Gear.Hedgehog).Team.GraveRect, Round(Gear.X) + WorldDx - 16, Round(Gear.Y) + WorldDy - 16, 32, (GameTicks shr 7) and 7, Surface); - gtUFO: DrawSprite(sprUFO, Round(Gear.X) - 16 + WorldDx, Round(Gear.Y) - 16 + WorldDy, (GameTicks shr 7) mod 4, Surface); - gtSmokeTrace: if Gear.Tag < 8 then DrawSprite(sprSmokeTrace, Round(Gear.X) - 16 + WorldDx, Round(Gear.Y) - 16 + WorldDy, Gear.Tag, Surface); - gtRope: begin - DrawRopeLine(Round(Gear.X) + WorldDx, Round(Gear.Y) + WorldDy, - Round(PHedgehog(Gear.Hedgehog).Gear.X) + WorldDx, Round(PHedgehog(Gear.Hedgehog).Gear.Y) + WorldDy); - if RopePoints.Count > 0 then - begin - i:= 0; - while i < Pred(RopePoints.Count) do - begin - DrawRopeLine(Round(RopePoints.ar[i].X) + WorldDx, Round(RopePoints.ar[i].Y) + WorldDy, - Round(RopePoints.ar[Succ(i)].X) + WorldDx, Round(RopePoints.ar[Succ(i)].Y) + WorldDy); - inc(i) - end; - DrawRopeLine(Round(RopePoints.ar[i].X) + WorldDx, Round(RopePoints.ar[i].Y) + WorldDy, - Round(Gear.X) + WorldDx, Round(Gear.Y) + WorldDy); - DrawSprite(sprRopeHook, Round(RopePoints.ar[0].X) + WorldDx - 16, Round(RopePoints.ar[0].Y) + WorldDy - 16, RopePoints.HookAngle, Surface); - end else - DrawSprite(sprRopeHook, Round(Gear.X) - 16 + WorldDx, Round(Gear.Y) - 16 + WorldDy, DxDy2Angle32(Gear.dY, Gear.dX), Surface); - end; - end; - Gear:= Gear.NextGear - end; -end; - -procedure FreeGearsList; -var t, tt: PGear; -begin -tt:= GearsList; -GearsList:= nil; -while tt<>nil do - begin - t:= tt; - tt:= tt.NextGear; - try - Dispose(t) - except OutError(errmsgDynamicVar) end; - end; -end; - -procedure InitGears; -var i: integer; -begin -for i:= 0 to cCloudsNumber do AddGear( - cScreenWidth + i * ((cScreenWidth * 2 + 2304) div cCloudsNumber), -128, gtCloud, random(4), (0.5-random)*0.01); -AddGear(0, 0, gtActionTimer, gtsStartGame, 0, 0, 2000).Health:= 3; -end; - -procedure doMakeExplosion(X, Y, Radius: integer; Mask: LongWord); -var Gear: PGear; - dmg: integer; -begin -TargetPoint.X:= NoPointX; -{$IFDEF DEBUGFILE}if Radius > 3 then AddFileLog('Explosion: at (' + inttostr(x) + ',' + inttostr(y) + ')');{$ENDIF} -DrawExplosion(X, Y, Radius); -if (Mask and EXPLAutoSound)<>0 then PlaySound(sndExplosion); -if (Mask and EXPLNoDamage)<>0 then exit; -if (Mask and EXPLAllDamageInRadius)=0 then Radius:= Radius shl 1; -Gear:= GearsList; -while Gear <> nil do - begin - dmg:= Radius - Round(sqrt(sqr(Gear.X - X) + sqr(Gear.Y - Y))); - if dmg > 0 then - begin - dmg:= dmg shr 1; - case Gear.Kind of - gtHedgehog: begin - inc(Gear.Damage, dmg); - Gear.dX:= Gear.dX + dmg / 200 * sign(Gear.X - X); - Gear.dY:= Gear.dY + dmg / 200 * sign(Gear.Y - Y); - FollowGear:= Gear - end; - gtGrave: Gear.dY:= - dmg / 250; - end; - end; - Gear:= Gear.NextGear - end -end; - -procedure AssignHHCoords; -var Gear: PGear; - pX, pY: integer; -begin -Gear:= GearsList; -while Gear <> nil do - begin - if Gear.Kind = gtHedgehog then - begin - GetHHPoint(pX, pY); - Gear.X:= pX; - Gear.Y:= pY - end; - Gear:= Gear.NextGear - end -end; - -initialization - -finalization -FreeGearsList - -end. +(* + * Hedgewars, a worms-like game + * Copyright (c) 2004, 2005 Andrey Korotaev + * + * 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 ffe4ad26a64c -r bcbd7adb4e4b hedgewars/uIO.pas --- a/hedgewars/uIO.pas Mon Aug 22 21:38:06 2005 +0000 +++ b/hedgewars/uIO.pas Tue Aug 23 16:17:53 2005 +0000 @@ -1,208 +1,249 @@ -(* - * Hedgewars, a worms-like game - * Copyright (c) 2004, 2005 Andrey Korotaev - * - * Distributed under the terms of the BSD-modified licence: - * - * Permission is hereby granted, free of charge, to any person obtaining a copy - * of this software and associated documentation files (the "Software"), to deal - * with the Software without restriction, including without limitation the - * rights to use, copy, modify, merge, publish, distribute, sublicense, and/or - * sell copies of the Software, and to permit persons to whom the Software is - * furnished to do so, subject to the following conditions: - * - * 1. Redistributions of source code must retain the above copyright notice, - * this list of conditions and the following disclaimer. - * 2. Redistributions in binary form must reproduce the above copyright notice, - * this list of conditions and the following disclaimer in the documentation - * and/or other materials provided with the distribution. - * 3. The name of the author may not be used to endorse or promote products - * derived from this software without specific prior written permission. - * - * THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR IMPLIED - * WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF - * MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO - * EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, - * SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, - * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; - * OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, - * WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR - * OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF - * ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. - *) - -unit uIO; -interface -uses SDLh; -{$INCLUDE options.inc} - -const ipcPort: Word = 0; - -procedure SendIPC(s: shortstring); -procedure SendIPCAndWaitReply(s: shortstring); -procedure IPCCheckSock; -procedure InitIPC; -procedure CloseIPC; -procedure NetGetNextCmd; - -implementation -uses uConsole, uConsts, uWorld, uMisc; -const isPonged: boolean = false; -var IPCSock: PTCPSocket; - fds: PSDLNet_SocketSet; - - extcmd: array[word] of packed record - Time: LongWord; - case byte of - 1: (len: byte; - cmd: Char; - X, Y: integer;); - 2: (str: shortstring); - end; - cmdcurpos: integer = 0; - cmdendpos: integer = -1; - -procedure InitIPC; -var ipaddr: TIPAddress; -begin -WriteToConsole('Init SDL_Net... '); -SDLTry(SDLNet_Init = 0, true); -fds:= SDLNet_AllocSocketSet(1); -SDLTry(fds <> nil, true); -WriteLnToConsole(msgOK); -WriteToConsole('Establishing IPC connection... '); -SDLTry(SDLNet_ResolveHost(ipaddr, '127.0.0.1', ipcPort) = 0, true); -IPCSock:= SDLNet_TCP_Open(ipaddr); -SDLTry(IPCSock <> nil, true); -WriteLnToConsole(msgOK) -end; - -procedure CloseIPC; -begin -SDLNet_FreeSocketSet(fds); -SDLNet_TCP_Close(IPCSock); -SDLNet_Quit -end; - -procedure ParseIPCCommand(s: shortstring); -begin -case s[1] of - '!': isPonged:= true; - '?': SendIPC('!'); - 'e': ParseCommand(copy(s, 2, Length(s) - 1)); - 'E': OutError(copy(s, 2, Length(s) - 1), true); - 'W': OutError(copy(s, 2, Length(s) - 1), false); - 'T': case s[2] of - 'L': GameType:= gmtLocal; - 'D': GameType:= gmtDemo; - 'N': GameType:= gmtNet; - else OutError(errmsgIncorrectUse + ' IPC "T" :' + s[2], true) end; - else - inc(cmdendpos); - extcmd[cmdendpos].Time := PLongWord(@s[byte(s[0]) - 3])^; - extcmd[cmdendpos].str := s; - {$IFDEF DEBUGFILE}AddFileLog('IPC in: '+s[1]+' ticks '+inttostr(extcmd[cmdendpos].Time)+' at '+inttostr(cmdendpos));{$ENDIF} - dec(extcmd[cmdendpos].len, 4) - end -end; - -procedure IPCCheckSock; -const ss: string = ''; -var i: integer; - buf: array[0..255] of byte; - s: shortstring absolute buf; -begin -fds.numsockets:= 0; -SDLNet_AddSocket(fds, IPCSock); - -while SDLNet_CheckSockets(fds, 0) > 0 do - begin - i:= SDLNet_TCP_Recv(IPCSock, @buf[1], 255); - if i > 0 then - begin - buf[0]:= i; - ss:= ss + s; - while (Length(ss) > 1)and(Length(ss) > byte(ss[1])) do - begin - ParseIPCCommand(copy(ss, 2, byte(ss[1]))); - Delete(ss, 1, Succ(byte(ss[1]))) - end - end else OutError('IPC connection lost', true) - end; -end; - -procedure SendIPC(s: shortstring); -begin -//WriteLnToConsole(s); -if s[0]>#251 then s[0]:= #251; -PLongWord(@s[Succ(byte(s[0]))])^:= GameTicks; -{$IFDEF DEBUGFILE}AddFileLog('IPC send: '+s);{$ENDIF} -inc(s[0],4); -SDLNet_TCP_Send(IPCSock, @s, Succ(byte(s[0]))) -end; - -procedure SendIPCAndWaitReply(s: shortstring); -begin -SendIPC(s); -s:= '?'; -SDLNet_TCP_Send(IPCSock, @s, Succ(byte(s[0]))); -isPonged:= false; -repeat - IPCCheckSock; - SDL_Delay(1) -until isPonged -end; - -procedure NetGetNextCmd; -var tmpflag: boolean; -begin -while (cmdcurpos <= cmdendpos)and(extcmd[cmdcurpos].cmd = 's') do - begin - WriteLnToConsole('> ' + copy(extcmd[cmdcurpos].str, 2, Pred(extcmd[cmdcurpos].len))); - AddCaption('> ' + copy(extcmd[cmdcurpos].str, 2, Pred(extcmd[cmdcurpos].len)), $FFFFFF, capgrpNetSay); - inc(cmdcurpos) - end; - -if cmdcurpos <= cmdendpos then - if GameTicks > extcmd[cmdcurpos].Time then - outerror('oops, queue error. in buffer: '+extcmd[cmdcurpos].cmd+' ('+inttostr(GameTicks)+' > '+inttostr(extcmd[cmdcurpos].Time)+')', true); - -tmpflag:= true; -while (cmdcurpos <= cmdendpos)and(GameTicks = extcmd[cmdcurpos].Time) do - begin - case extcmd[cmdcurpos].cmd of - 'L': ParseCommand('/+left'); - 'l': ParseCommand('/-left'); - 'R': ParseCommand('/+right'); - 'r': ParseCommand('/-right'); - 'U': ParseCommand('/+up'); - 'u': ParseCommand('/-up'); - 'D': ParseCommand('/+down'); - 'd': ParseCommand('/-down'); - 'A': ParseCommand('/+attack'); - 'a': ParseCommand('/-attack'); - 'S': ParseCommand('/switch'); - 'j': ParseCommand('/ljump'); - 'J': ParseCommand('/hjump'); - 'N': begin - tmpflag:= false; - {$IFDEF DEBUGFILE}AddFileLog('got cmd "N": time '+inttostr(extcmd[cmdcurpos].Time)){$ENDIF} - end; - 'p': begin - TargetPoint.X:= extcmd[cmdcurpos].X; - TargetPoint.Y:= extcmd[cmdcurpos].Y; - ParseCommand('/put') - end; - 'P': begin - CursorPoint.X:= extcmd[cmdcurpos].X + WorldDx; - CursorPoint.Y:= extcmd[cmdcurpos].Y + WorldDy; - end; - '1'..'5': ParseCommand('/timer ' + extcmd[cmdcurpos].cmd); - #128..#131: ParseCommand('/slot ' + char(byte(extcmd[cmdcurpos].cmd) - 79)) - end; - inc(cmdcurpos) - end; -isInLag:= (cmdcurpos > cmdendpos) and tmpflag -end; - -end. +(* + * Hedgewars, a worms-like game + * Copyright (c) 2004, 2005 Andrey Korotaev + * + * Distributed under the terms of the BSD-modified licence: + * + * Permission is hereby granted, free of charge, to any person obtaining a copy + * of this software and associated documentation files (the "Software"), to deal + * with the Software without restriction, including without limitation the + * rights to use, copy, modify, merge, publish, distribute, sublicense, and/or + * sell copies of the Software, and to permit persons to whom the Software is + * furnished to do so, subject to the following conditions: + * + * 1. Redistributions of source code must retain the above copyright notice, + * this list of conditions and the following disclaimer. + * 2. Redistributions in binary form must reproduce the above copyright notice, + * this list of conditions and the following disclaimer in the documentation + * and/or other materials provided with the distribution. + * 3. The name of the author may not be used to endorse or promote products + * derived from this software without specific prior written permission. + * + * THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR IMPLIED + * WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF + * MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO + * EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, + * SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, + * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; + * OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, + * WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR + * OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF + * ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + *) + +unit uIO; +interface +uses SDLh; +{$INCLUDE options.inc} + +const ipcPort: Word = 0; + +procedure SendIPC(s: shortstring); +procedure SendIPCAndWaitReply(s: shortstring); +procedure IPCCheckSock; +procedure InitIPC; +procedure CloseIPC; +procedure NetGetNextCmd; +procedure LoadFortPoints(Fort: shortstring; isRight: boolean; Count: Longword); + +implementation +uses uConsole, uConsts, uWorld, uMisc, uRandom, uLand; +const isPonged: boolean = false; +var IPCSock: PTCPSocket; + fds: PSDLNet_SocketSet; + + extcmd: array[word] of packed record + Time: LongWord; + case byte of + 1: (len: byte; + cmd: Char; + X, Y: integer;); + 2: (str: shortstring); + end; + cmdcurpos: integer = 0; + cmdendpos: integer = -1; + +procedure InitIPC; +var ipaddr: TIPAddress; +begin +WriteToConsole('Init SDL_Net... '); +SDLTry(SDLNet_Init = 0, true); +fds:= SDLNet_AllocSocketSet(1); +SDLTry(fds <> nil, true); +WriteLnToConsole(msgOK); +WriteToConsole('Establishing IPC connection... '); +SDLTry(SDLNet_ResolveHost(ipaddr, '127.0.0.1', ipcPort) = 0, true); +IPCSock:= SDLNet_TCP_Open(ipaddr); +SDLTry(IPCSock <> nil, true); +WriteLnToConsole(msgOK) +end; + +procedure CloseIPC; +begin +SDLNet_FreeSocketSet(fds); +SDLNet_TCP_Close(IPCSock); +SDLNet_Quit +end; + +procedure ParseIPCCommand(s: shortstring); +begin +case s[1] of + '!': isPonged:= true; + '?': SendIPC('!'); + 'e': ParseCommand(copy(s, 2, Length(s) - 1)); + 'E': OutError(copy(s, 2, Length(s) - 1), true); + 'W': OutError(copy(s, 2, Length(s) - 1), false); + 'T': case s[2] of + 'L': GameType:= gmtLocal; + 'D': GameType:= gmtDemo; + 'N': GameType:= gmtNet; + else OutError(errmsgIncorrectUse + ' IPC "T" :' + s[2], true) end; + else + inc(cmdendpos); + extcmd[cmdendpos].Time := PLongWord(@s[byte(s[0]) - 3])^; + extcmd[cmdendpos].str := s; + {$IFDEF DEBUGFILE}AddFileLog('IPC in: '+s[1]+' ticks '+inttostr(extcmd[cmdendpos].Time)+' at '+inttostr(cmdendpos));{$ENDIF} + dec(extcmd[cmdendpos].len, 4) + end +end; + +procedure IPCCheckSock; +const ss: string = ''; +var i: integer; + buf: array[0..255] of byte; + s: shortstring absolute buf; +begin +fds.numsockets:= 0; +SDLNet_AddSocket(fds, IPCSock); + +while SDLNet_CheckSockets(fds, 0) > 0 do + begin + i:= SDLNet_TCP_Recv(IPCSock, @buf[1], 255); + if i > 0 then + begin + buf[0]:= i; + ss:= ss + s; + while (Length(ss) > 1)and(Length(ss) > byte(ss[1])) do + begin + ParseIPCCommand(copy(ss, 2, byte(ss[1]))); + Delete(ss, 1, Succ(byte(ss[1]))) + end + end else OutError('IPC connection lost', true) + end; +end; + +procedure SendIPC(s: shortstring); +begin +//WriteLnToConsole(s); +if s[0]>#251 then s[0]:= #251; +PLongWord(@s[Succ(byte(s[0]))])^:= GameTicks; +{$IFDEF DEBUGFILE}AddFileLog('IPC send: '+s);{$ENDIF} +inc(s[0],4); +SDLNet_TCP_Send(IPCSock, @s, Succ(byte(s[0]))) +end; + +procedure SendIPCAndWaitReply(s: shortstring); +begin +SendIPC(s); +s:= '?'; +SDLNet_TCP_Send(IPCSock, @s, Succ(byte(s[0]))); +isPonged:= false; +repeat + IPCCheckSock; + SDL_Delay(1) +until isPonged +end; + +procedure NetGetNextCmd; +var tmpflag: boolean; +begin +while (cmdcurpos <= cmdendpos)and(extcmd[cmdcurpos].cmd = 's') do + begin + WriteLnToConsole('> ' + copy(extcmd[cmdcurpos].str, 2, Pred(extcmd[cmdcurpos].len))); + AddCaption('> ' + copy(extcmd[cmdcurpos].str, 2, Pred(extcmd[cmdcurpos].len)), $FFFFFF, capgrpNetSay); + inc(cmdcurpos) + end; + +if cmdcurpos <= cmdendpos then + if GameTicks > extcmd[cmdcurpos].Time then + outerror('oops, queue error. in buffer: '+extcmd[cmdcurpos].cmd+' ('+inttostr(GameTicks)+' > '+inttostr(extcmd[cmdcurpos].Time)+')', true); + +tmpflag:= true; +while (cmdcurpos <= cmdendpos)and(GameTicks = extcmd[cmdcurpos].Time) do + begin + case extcmd[cmdcurpos].cmd of + 'L': ParseCommand('/+left'); + 'l': ParseCommand('/-left'); + 'R': ParseCommand('/+right'); + 'r': ParseCommand('/-right'); + 'U': ParseCommand('/+up'); + 'u': ParseCommand('/-up'); + 'D': ParseCommand('/+down'); + 'd': ParseCommand('/-down'); + 'A': ParseCommand('/+attack'); + 'a': ParseCommand('/-attack'); + 'S': ParseCommand('/switch'); + 'j': ParseCommand('/ljump'); + 'J': ParseCommand('/hjump'); + 'N': begin + tmpflag:= false; + {$IFDEF DEBUGFILE}AddFileLog('got cmd "N": time '+inttostr(extcmd[cmdcurpos].Time)){$ENDIF} + end; + 'p': begin + TargetPoint.X:= extcmd[cmdcurpos].X; + TargetPoint.Y:= extcmd[cmdcurpos].Y; + ParseCommand('/put') + end; + 'P': begin + CursorPoint.X:= extcmd[cmdcurpos].X + WorldDx; + CursorPoint.Y:= extcmd[cmdcurpos].Y + WorldDy; + end; + '1'..'5': ParseCommand('/timer ' + extcmd[cmdcurpos].cmd); + #128..#131: ParseCommand('/slot ' + char(byte(extcmd[cmdcurpos].cmd) - 79)) + end; + inc(cmdcurpos) + end; +isInLag:= (cmdcurpos > cmdendpos) and tmpflag +end; + +procedure LoadFortPoints(Fort: shortstring; isRight: boolean; Count: Longword); +const cMAXFORTPOINTS = 20; +var f: textfile; + i, t: integer; + cnt: Longword; + ar: array[0..Pred(cMAXFORTPOINTS)] of TPoint; + p: TPoint; +begin +if isRight then Fort:= Pathz[ptForts] + Fort + 'R.txt' + else Fort:= Pathz[ptForts] + Fort + 'L.txt'; +WriteToConsole(msgLoading + Fort + ' '); +{$I-} +AssignFile(f, Fort); +Reset(f); +cnt:= 0; +while not (eof(f) or (cnt = cMAXFORTPOINTS)) do + begin + Readln(f, ar[cnt].x, ar[cnt].y); + if isRight then inc(ar[cnt].x, 1024); + inc(cnt); + end; +Closefile(f); +{$I+} +TryDo(IOResult = 0, msgFailed, true); +WriteLnToConsole(msgOK); +TryDo(Count < cnt, 'Fort doesn''t contain needed spawn points', true); +for i:= 0 to Pred(cnt) do + begin + t:= GetRandom(cnt); + if i <> t then + begin + p:= ar[i]; + ar[i]:= ar[t]; + ar[t]:= p + end + end; +for i:= 0 to Pred(Count) do + AddHHPoint(ar[i].x, ar[i].y); +end; + +end. diff -r ffe4ad26a64c -r bcbd7adb4e4b hedgewars/uKeys.pas --- a/hedgewars/uKeys.pas Mon Aug 22 21:38:06 2005 +0000 +++ b/hedgewars/uKeys.pas Tue Aug 23 16:17:53 2005 +0000 @@ -1,128 +1,128 @@ -(* - * Hedgewars, a worms-like game - * Copyright (c) 2004, 2005 Andrey Korotaev - * - * Distributed under the terms of the BSD-modified licence: - * - * Permission is hereby granted, free of charge, to any person obtaining a copy - * of this software and associated documentation files (the "Software"), to deal - * with the Software without restriction, including without limitation the - * rights to use, copy, modify, merge, publish, distribute, sublicense, and/or - * sell copies of the Software, and to permit persons to whom the Software is - * furnished to do so, subject to the following conditions: - * - * 1. Redistributions of source code must retain the above copyright notice, - * this list of conditions and the following disclaimer. - * 2. Redistributions in binary form must reproduce the above copyright notice, - * this list of conditions and the following disclaimer in the documentation - * and/or other materials provided with the distribution. - * 3. The name of the author may not be used to endorse or promote products - * derived from this software without specific prior written permission. - * - * THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR IMPLIED - * WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF - * MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO - * EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, - * SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, - * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; - * OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, - * WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR - * OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF - * ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. - *) - -unit uKeys; -interface -{$INCLUDE options.inc} - -function KeyNameToCode(name: string): word; -procedure ProcessKbd; -procedure ResetKbd; -procedure ProcessKbdDemo; -procedure InitKbdKeyTable; - -implementation -uses SDLh, uTeams, uConsole, uConsts, uMisc; - -type TKeyboardState = array[0..322] of Byte; -var tkbd: TKeyboardState; - KeyNames: array [0..cKeyMaxIndex] of string[15]; - -function KeyNameToCode(name: string): word; -begin -Result:= cKeyMaxIndex; -while (Result>0)and(KeyNames[Result]<>name) do dec(Result) -end; - -procedure ProcessKbd; -var i: integer; - s: shortstring; - pkbd: PByteArray; -begin -if (CurrentTeam = nil) - or (CurrentTeam.ExtDriven) - or (CurrentTeam.Hedgehogs[CurrentTeam.CurrHedgehog].BotLevel <> 0) then exit; -pkbd:= SDL_GetKeyState(nil); -i:= SDL_GetMouseState(nil, nil); -pkbd^[1]:= (i and 1); -pkbd^[2]:= ((i shl 1) and 1); -pkbd^[3]:= ((i shl 2) and 1); -for i:= 1 to cKeyMaxIndex do - if CurrentTeam.Aliases[i][0]<>#0 then - begin - if CurrentTeam.Aliases[i][1]='+' then - begin - if (pkbd^[i] <> 0)and(tkbd[i] = 0) then ParseCommand(CurrentTeam.Aliases[i]) else - if (pkbd^[i] = 0)and(tkbd[i] <> 0) then - begin - s:= CurrentTeam.Aliases[i]; - s[1]:= '-'; - ParseCommand(s) - end; - end else - if (tkbd[i] = 0) and (pkbd^[i] <> 0) then ParseCommand(CurrentTeam.Aliases[i]); - tkbd[i]:= pkbd^[i] - end -end; - -procedure ProcessKbdDemo; -var pkbd: PByteArray; -begin -pkbd:= PByteArray(SDL_GetKeyState(nil)); -if pkbd^[27] <> 0 then - begin - ParseCommand('/quit'); - end; -end; - -procedure ResetKbd; -var i, t: integer; - pkbd: PByteArray; -begin -pkbd:= PByteArray(SDL_GetKeyState(@i)); -for t:= 0 to Pred(i) do - tkbd[i]:= pkbd^[i] -end; - -procedure InitKbdKeyTable; -var i, t: integer; - s: string[15]; -begin -KeyNames[1]:= 'mousel'; -KeyNames[2]:= 'mousem'; -KeyNames[3]:= 'mouser'; -for i:= 4 to cKeyMaxIndex do - begin - s:= SDL_GetKeyName(i); - if s = 'unknown key' then KeyNames[i]:= '' - else begin - for t:= 1 to Length(s) do - if s[t] = ' ' then s[t]:= '_'; - KeyNames[i]:= s - end; - end -end; - -initialization - -end. +(* + * Hedgewars, a worms-like game + * Copyright (c) 2004, 2005 Andrey Korotaev + * + * 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 ffe4ad26a64c -r bcbd7adb4e4b hedgewars/uLand.pas --- a/hedgewars/uLand.pas Mon Aug 22 21:38:06 2005 +0000 +++ b/hedgewars/uLand.pas Tue Aug 23 16:17:53 2005 +0000 @@ -1,502 +1,503 @@ -(* - * Hedgewars, a worms-like game - * Copyright (c) 2005 Andrey Korotaev - * - * 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. +(* + * 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, uIO; + +type TPixAr = record + Count: Longword; + ar: array[word] of TPoint; + end; + +var HHPoints: record + First, Last: word; + ar: array[1..Pred(cMaxHHs)] of TPoint + end = (First: 1); + +procedure BlitImageAndGenerateCollisionInfo(cpX, cpY: Longword; Image, Surface: PSDL_Surface); +var i, p: LongWord; + x, y: Longword; + bpp: integer; + r: TSDL_Rect; +begin +r.x:= cpX; +r.y:= cpY; +SDL_UpperBlit(Image, nil, Surface, @r); +WriteToConsole('Generating collision info... '); + +if SDL_MustLock(Image) then + SDLTry(SDL_LockSurface(Image) >= 0, true); + +bpp:= Image.format.BytesPerPixel; +WriteToConsole('('+inttostr(bpp)+') '); +p:= LongWord(Image.pixels); +case bpp of + 1: OutError('We don''t work with 8 bit surfaces', true); + 2: for y:= 0 to Pred(Image.h) do + begin + i:= Longword(@Land[cpY + y, cpX]); + for x:= 0 to Pred(Image.w) do + if PWord(p + x * 2)^ = 0 then PLongWord(i + x * 4)^:= 0 + else PLongWord(i + x * 4)^:= 1; + inc(p, Image.pitch); + end; + 3: for y:= 0 to Pred(Image.h) do + begin + i:= Longword(@Land[cpY + y, cpX]); + for x:= 0 to Pred(Image.w) do + if (PByte(p + x * 3 + 0)^ = 0) + and (PByte(p + x * 3 + 1)^ = 0) + and (PByte(p + x * 3 + 2)^ = 0) then PLongWord(i + x * 4)^:= 0 + else PLongWord(i + x * 4)^:= 1; + inc(p, Image.pitch); + end; + 4: for y:= 0 to Pred(Image.h) do + begin + i:= Longword(@Land[cpY + y, cpX]); + for x:= 0 to Pred(Image.w) do + if PLongword(p + x * 4)^ = 0 then PLongWord(i + x * 4)^:= 0 + else PLongWord(i + x * 4)^:= 1; + inc(p, Image.pitch); + end; + end; +if SDL_MustLock(Image) then + SDL_UnlockSurface(Image); +WriteLnToConsole(msgOK) +end; + +procedure GenEdge(out pa: TPixAr); +var angle, r: real; + len1: Longword; +begin +len1:= 0; +angle:= 5*pi/6; +r:= 410; +repeat + angle:= angle + 0.1 + getrandom * 0.1; + pa.ar[len1].X:= 544 + trunc(r*cos(angle)); + pa.ar[len1].Y:= 1080 + trunc(1.5*r*sin(angle)); + if r<380 then r:= r+getrandom*110 + else r:= r - getrandom*80; + inc(len1); +until angle > 7/4*pi; + +angle:= -pi/6; +r:= 510; +pa.ar[len1].X:= 644 + trunc(r*cos(angle)); +pa.ar[len1].Y:= 1080 + trunc(r*sin(angle)); +angle:= -pi; + +repeat + angle:= angle + 0.1 + getrandom*0.1; + pa.ar[len1].X:= 1504 + trunc(r*cos(angle)); + pa.ar[len1].Y:= 880 + trunc(1.5*r*sin(angle)); + if r<410 then r:= r + getrandom*80 + else r:= r - getrandom*110; + inc(len1); +until angle > 1/4*pi; +pa.ar[len1]:= pa.ar[0]; +pa.Count:= Succ(len1) +end; + +procedure DrawBezierBorder(var pa: TPixAr); +var x, y, i: integer; + tx, ty, vx, vy, vlen, t: real; + r1, r2, r3, r4: real; + x1, y1, x2, y2, cx1, cy1, cx2, cy2, tsq, tcb: real; +begin +vx:= 0; +vy:= 0; +with pa do +for i:= 0 to Count-2 do + begin + vlen:= sqrt(sqr(ar[i + 1].x - ar[i ].X) + sqr(ar[i + 1].y - ar[i ].y)); + t:= sqrt(sqr(ar[i + 1].x - ar[i + 2].X) + sqr(ar[i + 1].y - ar[i + 2].y)); + if t 1023) then exit; + with Stack.points[Stack.Count] do + begin + xl:= _xl; + xr:= _xr; + y:= _y; + dir:= _dir + end; + inc(Stack.Count); + TryDo(Stack.Count < 8192, 'stack overflow', true) + end; + + procedure Pop(out _xl, _xr, _y, _dir: integer); + begin + dec(Stack.Count); + with Stack.points[Stack.Count] do + begin + _xl:= xl; + _xr:= xr; + _y:= y; + _dir:= dir + end + end; + +var xl, xr, dir: integer; +begin +Stack.Count:= 0; +xl:= x - 1; +xr:= x; +Push(xl, xr, 1024, -1); +while Stack.Count > 0 do + begin + Pop(xl, xr, y, dir); + while (xl > 0) and (Land[y, xl] = 0) do dec(xl); + while (xr < 2047) and (Land[y, xr] = 0) do inc(xr); + while (xl < xr) do + begin + while (xl <= xr) and (Land[y, xl] <> 0) do inc(xl); + x:= xl; + while (xl <= xr) and (Land[y, xl] = 0) do + begin + Land[y, xl]:= $FFFFFF; + inc(xl) + end; + if x < xl then Push(x, Pred(xl), y, dir) + end; + end; +end; + +procedure ColorizeLand(Surface: PSDL_Surface); +var tmpsurf: PSDL_Surface; + r: TSDL_Rect; +begin +tmpsurf:= LoadImage(Pathz[ptThemeCurrent] + 'LandTex.png'); +r.y:= 0; +while r.y < 1024 do + begin + r.x:= 0; + while r.x < 2048 do + begin + SDL_UpperBlit(tmpsurf, nil, Surface, @r); + inc(r.x, tmpsurf.w) + end; + inc(r.y, tmpsurf.h) + end; +SDL_FreeSurface(tmpsurf); + +tmpsurf:= SDL_CreateRGBSurfaceFrom(@Land, 2048, 1024, 32, 2048*4, $FF0000, $FF00, $FF, 0); +SDLTry(tmpsurf <> nil, true); +SDL_SetColorKey(tmpsurf, SDL_SRCCOLORKEY, SDL_MapRGB(tmpsurf.format, $FF, $FF, $FF)); +SDL_UpperBlit(tmpsurf, nil, Surface, nil) +end; + +procedure AddBorder(Surface: PSDL_Surface); +var tmpsurf: PSDL_Surface; + r, rr: TSDL_Rect; + x, yd, yu: integer; +begin +tmpsurf:= LoadImage(Pathz[ptThemeCurrent] + 'Border.png'); +for x:= 0 to 2047 do + begin + yd:= 1023; + repeat + while (yd > 0 ) and (Land[yd, x] = 0) do dec(yd); + if (yd < 0) then yd:= 0; + while (yd < 1024) and (Land[yd, x] <> 0) do inc(yd); + dec(yd); + yu:= yd; + while (yu > 0 ) and (Land[yu, x] <> 0) do dec(yu); + while (yu < yd ) and (Land[yu, x] = 0) do inc(yu); + if (yd < 1023) and ((yd - yu) >= 16) then + begin + rr.x:= x; + rr.y:= yd - 15; + r.x:= x mod tmpsurf.w; + r.y:= 16; + r.w:= 1; + r.h:= 16; + SDL_UpperBlit(tmpsurf, @r, Surface, @rr); + end; + if (yu > 0) then + begin + rr.x:= x; + rr.y:= yu; + r.x:= x mod tmpsurf.w; + r.y:= 0; + r.w:= 1; + r.h:= min(16, yd - yu + 1); + SDL_UpperBlit(tmpsurf, @r, Surface, @rr); + end; + yd:= yu - 1; + until yd < 0; + end; +end; + +procedure AddGirders(Surface: PSDL_Surface); +var tmpsurf: PSDL_Surface; + x1, x2, y, k, i: integer; + r, rr: TSDL_Rect; + + function CountZeroz(x, y: integer): Longword; + var i: integer; + begin + Result:= 0; + for i:= y to y + 15 do + if Land[i, x] <> 0 then inc(Result) + end; + +begin +y:= 256; +repeat + inc(y, 24); + x1:= 1024; + x2:= 1024; + while (x1 > 100) and (CountZeroz(x1, y) = 0) do dec(x1, 2); + i:= x1 - 12; + repeat + k:= CountZeroz(x1, y); + dec(x1, 2) + until (x1 < 100) or (k = 0) or (k = 16) or (x1 < i); + inc(x1, 2); + if k = 16 then + begin + while (x2 < 1900) and (CountZeroz(x2, y) = 0) do inc(x2, 2); + i:= x2 + 12; + repeat + k:= CountZeroz(x2, y); + inc(x2, 2) + until (x2 > 1900) or (k = 0) or (k = 16) or (x2 > i); + if (x2 < 1900) and (k = 16) and (x2 - x1 > 250) then break; + end; +x1:= 0; +until y > 900; +if x1 > 0 then + begin + tmpsurf:= LoadImage(Pathz[ptGraphics] + 'Girder.png'); + rr.x:= x1; + rr.y:= y; + while rr.x + 100 < x2 do + begin + SDL_UpperBlit(tmpsurf, nil, Surface, @rr); + inc(rr.x, 100); + end; + r.x:= 0; + r.y:= 0; + r.w:= x2 - rr.x; + r.h:= 16; + SDL_UpperBlit(tmpsurf, @r, Surface, @rr); + SDL_FreeSurface(tmpsurf); + for k:= y to y + 15 do + for i:= x1 to x2 do Land[k, i]:= $FFFFFF + end +end; + +procedure AddHHPoints; +var i, x, y: integer; +begin +for i:= 0 to 9 do + begin + y:= 0; + x:= i * 160 + 300; + repeat + inc(y, 2); + until (y > 1023) or (Land[y, x - 6] <> 0) or (Land[y, x - 3] <> 0) or (Land[y, x] <> 0) + or (Land[y, x + 3] <> 0) or (Land[y, x + 6] <> 0); + AddHHPoint(x, y - 12) + end; +end; + +procedure GenLandSurface; +var pa: TPixAr; + tmpsurf: PSDL_Surface; +begin +GenEdge(pa); +DrawBezierBorder(pa); +FillLand(1023, 1023); +AddProgress; +with PixelFormat^ do + tmpsurf:= SDL_CreateRGBSurface(SDL_HWSURFACE, 2048, 1024, BitsPerPixel, RMask, GMask, BMask, 0); +ColorizeLand(tmpsurf); +AddProgress; +AddBorder(tmpsurf); +with PixelFormat^ do + LandSurface:= SDL_CreateRGBSurface(SDL_HWSURFACE, 2048, 1024, BitsPerPixel, RMask, GMask, BMask, 0); +SDL_FillRect(LandSurface, nil, 0); +AddGirders(LandSurface); +SDL_SetColorKey(tmpsurf, SDL_SRCCOLORKEY, 0); +SDL_UpperBlit(tmpsurf, nil, LandSurface, nil); +SDL_FreeSurface(tmpsurf); +AddProgress; +AddHHPoints; +RandomizeHHPoints; +end; + +procedure MakeFortsMap; +var p: PTeam; + tmpsurf: PSDL_Surface; +begin +p:= TeamsList; +TryDo(p <> nil, 'No teams on map!', true); +with PixelFormat^ do + LandSurface:= SDL_CreateRGBSurface(SDL_HWSURFACE, 2048, 1024, BitsPerPixel, RMask, GMask, BMask, 0); +tmpsurf:= LoadImage(Pathz[ptForts] + p.FortName + 'L.png'); +BlitImageAndGenerateCollisionInfo(0, 0, tmpsurf, LandSurface); +SDL_FreeSurface(tmpsurf); +LoadFortPoints(p.FortName, false, TeamSize(p)); +p:= p.Next; +TryDo(p <> nil, 'Only one team on map!', true); +tmpsurf:= LoadImage(Pathz[ptForts] + p.FortName + 'R.png'); +BlitImageAndGenerateCollisionInfo(1024, 0, tmpsurf, LandSurface); +SDL_FreeSurface(tmpsurf); +LoadFortPoints(p.FortName, true, TeamSize(p)); +p:= p.Next; +TryDo(p = nil, 'More than 2 teams on map in forts mode!', true); +end; + +procedure AddHHPoint(_x, _y: integer); +begin +with HHPoints do + begin + inc(Last); + TryDo(Last < cMaxHHs, 'HHs coords queue overflow', true); + with ar[Last] do + begin + x:= _x; + y:= _y + end + end +end; + +procedure GetHHPoint(out _x, _y: integer); +begin +with HHPoints do + begin + TryDo(First <= Last, 'HHs coords queue underflow ' + inttostr(First), true); + with ar[First] do + begin + _x:= x; + _y:= y + end; + inc(First) + end +end; + +procedure RandomizeHHPoints; +var i, t: integer; + p: TPoint; +begin +with HHPoints do + begin + for i:= First to Last do + begin + t:= GetRandom(Last - First + 1) + First; + if i <> t then + begin + p:= ar[i]; + ar[i]:= ar[t]; + ar[t]:= p + end + end + end +end; + +end. diff -r ffe4ad26a64c -r bcbd7adb4e4b hedgewars/uMisc.pas --- a/hedgewars/uMisc.pas Mon Aug 22 21:38:06 2005 +0000 +++ b/hedgewars/uMisc.pas Tue Aug 23 16:17:53 2005 +0000 @@ -1,210 +1,210 @@ -(* - * Hedgewars, a worms-like game - * Copyright (c) 2004, 2005 Andrey Korotaev - * - * Distributed under the terms of the BSD-modified licence: - * - * Permission is hereby granted, free of charge, to any person obtaining a copy - * of this software and associated documentation files (the "Software"), to deal - * with the Software without restriction, including without limitation the - * rights to use, copy, modify, merge, publish, distribute, sublicense, and/or - * sell copies of the Software, and to permit persons to whom the Software is - * furnished to do so, subject to the following conditions: - * - * 1. Redistributions of source code must retain the above copyright notice, - * this list of conditions and the following disclaimer. - * 2. Redistributions in binary form must reproduce the above copyright notice, - * this list of conditions and the following disclaimer in the documentation - * and/or other materials provided with the distribution. - * 3. The name of the author may not be used to endorse or promote products - * derived from this software without specific prior written permission. - * - * THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR IMPLIED - * WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF - * MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO - * EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, - * SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, - * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; - * OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, - * WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR - * OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF - * ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. - *) - -unit uMisc; -interface -uses uConsts, SDLh; -{$INCLUDE options.inc} -var isCursorVisible : boolean = false; - isTerminated : boolean = false; - isInLag : boolean = false; - isSoundEnabled : boolean = true; - isInMultiShoot : boolean = false; - - GameState : TGameState = gsLandGen; - GameType : TGameType = gmtLocal; - GameFlags : Longword = 0; - TurnTimeLeft : Longword = 0; - cHedgehogTurnTime: Longword = 30000; - - cLandYShift : integer = 888; - cCloudsNumber : integer = 9; - cConsoleHeight : integer = 320; - cConsoleYAdd : integer = 0; - cTimerInterval : Cardinal = 15; - cScreenWidth : integer = 1024; - cScreenHeight : integer = 768; - cBits : integer = 16; - cWaterLine : integer = 1024; - cVisibleWater : integer = 64; - cScreenEdgesDist : integer = 240; - - GameTicks : LongWord = 0; - - cSkyColor : Cardinal = 0; - cWaterColor : Cardinal = $32397A; - cMapBackColor : Cardinal = $FFFFFF; - cWhiteColor : Cardinal = $FFFFFF; - cConsoleSplitterColor : Cardinal = $FF0000; - cColorNearBlack : Cardinal = 16; - cExplosionBorderColor : LongWord = $808080; - - cDrownSpeed : Real = 0.06; - cMaxWindSpeed : Real = 0.0003; - cWindSpeed : Real = 0.0001; - cGravity : Real = 0.0005; - - cShowFPS : boolean = true; - cFullScreen : boolean = true; - -const - cMaxPower = 1500; - cMaxAngle = 2048; - cPowerDivisor = 1500; - -var - cSendEmptyPacketTime : LongWord = 2000; - cSendCursorPosTime : LongWord = 50; - - flagMakeCapture: boolean = false; - - AttackBar : integer = 0; // 0 - отсутствует, 1 - внизу, 2 - как в wwp - -function Sign(r: real): integer; -function Min(a, b: integer): integer; -function Max(a, b: integer): integer; -procedure OutError(Msg: String; const isFatalError: boolean=false); -procedure TryDo(Assert: boolean; Msg: string; isFatal: boolean); -procedure SDLTry(Assert: boolean; isFatal: boolean); -function IntToStr(n: integer): shortstring; -function FloatToStr(n: real): shortstring; -function arctan(const Y, X: real): real; -function DxDy2Angle32(const _dY, _dX: Extended): integer; -procedure AdjustColor(var Color: Longword); -{$IFDEF DEBUGFILE} -procedure AddFileLog(s: shortstring); -{$ENDIF} - -var CursorPoint: TPoint; - TargetPoint: TPoint = (X: NoPointX; Y: 0); - -implementation -uses uConsole, uStore; -{$IFDEF DEBUGFILE} -var f: textfile; -{$ENDIF} - - -function Sign(r: real): integer; -begin -if r < 0 then Result:= -1 else Result:= 1 -end; - -function Min(a, b: integer): integer; -begin -if a < b then Result:= a else Result:= b -end; - -function Max(a, b: integer): integer; -begin -if a > b then Result:= a else Result:= b -end; - -procedure OutError(Msg: String; const isFatalError: boolean=false); -begin -{$IFDEF DEBUGFILE}AddFileLog(Msg);{$ENDIF} -if isFatalError then - begin - WriteLn(Msg); - SDL_Quit; - Readln; - halt(1) - end else WriteLnToConsole(Msg) -end; - -procedure TryDo(Assert: boolean; Msg: string; isFatal: boolean); -begin -if not Assert then OutError(msg, isFatal) -end; - -procedure SDLTry(Assert: boolean; isFatal: boolean); -begin -if not Assert then OutError(SDL_GetError, isFatal) -end; - -procedure AdjustColor(var Color: Cardinal); -begin -Color:= SDL_MapRGB(PixelFormat, (Color shr 16) and $FF, (Color shr 8) and $FF, Color and $FF) -end; - -function IntToStr(n: integer): shortstring; -begin -str(n, Result) -end; - -function FloatToStr(n: real): shortstring; -begin -str(n, Result) -end; - -function arctan(const Y, X: real): real; -asm - fld Y - fld X - fpatan - fwait -end; - -function DxDy2Angle32(const _dY, _dX: Extended): integer; -const piDIV32: Extended = pi/32; -asm - fld _dY - fld _dX - fpatan - fld piDIV32 - fdiv - sub esp, 4 - fistp dword ptr [esp] - pop eax - shr eax, 1 - and eax, $1F -end; - - -{$IFDEF DEBUGFILE} -procedure AddFileLog(s: shortstring); -begin -writeln(f, GameTicks: 6, ': ', s); -flush(f) -end; - -initialization -assignfile(f, 'debug.txt'); -rewrite(f); -finalization -writeln(f, '-= halt at ',GameTicks,' ticks =-'); -Flush(f); -closefile(f) -{$ENDIF} - -end. +(* + * Hedgewars, a worms-like game + * Copyright (c) 2004, 2005 Andrey Korotaev + * + * Distributed under the terms of the BSD-modified licence: + * + * Permission is hereby granted, free of charge, to any person obtaining a copy + * of this software and associated documentation files (the "Software"), to deal + * with the Software without restriction, including without limitation the + * rights to use, copy, modify, merge, publish, distribute, sublicense, and/or + * sell copies of the Software, and to permit persons to whom the Software is + * furnished to do so, subject to the following conditions: + * + * 1. Redistributions of source code must retain the above copyright notice, + * this list of conditions and the following disclaimer. + * 2. Redistributions in binary form must reproduce the above copyright notice, + * this list of conditions and the following disclaimer in the documentation + * and/or other materials provided with the distribution. + * 3. The name of the author may not be used to endorse or promote products + * derived from this software without specific prior written permission. + * + * THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR IMPLIED + * WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF + * MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO + * EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, + * SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, + * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; + * OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, + * WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR + * OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF + * ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + *) + +unit uMisc; +interface +uses uConsts, SDLh; +{$INCLUDE options.inc} +var isCursorVisible : boolean = false; + isTerminated : boolean = false; + isInLag : boolean = false; + isSoundEnabled : boolean = true; + isInMultiShoot : boolean = false; + + GameState : TGameState = gsLandGen; + GameType : TGameType = gmtLocal; + GameFlags : Longword = 0; + TurnTimeLeft : Longword = 0; + cHedgehogTurnTime: Longword = 30000; + + cLandYShift : integer = 888; + cCloudsNumber : integer = 9; + cConsoleHeight : integer = 320; + cConsoleYAdd : integer = 0; + cTimerInterval : Cardinal = 15; + cScreenWidth : integer = 1024; + cScreenHeight : integer = 768; + cBits : integer = 16; + cWaterLine : integer = 1024; + cVisibleWater : integer = 64; + cScreenEdgesDist : integer = 240; + + GameTicks : LongWord = 0; + + cSkyColor : Cardinal = 0; + cWaterColor : Cardinal = $32397A; + cMapBackColor : Cardinal = $FFFFFF; + cWhiteColor : Cardinal = $FFFFFF; + cConsoleSplitterColor : Cardinal = $FF0000; + cColorNearBlack : Cardinal = 16; + cExplosionBorderColor : LongWord = $808080; + + cDrownSpeed : Real = 0.06; + cMaxWindSpeed : Real = 0.0003; + cWindSpeed : Real = 0.0001; + cGravity : Real = 0.0005; + + cShowFPS : boolean = true; + cFullScreen : boolean = true; + +const + cMaxPower = 1500; + cMaxAngle = 2048; + cPowerDivisor = 1500; + +var + cSendEmptyPacketTime : LongWord = 2000; + cSendCursorPosTime : LongWord = 50; + + flagMakeCapture: boolean = false; + + AttackBar : integer = 0; // 0 - отсутствует, 1 - внизу, 2 - как в wwp + +function Sign(r: real): integer; +function Min(a, b: integer): integer; +function Max(a, b: integer): integer; +procedure OutError(Msg: String; const isFatalError: boolean=false); +procedure TryDo(Assert: boolean; Msg: string; isFatal: boolean); +procedure SDLTry(Assert: boolean; isFatal: boolean); +function IntToStr(n: integer): shortstring; +function FloatToStr(n: real): shortstring; +function arctan(const Y, X: real): real; +function DxDy2Angle32(const _dY, _dX: Extended): integer; +procedure AdjustColor(var Color: Longword); +{$IFDEF DEBUGFILE} +procedure AddFileLog(s: shortstring); +{$ENDIF} + +var CursorPoint: TPoint; + TargetPoint: TPoint = (X: NoPointX; Y: 0); + +implementation +uses uConsole, uStore; +{$IFDEF DEBUGFILE} +var f: textfile; +{$ENDIF} + + +function Sign(r: real): integer; +begin +if r < 0 then Result:= -1 else Result:= 1 +end; + +function Min(a, b: integer): integer; +begin +if a < b then Result:= a else Result:= b +end; + +function Max(a, b: integer): integer; +begin +if a > b then Result:= a else Result:= b +end; + +procedure OutError(Msg: String; const isFatalError: boolean=false); +begin +{$IFDEF DEBUGFILE}AddFileLog(Msg);{$ENDIF} +if isFatalError then + begin + WriteLn(Msg); + SDL_Quit; + Readln; + halt(1) + end else WriteLnToConsole(Msg) +end; + +procedure TryDo(Assert: boolean; Msg: string; isFatal: boolean); +begin +if not Assert then OutError(msg, isFatal) +end; + +procedure SDLTry(Assert: boolean; isFatal: boolean); +begin +if not Assert then OutError(SDL_GetError, isFatal) +end; + +procedure AdjustColor(var Color: Cardinal); +begin +Color:= SDL_MapRGB(PixelFormat, (Color shr 16) and $FF, (Color shr 8) and $FF, Color and $FF) +end; + +function IntToStr(n: integer): shortstring; +begin +str(n, Result) +end; + +function FloatToStr(n: real): shortstring; +begin +str(n, Result) +end; + +function arctan(const Y, X: real): real; +asm + fld Y + fld X + fpatan + fwait +end; + +function DxDy2Angle32(const _dY, _dX: Extended): integer; +const piDIV32: Extended = pi/32; +asm + fld _dY + fld _dX + fpatan + fld piDIV32 + fdiv + sub esp, 4 + fistp dword ptr [esp] + pop eax + shr eax, 1 + and eax, $1F +end; + + +{$IFDEF DEBUGFILE} +procedure AddFileLog(s: shortstring); +begin +writeln(f, GameTicks: 6, ': ', s); +flush(f) +end; + +initialization +assignfile(f, 'debug.txt'); +rewrite(f); +finalization +writeln(f, '-= halt at ',GameTicks,' ticks =-'); +Flush(f); +closefile(f) +{$ENDIF} + +end. diff -r ffe4ad26a64c -r bcbd7adb4e4b hedgewars/uNet.pas --- a/hedgewars/uNet.pas Mon Aug 22 21:38:06 2005 +0000 +++ b/hedgewars/uNet.pas Tue Aug 23 16:17:53 2005 +0000 @@ -1,155 +1,155 @@ -(* - * Hedgewars, a worms-like game - * Copyright (c) 2004, 2005 Andrey Korotaev - * - * Distributed under the terms of the BSD-modified licence: - * - * Permission is hereby granted, free of charge, to any person obtaining a copy - * of this software and associated documentation files (the "Software"), to deal - * with the Software without restriction, including without limitation the - * rights to use, copy, modify, merge, publish, distribute, sublicense, and/or - * sell copies of the Software, and to permit persons to whom the Software is - * furnished to do so, subject to the following conditions: - * - * 1. Redistributions of source code must retain the above copyright notice, - * this list of conditions and the following disclaimer. - * 2. Redistributions in binary form must reproduce the above copyright notice, - * this list of conditions and the following disclaimer in the documentation - * and/or other materials provided with the distribution. - * 3. The name of the author may not be used to endorse or promote products - * derived from this software without specific prior written permission. - * - * THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR IMPLIED - * WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF - * MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO - * EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, - * SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, - * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; - * OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, - * WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR - * OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF - * ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. - *) - -unit uNet; -interface -uses WinSock, Messages; -const - IN_NET_PORT = 46632; - WM_ASYNC_NETEVENT = WM_USER + 7; - -type TCommandHandler = procedure (s: shortstring); - -procedure SplitStream2Commands(var ss: string; Handler: TCommandHandler); -procedure SendSock(Socket: TSocket; s: shortstring); -procedure InitServer; -procedure NetSockEvent(sock, lParam: Longword); - -var hNetListenSockTCP: TSocket = INVALID_SOCKET; - -implementation -uses uServerMisc, uPlayers; - -procedure SplitStream2Commands(var ss: string; Handler: TCommandHandler); -var s: shortstring; -begin -while (Length(ss) > 1)and(Length(ss) > byte(ss[1])) do - begin - s:= copy(ss, 2, byte(ss[1])); - Delete(ss, 1, Succ(byte(ss[1]))); - Handler(s) - end; -end; - -procedure SendSock(Socket: TSocket; s: shortstring); -begin -//writeln(socket, '> ', s); -send(Socket, s[0], Succ(byte(s[0])), 0) -end; - -procedure InitServer; -var myaddrTCP: TSockAddrIn; - t: integer; - stWSADataTCPIP : WSADATA; -begin -TryDo(WSAStartup($0101, stWSADataTCPIP) = 0, 'Error on WSAStartup'); -hNetListenSockTCP:= socket(AF_INET, SOCK_STREAM, 0); -myaddrTCP.sin_family := AF_INET; -myaddrTCP.sin_addr.s_addr := $0; -myaddrTCP.sin_port := htons(IN_NET_PORT); -t:= sizeof(TSockAddrIn); -TryDo( bind(hNetListenSockTCP, myaddrTCP, t) = 0, 'Error on bind' ); -TryDo( listen(hNetListenSockTCP, 1) = 0, 'Error on listen'); -WSAAsyncSelect(hNetListenSockTCP, hwndMain, WM_ASYNC_NETEVENT, FD_ACCEPT or FD_READ or FD_CLOSE) -end; - -procedure ParseNetCommand(Player: PPlayer; s: shortstring); -begin -case s[1] of - '?': SendSock(player.socket, '!'); - 'n': begin - player.Name:= copy(s, 2, length(s) - 1); - Writeln(player.socket, ' now is ', player.Name) - end; - 'C': SendConfig(player); - 'G': SendAll('G'); - 'T': begin - s[0]:= #5; - s[1]:= 'T'; - PLongWord(@s[2])^:= GetTeamCount; - SendSock(player.socket, s) - end; - 'K': SelectFirstCFGTeam; - 'k': SelectNextCFGTeam; - 'h': ConfCurrTeam(s); - else SendAllButOne(Player, s) end -end; - -procedure NetSockEvent(sock, lParam: Longword); -var i: integer; - buf: array[0..255] of byte; - s: shortstring absolute buf; - WSAEvent: word; - player: PPlayer; - sa: TSockAddr; -begin -WSAEvent:= WSAGETSELECTEVENT(lParam); -case WSAEvent of - FD_ACCEPT: begin - i:= sizeof(sa); - sock:= accept(hNetListenSockTCP, @sa, @i); - Writeln('Connected player ', sock, ' from ', inet_ntoa(sa.sin_addr)); - AddPlayer(sock); - SendSock(sock, 'i') - end; - FD_CLOSE: begin - player:= FindPlayerbySock(sock); - TryDo(player <> nil, 'FD_CLOSE from unknown player??'); - Write('Player quit: '); - if player.Name[0]=#0 then Writeln('socket ', player.socket) - else Writeln(player.Name); - DeletePlayer(player); - closesocket(sock); - end; - FD_READ: begin - player:= FindPlayerbySock(sock); - TryDo(player <> nil, 'FD_READ from unknown player??'); - repeat - i:= recv(sock, buf[1], 255, 0); - if i > 0 then - begin - buf[0]:= i; - player.inbuf:= player.inbuf + s; - while (Length(player.inbuf) > 1)and(Length(player.inbuf) > byte(player.inbuf[1])) do - begin - ParseNetCommand(player, copy(player.inbuf, 2, byte(player.inbuf[1]))); - Delete(player.inbuf, 1, Succ(byte(player.inbuf[1]))) - end; - end; - until i < 1; - end - end -end; - - -end. +(* + * Hedgewars, a worms-like game + * Copyright (c) 2004, 2005 Andrey Korotaev + * + * 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 ffe4ad26a64c -r bcbd7adb4e4b hedgewars/uPlayers.pas --- a/hedgewars/uPlayers.pas Mon Aug 22 21:38:06 2005 +0000 +++ b/hedgewars/uPlayers.pas Tue Aug 23 16:17:53 2005 +0000 @@ -1,191 +1,191 @@ -(* - * Hedgewars, a worms-like game - * Copyright (c) 2004, 2005 Andrey Korotaev - * - * Distributed under the terms of the BSD-modified licence: - * - * Permission is hereby granted, free of charge, to any person obtaining a copy - * of this software and associated documentation files (the "Software"), to deal - * with the Software without restriction, including without limitation the - * rights to use, copy, modify, merge, publish, distribute, sublicense, and/or - * sell copies of the Software, and to permit persons to whom the Software is - * furnished to do so, subject to the following conditions: - * - * 1. Redistributions of source code must retain the above copyright notice, - * this list of conditions and the following disclaimer. - * 2. Redistributions in binary form must reproduce the above copyright notice, - * this list of conditions and the following disclaimer in the documentation - * and/or other materials provided with the distribution. - * 3. The name of the author may not be used to endorse or promote products - * derived from this software without specific prior written permission. - * - * THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR IMPLIED - * WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF - * MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO - * EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, - * SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, - * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; - * OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, - * WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR - * OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF - * ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. - *) - -unit uPlayers; -interface -uses windows, WinSock; -type PPlayer = ^TPlayer; - PTeam = ^TTeam; - TTeam = record - hhs: array[0..7] of TPoint; - hhCount: LongWord; - end; - TPlayer = record - socket: TSocket; - NextPlayer, PrevPlayer: PPlayer; - Name: string[31]; - inbuf: string; - isme: boolean; - CurrTeam: LongWord; - TeamCount: LongWord; - Teams: array[0..3] of TTeam - end; - -function AddPlayer(sock: TSocket): PPlayer; -procedure DeletePlayer(Player: PPlayer); -function FindPlayerbySock(sock: TSocket): PPlayer; -procedure SendAll(s: shortstring); -procedure SendAllButOne(Player: PPlayer; s: shortstring); -procedure SelectFirstCFGTeam; -procedure SelectNextCFGTeam; -function GetTeamCount: Longword; -procedure ConfCurrTeam(s: shortstring); -procedure SendConfig(player: PPlayer); - -var CurrCFGPlayer: PPlayer; - -implementation -uses uServerMisc, uNet, SysUtils; -var PlayersList: PPlayer = nil; - -function AddPlayer(sock: TSocket): PPlayer; -begin -New(Result); -TryDo(Result <> nil, 'Error adding player!'); -FillChar(Result^, sizeof(TPlayer), 0); -Result.socket:= sock; -Result.TeamCount:= 2; -if PlayersList = nil then begin PlayersList:= Result; result.isme:= true end - else begin - PlayersList.PrevPlayer:= Result; - Result.NextPlayer:= PlayersList; - PlayersList:= Result - end -end; - -procedure DeletePlayer(Player: PPlayer); -begin -if Player = nil then OutError('Trying remove nil player!', false); -if Player.NextPlayer <> nil then Player.NextPlayer.PrevPlayer:= Player.PrevPlayer; -if Player.PrevPlayer <> nil then Player.PrevPlayer.NextPlayer:= Player.NextPlayer - else begin - PlayersList:= Player^.NextPlayer; - if PlayersList <> nil then PlayersList.PrevPlayer:= nil - end; -Dispose(Player) -end; - -function FindPlayerbySock(sock: TSocket): PPlayer; -begin -Result:= PlayersList; -while (Result<>nil)and(Result.socket<>sock) do - Result:= Result.NextPlayer -end; - -procedure SendAll(s: shortstring); -var p: PPlayer; -begin -p:= PlayersList; -while p <> nil do - begin - SendSock(p.socket, s); - p:= p.NextPlayer - end; -end; - -procedure SendAllButOne(Player: PPlayer; s: shortstring); -var p: PPlayer; -begin -p:= Player.NextPlayer; -while p <> nil do - begin - SendSock(p.socket, s); - p:= p.NextPlayer - end; -p:= PlayersList; -while p <> Player do - begin - SendSock(p.socket, s); - p:= p.NextPlayer - end; -end; - -function GetTeamCount: Longword; -var p: PPlayer; -begin -p:= PlayersList; -Result:= 0; -while p <> nil do - begin - inc(Result, p.TeamCount); - p:= p.NextPlayer - end; -end; - -procedure SelectFirstCFGTeam; -begin -CurrCFGPlayer:= PlayersList -end; - -procedure SelectNextCFGTeam; -begin -if CurrCFGPlayer = nil then OutError('Trying select next on nil current', true); -if Succ(CurrCFGPlayer.CurrTeam) < CurrCFGPlayer.TeamCount then inc(CurrCFGPlayer.CurrTeam) - else CurrCFGPlayer:= CurrCFGPlayer.NextPlayer -end; - -procedure ConfCurrTeam(s: shortstring); -begin -if CurrCFGPlayer = nil then OutError('Trying select next on nil current', true); -case s[1] of - 'h': with CurrCFGPlayer.Teams[CurrCFGPlayer.CurrTeam] do - begin - hhs[hhCount].X:= PLongWord(@s[2])^; - hhs[hhCount].Y:= PLongWord(@s[6])^; - inc(hhCount); - end; - end; -end; - -procedure SendConfig(player: PPlayer); -var p: PPlayer; - i, t: integer; -begin -p:= PlayersList; -while p <> nil do - begin - for t:= 0 to Pred(player.TeamCount) do - begin - SendSock(player.socket, 'eaddteam'); - if p = player then SendSock(player.socket, '@') - else SendSock(player.socket, 'erdriven'); - for i:= 0 to Pred(player.Teams[t].hhCount) do - SendSock(player.socket, Format('eadd hh%d %d %d %d',[i, p.Teams[t].hhs[i].X, p.Teams[t].hhs[i].Y, 0])); - Sendsock(player.socket, Format('ecolor %d',[random($A0A0A0)+$5F5F5F])) - end; - p:= p.NextPlayer - end -end; - - -end. +(* + * Hedgewars, a worms-like game + * Copyright (c) 2004, 2005 Andrey Korotaev + * + * 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 ffe4ad26a64c -r bcbd7adb4e4b hedgewars/uRandom.pas --- a/hedgewars/uRandom.pas Mon Aug 22 21:38:06 2005 +0000 +++ b/hedgewars/uRandom.pas Tue Aug 23 16:17:53 2005 +0000 @@ -1,75 +1,75 @@ -(* - * Hedgewars, a worms-like game - * Copyright (c) 2004, 2005 Andrey Korotaev - * - * Distributed under the terms of the BSD-modified licence: - * - * Permission is hereby granted, free of charge, to any person obtaining a copy - * of this software and associated documentation files (the "Software"), to deal - * with the Software without restriction, including without limitation the - * rights to use, copy, modify, merge, publish, distribute, sublicense, and/or - * sell copies of the Software, and to permit persons to whom the Software is - * furnished to do so, subject to the following conditions: - * - * 1. Redistributions of source code must retain the above copyright notice, - * this list of conditions and the following disclaimer. - * 2. Redistributions in binary form must reproduce the above copyright notice, - * this list of conditions and the following disclaimer in the documentation - * and/or other materials provided with the distribution. - * 3. The name of the author may not be used to endorse or promote products - * derived from this software without specific prior written permission. - * - * THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR IMPLIED - * WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF - * MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO - * EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, - * SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, - * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; - * OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, - * WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR - * OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF - * ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. - *) - -unit uRandom; -interface -uses uSHA; - -procedure SetRandomParams(Seed: shortstring; FillBuf: shortstring); -function GetRandom: real; overload; -function GetRandom(m: LongWord): LongWord; overload; - -implementation -var sc1, sc2: TSHA1Context; - Fill: shortstring; - -procedure SetRandomParams(Seed: shortstring; FillBuf: shortstring); -begin -SHA1Init(sc1); -SHA1Update(sc1, @Seed, Length(Seed)+1); -Fill:= FillBuf -end; - -function GetRandom: real; -var dig: TSHA1Digest; -begin -SHA1Update(sc1, @Fill[1], Length(Fill)); -sc2:= sc1; -dig:= SHA1Final(sc1); -Result:= frac( dig.LongWords[0]*0.0000731563977 - + pi * dig.Words[6] - + 0.0109070019*dig.Words[9]); -sc1:= sc2 -end; - -function GetRandom(m: LongWord): LongWord; -var dig: TSHA1Digest; -begin -SHA1Update(sc1, @Fill[1], Length(Fill)); -sc2:= sc1; -dig:= SHA1Final(sc1); -Result:= (((dig.LongWords[0] mod m) + (dig.LongWords[2] mod m)) mod m + (dig.LongWords[3] mod m)) mod m; -sc1:= sc2 -end; - -end. +(* + * Hedgewars, a worms-like game + * Copyright (c) 2004, 2005 Andrey Korotaev + * + * 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 ffe4ad26a64c -r bcbd7adb4e4b hedgewars/uSHA.pas --- a/hedgewars/uSHA.pas Mon Aug 22 21:38:06 2005 +0000 +++ b/hedgewars/uSHA.pas Tue Aug 23 16:17:53 2005 +0000 @@ -1,163 +1,163 @@ -(* - * Hedgewars, a worms-like game - * Copyright (c) 2004, 2005 Andrey Korotaev - * - * Distributed under the terms of the BSD-modified licence: - * - * Permission is hereby granted, free of charge, to any person obtaining a copy - * of this software and associated documentation files (the "Software"), to deal - * with the Software without restriction, including without limitation the - * rights to use, copy, modify, merge, publish, distribute, sublicense, and/or - * sell copies of the Software, and to permit persons to whom the Software is - * furnished to do so, subject to the following conditions: - * - * 1. Redistributions of source code must retain the above copyright notice, - * this list of conditions and the following disclaimer. - * 2. Redistributions in binary form must reproduce the above copyright notice, - * this list of conditions and the following disclaimer in the documentation - * and/or other materials provided with the distribution. - * 3. The name of the author may not be used to endorse or promote products - * derived from this software without specific prior written permission. - * - * THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR IMPLIED - * WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF - * MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO - * EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, - * SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, - * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; - * OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, - * WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR - * OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF - * ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. - *) - -unit uSHA; -interface - -type TSHA1Context = packed record - H: array[0..4] of LongWord; - Length, CurrLength: Int64; - Buf: array[0..63] of byte; - end; - TSHA1Digest = record - case byte of - 0: (LongWords: array[0.. 4] of LongWord); - 1: ( Words: array[0.. 9] of Word); - 2: ( Bytes: array[0..19] of Byte) - end; - -procedure SHA1Init(var Context: TSHA1Context); -procedure SHA1Update(var Context: TSHA1Context; Buf: Pointer; Length: LongWord); -function SHA1Final(Context: TSHA1Context): TSHA1Digest; - -implementation - -function _bswap(X: LongWord): LongWord; assembler; -asm - bswap eax -end; - -function rol(x: LongWord; y: Byte): LongWord; assembler; -asm - mov cl,dl - rol eax,cl -end; - -function Ft(t, b, c, d: LongWord): LongWord; -begin -case t of - 0..19: Result := (b and c) or ((not b) and d); - 20..39: Result := b xor c xor d; - 40..59: Result := (b and c) or (b and d) or (c and d); - else Result := b xor c xor d; - end; -end; - -function Kt(t: Byte): LongWord; -begin - case t of - 0..19: Result := $5A827999; - 20..39: Result := $6ED9EBA1; - 40..59: Result := $8F1BBCDC; - else - Result := $CA62C1D6 - end; -end; - - -procedure SHA1Hash(var Context: TSHA1Context); -var S: array[0..4 ] of LongWord; - W: array[0..79] of LongWord; - i, t: LongWord; -begin -move(Context.H, S, sizeof(S)); -for i:= 0 to 15 do - W[i]:= _bswap(PLongWord(LongWord(@Context.Buf)+i*4)^); -for i := 16 to 79 do - W[i] := rol(W[i - 3] xor W[i - 8] xor W[i - 14] xor W[i - 16], 1); -for i := 0 to 79 do - begin - t:= rol(S[0], 5) + Ft(i, S[1], S[2], S[3]) + S[4] + W[i] + Kt(i); - S[4]:= S[3]; - S[3]:= S[2]; - S[2]:= rol(S[1], 30); - S[1]:= S[0]; - S[0]:= t - end; -for i := 0 to 4 do - Context.H[i]:= Context.H[i] + S[i] -end; - -procedure SHA1Init(var Context: TSHA1Context); -begin - with Context do - begin - Length := 0; - CurrLength:= 0; - H[0]:= $67452301; - H[1]:= $EFCDAB89; - H[2]:= $98BADCFE; - H[3]:= $10325476; - H[4]:= $C3D2E1F0 - end -end; - -procedure SHA1Update(var Context: TSHA1Context; Buf: Pointer; Length: LongWord); -var i: integer; -begin -for i:= 1 to Length do - begin - Context.Buf[Context.CurrLength]:= PByte(Buf)^; - inc(Context.CurrLength); - inc(LongWord(Buf)); - if Context.CurrLength=64 then - begin - SHA1Hash(Context); - inc(Context.Length, 512); - Context.CurrLength:=0 - end - end -end; - -function SHA1Final(Context: TSHA1Context): TSHA1Digest; -var i: LongWord; -begin -Context.Length:= Context.Length + Context.CurrLength shl 3; -Context.Buf[Context.CurrLength]:= $80; -inc(Context.CurrLength); -if Context.CurrLength>56 then - begin - FillChar(Context.Buf[Context.CurrLength],64-Context.CurrLength,0); - Context.CurrLength:= 64; - SHA1Hash(Context); - Context.CurrLength:=0 - end; -FillChar(Context.Buf[Context.CurrLength],56-Context.CurrLength,0); -for i:= 56 to 63 do - Context.Buf[i] := (Context.Length shr ((63 - i) * 8)) and $FF; -SHA1Hash(Context); -move(Context.H, Result, sizeof(TSHA1Digest)); -FillChar(Context, sizeof(Context), 0) -end; - -end. +(* + * Hedgewars, a worms-like game + * Copyright (c) 2004, 2005 Andrey Korotaev + * + * 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 ffe4ad26a64c -r bcbd7adb4e4b hedgewars/uServerMisc.pas --- a/hedgewars/uServerMisc.pas Mon Aug 22 21:38:06 2005 +0000 +++ b/hedgewars/uServerMisc.pas Tue Aug 23 16:17:53 2005 +0000 @@ -1,65 +1,65 @@ -(* - * Hedgewars, a worms-like game - * Copyright (c) 2004, 2005 Andrey Korotaev - * - * Distributed under the terms of the BSD-modified licence: - * - * Permission is hereby granted, free of charge, to any person obtaining a copy - * of this software and associated documentation files (the "Software"), to deal - * with the Software without restriction, including without limitation the - * rights to use, copy, modify, merge, publish, distribute, sublicense, and/or - * sell copies of the Software, and to permit persons to whom the Software is - * furnished to do so, subject to the following conditions: - * - * 1. Redistributions of source code must retain the above copyright notice, - * this list of conditions and the following disclaimer. - * 2. Redistributions in binary form must reproduce the above copyright notice, - * this list of conditions and the following disclaimer in the documentation - * and/or other materials provided with the distribution. - * 3. The name of the author may not be used to endorse or promote products - * derived from this software without specific prior written permission. - * - * THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR IMPLIED - * WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF - * MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO - * EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, - * SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, - * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; - * OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, - * WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR - * OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF - * ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. - *) - -unit uServerMisc; -interface -uses Windows; -const cAppName = 'hwnetserver'; - cAppTitle = 'hwnetserver'; - cProtVer = 1; - -procedure OutError(s: shortstring; isFatal: boolean); -procedure TryDo(b: boolean; msg: shortstring); - -var hwndMain: HWND; - isTerminated: boolean = false; - -implementation - -procedure OutError(s: shortstring; isFatal: boolean); -begin -Writeln(s); -if isFatal then - begin - Writeln('Server will now be terminated'); - Readln; - halt - end; -end; - -procedure TryDo(b: boolean; msg: shortstring); -begin -if not b then OutError(msg, true) -end; - -end. +(* + * Hedgewars, a worms-like game + * Copyright (c) 2004, 2005 Andrey Korotaev + * + * 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 ffe4ad26a64c -r bcbd7adb4e4b hedgewars/uSound.pas --- a/hedgewars/uSound.pas Mon Aug 22 21:38:06 2005 +0000 +++ b/hedgewars/uSound.pas Tue Aug 23 16:17:53 2005 +0000 @@ -1,111 +1,111 @@ -(* - * Hedgewars, a worms-like game - * Copyright (c) 2005 Andrey Korotaev - * - * Distributed under the terms of the BSD-modified licence: - * - * Permission is hereby granted, free of charge, to any person obtaining a copy - * of this software and associated documentation files (the "Software"), to deal - * with the Software without restriction, including without limitation the - * rights to use, copy, modify, merge, publish, distribute, sublicense, and/or - * sell copies of the Software, and to permit persons to whom the Software is - * furnished to do so, subject to the following conditions: - * - * 1. Redistributions of source code must retain the above copyright notice, - * this list of conditions and the following disclaimer. - * 2. Redistributions in binary form must reproduce the above copyright notice, - * this list of conditions and the following disclaimer in the documentation - * and/or other materials provided with the distribution. - * 3. The name of the author may not be used to endorse or promote products - * derived from this software without specific prior written permission. - * - * THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR IMPLIED - * WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF - * MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO - * EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, - * SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, - * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; - * OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, - * WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR - * OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF - * ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. - *) - -unit uSound; -interface -uses SDLh, uConsts; -{$INCLUDE options.inc} - -procedure InitSound; -procedure ReleaseSound; -procedure SoundLoad; -procedure PlaySound(snd: TSound); -procedure PlayMusic; -procedure StopSound(snd: TSound); - -implementation -uses uMisc, uConsole; -var Mus: PMixMusic; - -procedure InitSound; -begin -if not isSoundEnabled then exit; -WriteToConsole('Init sound...'); -isSoundEnabled:= Mix_OpenAudio(22050, $8010, 2, 512) = 0; -if isSoundEnabled then WriteLnToConsole(msgOK) - else WriteLnToConsole(msgFailed); -Mix_VolumeMusic(48) -end; - -procedure ReleaseSound; -var i: TSound; -begin -for i:= Low(TSound) to High(TSound) do - Mix_FreeChunk(Soundz[i].id); -Mix_FreeMusic(Mus); -Mix_CloseAudio -end; - -procedure SoundLoad; -var i: TSound; - s: string; -begin -if not isSoundEnabled then exit; -for i:= Low(TSound) to High(TSound) do - begin - s:= Pathz[ptSounds] + Soundz[i].FileName; - WriteToConsole(msgLoading + s + ' '); - Soundz[i].id:= Mix_LoadWAV_RW(SDL_RWFromFile(PChar(s), 'rb'), 1); - TryDo(Soundz[i].id <> nil, msgFailed, true); - WriteLnToConsole(msgOK); - end; - -s:= 'Data/Music/kahvi140a_alexander_chereshnev-illusion.ogg'; -WriteToConsole(msgLoading + s + ' '); -Mus:= Mix_LoadMUS(PChar(s)); -TryDo(Mus <> nil, msgFailed, false); -WriteLnToConsole(msgOK) -end; - -procedure PlaySound(snd: TSound); -begin -if not isSoundEnabled then exit; -if Mix_Playing(ord(snd)) = 0 then - Mix_PlayChannelTimed(ord(snd), Soundz[snd].id, 0, -1) -end; - -procedure StopSound(snd: TSound); -begin -if not isSoundEnabled then exit; -if Mix_Playing(ord(snd)) <> 0 then - Mix_HaltChannel(ord(snd)) -end; - -procedure PlayMusic; -begin -if not isSoundEnabled then exit; -if Mix_PlayingMusic = 0 then - Mix_PlayMusic(Mus, -1) -end; - -end. +(* + * Hedgewars, a worms-like game + * Copyright (c) 2005 Andrey Korotaev + * + * 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 ffe4ad26a64c -r bcbd7adb4e4b hedgewars/uStore.pas --- a/hedgewars/uStore.pas Mon Aug 22 21:38:06 2005 +0000 +++ b/hedgewars/uStore.pas Tue Aug 23 16:17:53 2005 +0000 @@ -1,594 +1,594 @@ -(* - * Hedgewars, a worms-like game - * Copyright (c) 2004, 2005 Andrey Korotaev - * - * Distributed under the terms of the BSD-modified licence: - * - * Permission is hereby granted, free of charge, to any person obtaining a copy - * of this software and associated documentation files (the "Software"), to deal - * with the Software without restriction, including without limitation the - * rights to use, copy, modify, merge, publish, distribute, sublicense, and/or - * sell copies of the Software, and to permit persons to whom the Software is - * furnished to do so, subject to the following conditions: - * - * 1. Redistributions of source code must retain the above copyright notice, - * this list of conditions and the following disclaimer. - * 2. Redistributions in binary form must reproduce the above copyright notice, - * this list of conditions and the following disclaimer in the documentation - * and/or other materials provided with the distribution. - * 3. The name of the author may not be used to endorse or promote products - * derived from this software without specific prior written permission. - * - * THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR IMPLIED - * WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF - * MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO - * EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, - * SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, - * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; - * OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, - * WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR - * OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF - * ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. - *) - -unit uStore; -interface -uses uConsts, uTeams, SDLh; -{$INCLUDE options.inc} - -type PRangeArray = ^TRangeArray; - TRangeArray = array[byte] of record - Left, Right: integer; - end; - -procedure StoreInit; -procedure StoreLoad; -procedure StoreRelease; -procedure DrawGear(Stuff : TStuff; X, Y: integer; Surface: PSDL_Surface); -procedure DrawSpriteFromRect(r: TSDL_Rect; X, Y, Height, Position: integer; Surface: PSDL_Surface); -procedure DrawSprite (Sprite: TSprite; X, Y, Position: integer; Surface: PSDL_Surface); -procedure DrawLand (X, Y: integer; Surface: PSDL_Surface); -procedure DXOutText(X, Y: Integer; Font: THWFont; s: string; Surface: PSDL_Surface); -procedure DrawCaption(X, Y: integer; Rect: TSDL_Rect; Surface: PSDL_Surface; const fromTempSurf: boolean = false); -procedure DrawHedgehog(X, Y: integer; Dir: integer; Pos, Step: LongWord; Surface: PSDL_Surface); -procedure DrawExplosion(X, Y, Radius: integer); -procedure DrawLineExplosions(ar: PRangeArray; Radius: Longword; y, dY: integer; Count: Byte); -procedure RenderHealth(var Hedgehog: THedgehog); -function RenderString(var s: shortstring; Color, Pos: integer): TSDL_Rect; -procedure AddProgress; -function LoadImage(filename: string): PSDL_Surface; - -var PixelFormat: PSDL_PixelFormat; - SDLPrimSurface: PSDL_Surface; - -implementation -uses uMisc, uIO, uConsole, uLand; - -var StoreSurface, - TempSurface, - HHSurface: PSDL_Surface; - -procedure DrawExplosion(X, Y, Radius: integer); -var ty, tx: integer; - p: integer; -begin -for ty:= max(-Radius, -y) to min(radius, 1023 - y) do - for tx:= max(0, round(x-radius*sqrt(1-sqr(ty/radius)))) to min(2047, round(x+radius*sqrt(1-sqr(ty/radius)))) do - Land[ty + y, tx]:= 0; - -if SDL_MustLock(LandSurface) then - SDLTry(SDL_LockSurface(LandSurface) >= 0, true); - -p:= Longword(LandSurface.pixels); -case LandSurface.format.BytesPerPixel of - 1: ;// not supported - 2: for ty:= max(-Radius, -y) to min(Radius, 1023 - y) do - for tx:= max(0, round(x-radius*sqrt(1-sqr(ty/radius)))) to min(2047, round(x+radius*sqrt(1-sqr(ty/radius)))) do - PWord(p + LandSurface.pitch*(y + ty) + tx * 2)^:= 0; - 3: for ty:= max(-Radius, -y) to min(Radius, 1023 - y) do - for tx:= max(0, round(x-radius*sqrt(1-sqr(ty/radius)))) to min(2047, round(x+radius*sqrt(1-sqr(ty/radius)))) do - begin - PByte(p + LandSurface.pitch*(y + ty) + tx * 3 + 0)^:= 0; - PByte(p + LandSurface.pitch*(y + ty) + tx * 3 + 1)^:= 0; - PByte(p + LandSurface.pitch*(y + ty) + tx * 3 + 2)^:= 0; - end; - 4: for ty:= max(-Radius, -y) to min(Radius, 1023 - y) do - for tx:= max(0, round(x-radius*sqrt(1-sqr(ty/radius)))) to min(2047, round(x+radius*sqrt(1-sqr(ty/radius)))) do - PLongword(p + LandSurface.pitch*(y + ty) + tx * 4)^:= 0; - end; - -inc(Radius, 4); - -case LandSurface.format.BytesPerPixel of - 1: ;// not supported - 2: for ty:= max(-Radius, -y) to min(Radius, 1023 - y) do - for tx:= max(0, round(x-radius*sqrt(1-sqr(ty/radius)))) to min(2047, round(x+radius*sqrt(1-sqr(ty/radius)))) do - if PWord(p + LandSurface.pitch*(y + ty) + tx * 2)^ <> 0 then - PWord(p + LandSurface.pitch*(y + ty) + tx * 2)^:= cExplosionBorderColor; - 3: for ty:= max(-Radius, -y) to min(Radius, 1023 - y) do - for tx:= max(0, round(x-radius*sqrt(1-sqr(ty/radius)))) to min(2047, round(x+radius*sqrt(1-sqr(ty/radius)))) do - if (PByte(p + LandSurface.pitch*(y + ty) + tx * 3 + 0)^ <> 0) - or (PByte(p + LandSurface.pitch*(y + ty) + tx * 3 + 1)^ <> 0) - or (PByte(p + LandSurface.pitch*(y + ty) + tx * 3 + 2)^ <> 0) - then begin - PByte(p + LandSurface.pitch*(y + ty) + tx * 3 + 0)^:= cExplosionBorderColor and $FF; - PByte(p + LandSurface.pitch*(y + ty) + tx * 3 + 1)^:= (cExplosionBorderColor shr 8) and $FF; - PByte(p + LandSurface.pitch*(y + ty) + tx * 3 + 2)^:= (cExplosionBorderColor shr 16); - end; - 4: for ty:= max(-Radius, -y) to min(Radius, 1023 - y) do - for tx:= max(0, round(x-radius*sqrt(1-sqr(ty/radius)))) to min(2047, round(x+radius*sqrt(1-sqr(ty/radius)))) do - if PLongword(p + LandSurface.pitch*(y + ty) + tx * 4)^ <> 0 then - PLongword(p + LandSurface.pitch*(y + ty) + tx * 4)^:= cExplosionBorderColor; - end; - -if SDL_MustLock(LandSurface) then - SDL_UnlockSurface(LandSurface); - -SDL_UpdateRect(LandSurface, X - Radius, Y - Radius, Radius * 2, Radius * 2) -end; - -procedure DrawLineExplosions(ar: PRangeArray; Radius: Longword; y, dY: integer; Count: Byte); -var tx, ty, i, p: integer; -begin -if SDL_MustLock(LandSurface) then - SDL_LockSurface(LandSurface); - -p:= Longword(LandSurface.pixels); -for i:= 0 to Pred(Count) do - begin - case LandSurface.format.BytesPerPixel of - 1: ; - 2: for ty:= max(-Radius, -y) to min(Radius, 1023 - y) do - for tx:= max(0, round(ar[i].Left - radius*sqrt(1-sqr(ty/radius)))) to min(2047, round(ar[i].Right + radius*sqrt(1-sqr(ty/radius)))) do - PWord(p + LandSurface.pitch*(y + ty) + tx * 2)^:= 0; - 3: for ty:= max(-Radius, -y) to min(Radius, 1023 - y) do - for tx:= max(0, round(ar[i].Left - radius*sqrt(1-sqr(ty/radius)))) to min(2047, round(ar[i].Right + radius*sqrt(1-sqr(ty/radius)))) do - begin - PByte(p + LandSurface.pitch*(y + ty) + tx * 3 + 0)^:= 0; - PByte(p + LandSurface.pitch*(y + ty) + tx * 3 + 1)^:= 0; - PByte(p + LandSurface.pitch*(y + ty) + tx * 3 + 2)^:= 0; - end; - 4: for ty:= max(-Radius, -y) to min(Radius, 1023 - y) do - for tx:= max(0, round(ar[i].Left - radius*sqrt(1-sqr(ty/radius)))) to min(2047, round(ar[i].Right + radius*sqrt(1-sqr(ty/radius)))) do - PLongword(p + LandSurface.pitch*(y + ty) + tx * 4)^:= 0; - end; - inc(y, dY) - end; - -inc(Radius, 4); -dec(y, Count*dY); - -for i:= 0 to Pred(Count) do - begin - case LandSurface.format.BytesPerPixel of - 1: ; - 2: for ty:= max(-Radius, -y) to min(Radius, 1023 - y) do - for tx:= max(0, round(ar[i].Left - radius*sqrt(1-sqr(ty/radius)))) to min(2047, round(ar[i].Right + radius*sqrt(1-sqr(ty/radius)))) do - if PWord(p + LandSurface.pitch*(y + ty) + tx * 2)^ <> 0 then - PWord(p + LandSurface.pitch*(y + ty) + tx * 2)^:= cExplosionBorderColor; - 3: for ty:= max(-Radius, -y) to min(Radius, 1023 - y) do - for tx:= max(0, round(ar[i].Left - radius*sqrt(1-sqr(ty/radius)))) to min(2047, round(ar[i].Right + radius*sqrt(1-sqr(ty/radius)))) do - if (PByte(p + LandSurface.pitch*(y + ty) + tx * 3 + 0)^ <> 0) - or (PByte(p + LandSurface.pitch*(y + ty) + tx * 3 + 1)^ <> 0) - or (PByte(p + LandSurface.pitch*(y + ty) + tx * 3 + 2)^ <> 0) - then begin - PByte(p + LandSurface.pitch*(y + ty) + tx * 3 + 0)^:= cExplosionBorderColor and $FF; - PByte(p + LandSurface.pitch*(y + ty) + tx * 3 + 1)^:= (cExplosionBorderColor shr 8) and $FF; - PByte(p + LandSurface.pitch*(y + ty) + tx * 3 + 2)^:= (cExplosionBorderColor shr 16); - end; - 4: for ty:= max(-Radius, -y) to min(Radius, 1023 - y) do - for tx:= max(0, round(ar[i].Left - radius*sqrt(1-sqr(ty/radius)))) to min(2047, round(ar[i].Right + radius*sqrt(1-sqr(ty/radius)))) do - if PLongword(p + LandSurface.pitch*(y + ty) + tx * 4)^ <> 0 then - PLongword(p + LandSurface.pitch*(y + ty) + tx * 4)^:= cExplosionBorderColor; - end; - inc(y, dY) - end; - -if SDL_MustLock(LandSurface) then - SDL_UnlockSurface(LandSurface); -end; - -procedure StoreInit; -begin -StoreSurface := SDL_CreateRGBSurface(SDL_HWSURFACE, 576, 1024, cBits, PixelFormat.RMask, PixelFormat.GMask, PixelFormat.BMask, 0); -TryDo( StoreSurface <> nil, errmsgCreateSurface + ': store' , true); - -TempSurface := SDL_CreateRGBSurface(SDL_HWSURFACE, 724, 320, cBits, PixelFormat.RMask, PixelFormat.GMask, PixelFormat.BMask, 0); -TryDo( TempSurface <> nil, errmsgCreateSurface + ': temp' , true); - -TryDo(SDL_SetColorKey( StoreSurface, SDL_SRCCOLORKEY or SDL_RLEACCEL, 0) = 0, errmsgTransparentSet, true); -//TryDo(SDL_SetColorKey(SpriteSurface, SDL_SRCCOLORKEY or SDL_RLEACCEL, 0) = 0, errmsgTransparentSet, true); -TryDo(SDL_SetColorKey( TempSurface, SDL_SRCCOLORKEY or SDL_RLEACCEL, 0) = 0, errmsgTransparentSet, true); -end; - -procedure LoadToSurface(Filename: String; Surface: PSDL_Surface; X, Y: integer); -var tmpsurf: PSDL_Surface; - rr: TSDL_Rect; -begin - tmpsurf:= LoadImage(Filename); - rr.x:= X; - rr.y:= Y; - SDL_UpperBlit(tmpsurf, nil, Surface, @rr); - SDL_FreeSurface(tmpsurf); -end; - -function WriteInRoundRect(Surface: PSDL_Surface; X, Y: integer; Color: LongWord; Font: THWFont; s: string): TSDL_Rect; -var w, h: integer; - tmpsurf: PSDL_Surface; - clr: TSDL_Color; -begin -TTF_SizeText(Fontz[Font].Handle, PChar(s), w, h); -Result.x:= X; -Result.y:= Y; -Result.w:= w + 6; -Result.h:= h + 6; -SDL_FillRect(Surface, @Result, 0); -Result.w:= 1; -Result.y:= Y + 1; -Result.h:= h + 4; -SDL_FillRect(Surface, @Result, cWhiteColor); -Result.x:= X + w + 5; -SDL_FillRect(Surface, @Result, cWhiteColor); -Result.x:= X + 1; -Result.w:= w + 4; -Result.y:= Y; -Result.h:= 1; -SDL_FillRect(Surface, @Result, cWhiteColor); -Result.y:= Y + h + 5; -SDL_FillRect(Surface, @Result, cWhiteColor); -Result.x:= X + 1; -Result.y:= Y + 1; -Result.h:= h + 4; -SDL_FillRect(Surface, @Result, cColorNearBlack); -SDL_GetRGB(Color, Surface.format, @clr.r, @clr.g, @clr.b); -tmpsurf:= TTF_RenderText_Blended(Fontz[Font].Handle, PChar(s), clr); -Result.x:= X + 3; -Result.y:= Y + 3; -SDL_UpperBlit(tmpsurf, nil, Surface, @Result); -SDL_FreeSurface(tmpsurf); -Result.x:= X; -Result.y:= Y; -Result.w:= w + 6; -Result.h:= h + 6 -end; - -procedure StoreLoad; -var i: TStuff; - ii: TSprite; - fi: THWFont; - s: string; - tmpsurf: PSDL_Surface; - - procedure WriteNames(Font: THWFont); - var Team: PTeam; - i: integer; - r: TSDL_Rect; - begin - r.x:= 0; - r.y:= 272; - Team:= TeamsList; - while Team<>nil do - begin - r.w:= 1968; - r:= WriteInRoundRect(StoreSurface, r.x, r.y, Team.Color, Font, Team.TeamName); - Team.NameRect:= r; - inc(r.y, r.h); - for i:= 0 to 7 do - if Team.Hedgehogs[i].Gear<>nil then - begin - r:= WriteInRoundRect(StoreSurface, r.x, r.y, Team.Color, Font, Team.Hedgehogs[i].Name); - Team.Hedgehogs[i].NameRect:= r; - inc(r.y, r.h) - end; - Team:= Team.Next - end; - end; - - procedure MakeCrossHairs; - var Team: PTeam; - r: TSDL_Rect; - tmpsurf: PSDL_Surface; - s: string; - TransColor: Longword; - begin - r.x:= 0; - r.y:= 256; - r.w:= 16; - r.h:= 16; - s:= Pathz[ptGraphics] + cCHFileName; - WriteToConsole(msgLoading + s + ' '); - tmpsurf:= IMG_Load(PChar(s)); - TryDo(tmpsurf <> nil, msgFailed, true); - WriteLnToConsole(msgOK); - TransColor:= SDL_MapRGB(tmpsurf.format, $FF, $FF, $FF); - TryDo(SDL_SetColorKey(tmpsurf, SDL_SRCCOLORKEY, TransColor) = 0, errmsgTransparentSet, true); - - Team:= TeamsList; - while Team<>nil do - begin - SDL_FillRect(StoreSurface, @r, Team.Color); - SDL_UpperBlit(tmpsurf, nil, StoreSurface, @r); - Team.CrossHairRect:= r; - inc(r.x, 16); - Team:= Team.Next - end; - - SDL_FreeSurface(tmpsurf) - end; - - procedure InitHealth; - var p: PTeam; - i, t: integer; - begin - p:= TeamsList; - t:= 0; - while p <> nil do - begin - for i:= 0 to cMaxHHIndex do - if p.Hedgehogs[i].Gear <> nil then - begin - p.Hedgehogs[i].HealthRect.y:= t; - RenderHealth(p.Hedgehogs[i]); - inc(t, p.Hedgehogs[i].HealthRect.h) - end; - p:= p.Next - end - end; - - procedure LoadGraves; - var p: PTeam; - l: integer; - begin - p:= TeamsList; - l:= 512; - while p <> nil do - begin - dec(l, 32); - if p.GraveName = '' then p.GraveName:= 'Simple'; - LoadToSurface(Pathz[ptGraves] + p.GraveName + '.png', StoreSurface, l, 512); - p.GraveRect.x:= l; - p.GraveRect.y:= 512; - p.GraveRect.w:= 32; - p.GraveRect.h:= 256; - p:= p.Next - end - end; - - procedure GetSkyColor; - var p: Longword; - begin - if SDL_MustLock(StoreSurface) then - SDLTry(SDL_LockSurface(StoreSurface) >= 0, true); - p:= Longword(StoreSurface.pixels) + Word(StuffPoz[sSky].x) * StoreSurface.format.BytesPerPixel; - case StoreSurface.format.BytesPerPixel of - 1: cSkyColor:= PByte(p)^; - 2: cSkyColor:= PWord(p)^; - 3: cSkyColor:= (PByte(p)^) or (PByte(p + 1)^ shl 8) or (PByte(p + 2)^ shl 16); - 4: cSkyColor:= PLongword(p)^; - end; - if SDL_MustLock(StoreSurface) then - SDL_UnlockSurface(StoreSurface) - end; - - procedure GetExplosionBorderColor; - var f: textfile; - c: integer; - begin - s:= Pathz[ptThemeCurrent] + cThemeCFGFilename; - WriteToConsole(msgLoading + s + ' '); - AssignFile(f, s); - {$I-} - Reset(f); - Readln(f, s); - Closefile(f); - {$I+} - TryDo(IOResult = 0, msgFailed, true); - WriteLnToConsole(msgOK); - val(s, cExplosionBorderColor, c); - if cFullScreen then - cExplosionBorderColor:= SDL_MapRGB(PixelFormat, (cExplosionBorderColor shr 16) and $FF, - (cExplosionBorderColor shr 8) and $FF, - cExplosionBorderColor and $FF) - else - cExplosionBorderColor:= SDL_MapRGB(LandSurface.format, (cExplosionBorderColor shr 16) and $FF, - (cExplosionBorderColor shr 8) and $FF, - cExplosionBorderColor and $FF) - end; - -begin -for fi:= Low(THWFont) to High(THWFont) do - with Fontz[fi] do - begin - s:= Pathz[ptFonts] + Name; - WriteToConsole(msgLoading + s + ' '); - Handle:= TTF_OpenFont(PChar(s), Height); - TryDo(Handle <> nil, msgFailed, true); - WriteLnToConsole(msgOK) - end; -AddProgress; -s:= Pathz[ptMapCurrent] + cLandFileName; -WriteToConsole(msgLoading + s + ' '); // загружаем текущее поле -//tmpsurf:= IMG_Load(PChar(s)); -tmpsurf:= LandSurface; -TryDo(tmpsurf <> nil, msgFailed, true); -if cFullScreen then - begin - LandSurface:= SDL_DisplayFormat(tmpsurf); - SDL_FreeSurface(tmpsurf); - end else LandSurface:= tmpsurf; -TryDo(SDL_SetColorKey(LandSurface, SDL_SRCCOLORKEY or SDL_RLEACCEL, 0) = 0, errmsgTransparentSet, true); -WriteLnToConsole(msgOK); - -GetExplosionBorderColor; - -AddProgress; -for i:= Low(TStuff) to High(TStuff) do - LoadToSurface(Pathz[StuffLoadData[i].Path] + StuffLoadData[i].FileName, StoreSurface, StuffPoz[i].x, StuffPoz[i].y); - -AddProgress; -WriteNames(fnt16); -MakeCrosshairs; -LoadGraves; - -GetSkyColor; - -AddProgress; -for ii:= Low(TSprite) to High(TSprite) do - with SpritesData[ii] do - begin - Surface:= LoadImage(Pathz[Path] + FileName); - TryDo(SDL_SetColorKey(Surface, SDL_SRCCOLORKEY or SDL_RLEACCEL, 0) = 0, errmsgTransparentSet, true) - end; - -AddProgress; -tmpsurf:= LoadImage(Pathz[ptGraphics] + cHHFileName); -HHSurface:= SDL_DisplayFormat(tmpsurf); -SDL_FreeSurface(tmpsurf); -TryDo(SDL_SetColorKey(HHSurface, SDL_SRCCOLORKEY or SDL_RLEACCEL, 0) = 0, errmsgTransparentSet, true); - -InitHealth; - -{$IFDEF DUMP} -SDL_SaveBMP_RW(LandSurface, SDL_RWFromFile('LandSurface.bmp', 'wb'), 1); -SDL_SaveBMP_RW(StoreSurface, SDL_RWFromFile('StoreSurface.bmp', 'wb'), 1); -SDL_SaveBMP_RW(TempSurface, SDL_RWFromFile('TempSurface.bmp', 'wb'), 1); -{$ENDIF} -end; - -procedure DrawFromRect(X, Y: integer; r: PSDL_Rect; SourceSurface, DestSurface: PSDL_Surface); -var rr: TSDL_Rect; -begin -rr.x:= X; -rr.y:= Y; -rr.w:= r.w; -rr.h:= r.h; -if SDL_UpperBlit(SourceSurface, r, DestSurface, @rr) < 0 then - begin - Writeln('Blit: ', SDL_GetError); - exit - end; -end; - -procedure DrawGear(Stuff: TStuff; X, Y: integer; Surface: PSDL_Surface); -begin -DrawFromRect(X, Y, @StuffPoz[Stuff], StoreSurface, Surface) -end; - -procedure DrawSpriteFromRect(r: TSDL_Rect; X, Y, Height, Position: integer; Surface: PSDL_Surface); -begin -r.y:= r.y + Height * Position; -r.h:= Height; -DrawFromRect(X, Y, @r, StoreSurface, Surface) -end; - -procedure DrawSprite(Sprite: TSprite; X, Y, Position: integer; Surface: PSDL_Surface); -var r: TSDL_Rect; -begin -r.x:= 0; -r.w:= SpritesData[Sprite].Width; -r.y:= Position * SpritesData[Sprite].Height; -r.h:= SpritesData[Sprite].Height; -DrawFromRect(X, Y, @r, SpritesData[Sprite].Surface, Surface) -end; - -procedure DXOutText(X, Y: Integer; Font: THWFont; s: string; Surface: PSDL_Surface); -var clr: TSDL_Color; - tmpsurf: PSDL_Surface; - r: TSDL_Rect; -begin -r.x:= X; -r.y:= Y; -SDL_GetRGB(cWhiteColor, PixelFormat, @clr.r, @clr.g, @clr.b); -tmpsurf:= TTF_RenderText_Solid(Fontz[Font].Handle, PChar(s), clr); -SDL_UpperBlit(tmpsurf, nil, Surface, @r); -SDL_FreeSurface(tmpsurf) -end; - -procedure DrawLand(X, Y: integer; Surface: PSDL_Surface); -const r: TSDL_Rect = (x: 0; y: 0; w: 2048; h: 1024); -begin -DrawFromRect(X, Y, @r, LandSurface, Surface) -end; - -procedure DrawCaption(X, Y: integer; Rect: TSDL_Rect; Surface: PSDL_Surface; const fromTempSurf: boolean = false); -begin -if fromTempSurf then DrawFromRect(X - (Rect.w) div 2, Y, @Rect, TempSurface, Surface) - else DrawFromRect(X - (Rect.w) div 2, Y, @Rect, StoreSurface, Surface) -end; - -procedure DrawHedgehog(X, Y: integer; Dir: integer; Pos, Step: LongWord; Surface: PSDL_Surface); -var r: TSDL_Rect; -begin -r.x:= Step * 32; -r.y:= Pos * 32; -if Dir = -1 then r.x:= cHHSurfaceWidth - 32 - r.x; -r.w:= 32; -r.h:= 32; -DrawFromRect(X, Y, @r, HHSurface, Surface) -end; - -procedure StoreRelease; -var ii: TSprite; -begin -for ii:= Low(TSprite) to High(TSprite) do - SDL_FreeSurface(SpritesData[ii].Surface); -SDL_FreeSurface( HHSurface ); -SDL_FreeSurface(TempSurface ); -SDL_FreeSurface(LandSurface ); -SDL_FreeSurface(StoreSurface ) -end; - -procedure RenderHealth(var Hedgehog: THedgehog); -var s: string; -begin -str(Hedgehog.Gear.Health, s); -Hedgehog.HealthRect:= WriteInRoundRect(TempSurface, Hedgehog.HealthRect.x, Hedgehog.HealthRect.y, Hedgehog.Team.Color, fnt16, s); -if Hedgehog.Gear.Damage > 0 then - begin - str(Hedgehog.Gear.Damage, s); - Hedgehog.HealthTagRect:= WriteInRoundRect(TempSurface, Hedgehog.HealthRect.x + Hedgehog.HealthRect.w, Hedgehog.HealthRect.y, Hedgehog.Team.Color, fnt16, s) - end; -end; - -function RenderString(var s: shortstring; Color, Pos: integer): TSDL_Rect; -begin -Result:= WriteInRoundRect(TempSurface, 64, Pos * Fontz[fntBig].Height, Color, fntBig, s); -end; - -procedure AddProgress; -const Step: Longword = 0; - ProgrSurf: PSDL_Surface = nil; - MaxCalls = 10; // MaxCalls should be the count of calls to AddProgress to prevent memory leakage -var r: TSDL_Rect; -begin -if Step = 0 then - begin - WriteToConsole(msgLoading + 'progress sprite... '); - ProgrSurf:= IMG_Load(PChar(string('Data\Graphics\BigDigits.png'))); - SDLTry(ProgrSurf <> nil, true); - WriteLnToConsole(msgOK) - end; -SDL_FillRect(SDLPrimSurface, nil, 0); -r.x:= 0; -r.w:= 32; -r.h:= 32; -r.y:= Step * 32; -DrawFromRect(cScreenWidth div 2 - 16, cScreenHeight div 2 - 16, @r, ProgrSurf, SDLPrimSurface); -SDL_Flip(SDLPrimSurface); -inc(Step); -if Step = MaxCalls then - begin - WriteLnToConsole('Freeing progress surface... '); - SDL_FreeSurface(ProgrSurf) - end; -end; - -function LoadImage(filename: string): PSDL_Surface; -begin -WriteToConsole(msgLoading + filename + '... '); -Result:= IMG_Load(PChar(filename)); -TryDo(Result <> nil, msgFailed, true); -WriteLnToConsole(msgOK) -end; - -end. +(* + * Hedgewars, a worms-like game + * Copyright (c) 2004, 2005 Andrey Korotaev + * + * 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 ffe4ad26a64c -r bcbd7adb4e4b hedgewars/uTeams.pas --- a/hedgewars/uTeams.pas Mon Aug 22 21:38:06 2005 +0000 +++ b/hedgewars/uTeams.pas Tue Aug 23 16:17:53 2005 +0000 @@ -1,268 +1,277 @@ -(* - * Hedgewars, a worms-like game - * Copyright (c) 2004, 2005 Andrey Korotaev - * - * 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. +(* + * 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); +function TeamSize(p: PTeam): Longword; + +implementation +uses uMisc, uStore, uWorld, uIO, uAIActions; + +procedure FreeTeamsList; forward; + +procedure SwitchHedgehog; +var tteam: PTeam; + th: integer; +begin +FreeActionsList; +TargetPoint.X:= NoPointX; +if CurrentTeam = nil then OutError('nil Team', true); +tteam:= CurrentTeam; +with CurrentTeam.Hedgehogs[CurrentTeam.CurrHedgehog] do + if Gear <> nil then Gear.Message:= 0; + +repeat + CurrentTeam:= CurrentTeam.Next; + if CurrentTeam = nil then CurrentTeam:= TeamsList; + th:= CurrentTeam.CurrHedgehog; + repeat + CurrentTeam.CurrHedgehog:= Succ(CurrentTeam.CurrHedgehog) mod cMaxHHIndex; + until (CurrentTeam.Hedgehogs[CurrentTeam.CurrHedgehog].Gear <> nil) or (CurrentTeam.CurrHedgehog = th) +until (CurrentTeam.Hedgehogs[CurrentTeam.CurrHedgehog].Gear <> nil) or (CurrentTeam = tteam); + +if (CurrentTeam = tteam) then + begin + if GameType = gmtDemo then + begin + SendIPC('q'); + GameState:= gsExit; + exit + end else OutError('There''s only one team on map!', true); + end; +with CurrentTeam.Hedgehogs[CurrentTeam.CurrHedgehog] do + begin + AttacksNum:= 0; + with Gear^ do + begin + State:= State or gstHHDriven; + Active:= true + end; + FollowGear:= Gear + end; +ResetKbd; +cWindSpeed:= (GetRandom * 2 - 1) * cMaxWindSpeed; +{$IFDEF DEBUGFILE}AddFileLog('Wind = '+FloatToStr(cWindSpeed));{$ENDIF} +ApplyAmmoChanges(@CurrentTeam.Hedgehogs[CurrentTeam.CurrHedgehog]); +TurnTimeLeft:= cHedgehogTurnTime +end; + +procedure SetFirstTurnHedgehog; +var i: integer; +begin +if CurrentTeam=nil then OutError('nil Team (SetFirstTurnHedgehog)', true); +i:= 0; +while (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; + +function TeamSize(p: PTeam): Longword; +var i: Longword; +begin +Result:= 0; +for i:= 0 to cMaxHHIndex do + if p.Hedgehogs[i].Gear <> nil then inc(Result) +end; + +initialization + +finalization + +FreeTeamsList + +end. diff -r ffe4ad26a64c -r bcbd7adb4e4b hedgewars/uWorld.pas --- a/hedgewars/uWorld.pas Mon Aug 22 21:38:06 2005 +0000 +++ b/hedgewars/uWorld.pas Tue Aug 23 16:17:53 2005 +0000 @@ -1,338 +1,338 @@ -(* - * Hedgewars, a worms-like game - * Copyright (c) 2004, 2005 Andrey Korotaev - * - * Distributed under the terms of the BSD-modified licence: - * - * Permission is hereby granted, free of charge, to any person obtaining a copy - * of this software and associated documentation files (the "Software"), to deal - * with the Software without restriction, including without limitation the - * rights to use, copy, modify, merge, publish, distribute, sublicense, and/or - * sell copies of the Software, and to permit persons to whom the Software is - * furnished to do so, subject to the following conditions: - * - * 1. Redistributions of source code must retain the above copyright notice, - * this list of conditions and the following disclaimer. - * 2. Redistributions in binary form must reproduce the above copyright notice, - * this list of conditions and the following disclaimer in the documentation - * and/or other materials provided with the distribution. - * 3. The name of the author may not be used to endorse or promote products - * derived from this software without specific prior written permission. - * - * THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR IMPLIED - * WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF - * MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO - * EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, - * SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, - * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; - * OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, - * WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR - * OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF - * ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. - *) - -unit uWorld; -interface -uses SDLh, uGears; -{$INCLUDE options.inc} -const WorldDx: integer = -512; - WorldDy: integer = -256; - -procedure InitWorld; -procedure DrawWorld(Lag: integer; Surface: PSDL_Surface); -procedure AddCaption(s: shortstring; Color, Group: LongWord); -procedure MoveWorld; -procedure AdjustMPoint; - -{$IFDEF COUNTTICKS} -var cntTicks: LongWord; -{$ENDIF} -var FollowGear: PGear = nil; - -implementation -uses uStore, uMisc, uConsts, uTeams, uIO; -const RealTicks: Longword = 0; - Frames: Longword = 0; - FPS: Longword = 0; - CountTicks: Longword = 0; - prevPoint: TPoint = (X: 0; Y: 0); - -type TCaptionStr = record - r: TSDL_Rect; - StorePos, - Group, - EndTime: LongWord; - end; - -var cWaterSprCount: integer; - Captions: array[0..Pred(cMaxCaptions)] of TCaptionStr; - -procedure InitWorld; -begin -cLandYShift:= cWaterLine + 64; -cWaterSprCount:= 1 + cScreenWidth div (SpritesData[sprWater].Width) -end; - -procedure DrawWorld(Lag: integer; Surface: PSDL_Surface); -var i, t: integer; - r: TSDL_Rect; - team: PTeam; -begin -// синее небо -inc(RealTicks, Lag); -r.h:= WorldDy; -if r.h > 0 then - begin - if r.h > cScreenHeight then r.h:= cScreenHeight; - r.x:= 0; - r.y:= 0; - r.w:= cScreenWidth; - SDL_FillRect(Surface, @r, cSkyColor) - end; -// задний фон -for i:= 0 to (cScreenWidth shr 6) do - DrawGear(sSky, i*64, WorldDy, Surface); - -for i:= -1 to 3 do // горизонт - DrawGear(sHorizont, i * 512 + (((WorldDx * 3) div 5) and $1FF), cWaterLine - 256 + WorldDy, Surface); - -// волны -{$WARNINGS OFF} -for i:= -1 to cWaterSprCount do DrawSprite(sprWater, i * 256 + ((WorldDx + (RealTicks shr 6) ) and $FF), cWaterLine + WorldDy - 40, (((GameTicks shr 7) + 2) mod 12), Surface); -for i:= -1 to cWaterSprCount do DrawSprite(sprWater, i * 256 + ((WorldDx - (RealTicks shr 6) + 192) and $FF), cWaterLine + WorldDy - 30, (((GameTicks shr 7) + 8) mod 12), Surface); -{$WARNINGS ON} - -// поле -DrawLand(WorldDx, WorldDy, Surface); -// вода -r.y:= WorldDy + cWaterLine + 32; -if r.y < cScreenHeight then - begin - r.h:= cScreenHeight - r.y; - r.x:= 0; - r.w:= cScreenWidth; - SDL_FillRect(Surface, @r, cWaterColor) - end; - -DrawGears(Surface); - -team:= TeamsList; -while team<>nil do - begin - for i:= 0 to 7 do - with team.Hedgehogs[i] do - if Gear<>nil then - if Gear.State = 0 then - begin // ёжик не находится под управлением - DrawCaption( round(Gear.X) + WorldDx, - round(Gear.Y) - cHHHalfHeight - 30 + WorldDy, - HealthRect, Surface, true); - DrawCaption( round(Gear.X) + WorldDx, - round(Gear.Y) - cHHHalfHeight - 54 + WorldDy, - NameRect, Surface); -// DrawCaption( round(Gear.X) + WorldDx, -// round(Gear.Y) - Gear.HalfHeight - 60 + WorldDy, -// Team.NameRect, Surface); - end else // ёжик, которым счас управляем - begin - if (Gear.State and (gstMoving or gstAttacked or gstDrowning or gstFalling))=0 then // рисуем прицел и, если бот думает, знак вопроса - if (Gear.State and gstHHThinking) <> 0 then - DrawGear(sQuestion, Round(Gear.X) - 10 + WorldDx, Round(Gear.Y) - cHHHalfHeight - 34 + WorldDy, Surface) - else - DrawCaption(Round(Gear.X + Sign(Gear.dX) * Sin(Gear.Angle*pi/cMaxAngle)*60) + WorldDx, - Round(Gear.Y - Cos(Gear.Angle*pi/cMaxAngle)*60) + WorldDy - 5, - Team.CrossHairRect, Surface) - end; - team:= team.Next - end; - -// волны -{$WARNINGS OFF} -for i:= -1 to cWaterSprCount do DrawSprite(sprWater, i * 256 + ((WorldDx + (RealTicks shr 6) + 64) and $FF), cWaterLine + WorldDy - 20, (((GameTicks shr 7) + 4 ) mod 12), Surface); -for i:= -1 to cWaterSprCount do DrawSprite(sprWater, i * 256 + ((WorldDx - (RealTicks shr 6) + 128) and $FF), cWaterLine + WorldDy - 10, (((GameTicks shr 7) + 10) mod 12), Surface); -for i:= -1 to cWaterSprCount do DrawSprite(sprWater, i * 256 + ((WorldDx + (RealTicks shr 6) ) and $FF), cWaterLine + WorldDy , (((GameTicks shr 7) + 6 ) mod 12), Surface); -{$WARNINGS ON} - -if TurnTimeLeft <> 0 then - begin - i:= Succ(Pred(TurnTimeLeft) div 1000); - if i>99 then t:= 112 - else if i>9 then t:= 96 - else t:= 80; - DrawSprite(sprFrame, t, cScreenHeight - 48, 1, Surface); - while i > 0 do - begin - dec(t, 32); - DrawSprite(sprBigDigit, t, cScreenHeight - 48, i mod 10, Surface); - i:= i div 10 - end; - DrawSprite(sprFrame, t - 4, cScreenHeight - 48, 0, Surface); - end; -if CurrentTeam <> nil then - case AttackBar of - 1: begin - r:= StuffPoz[sPowerBar]; - {$WARNINGS OFF} - r.w:= (CurrentTeam.Hedgehogs[CurrentTeam.CurrHedgehog].Gear.Power * 256) div cPowerDivisor; - {$WARNINGS ON} - DrawSpriteFromRect(r, cScreenWidth - 272, cScreenHeight - 48, 16, 0, Surface); - end; - end; - -// Указатель на цель -if TargetPoint.X <> NoPointX then DrawSprite(sprTargetP, TargetPoint.X + WorldDx - 16, TargetPoint.Y + WorldDy - 16, 0, Surface); - -// Captions -i:= 0; -while (i < cMaxCaptions) do - begin - with Captions[i] do - if EndTime > 0 then DrawCaption(cScreenWidth div 2, 8 + i * 32 + cConsoleYAdd, r, Surface, true); - inc(i) - end; -while (Captions[0].EndTime > 0) and (Captions[0].EndTime <= RealTicks) do - begin - for i:= 1 to Pred(cMaxCaptions) do - Captions[Pred(i)]:= Captions[i]; - Captions[Pred(cMaxCaptions)].EndTime:= 0 - end; - -// Указание на лаг -if isInLag then DrawSprite(sprLag, 32, 32 + cConsoleYAdd, (RealTicks shr 7) mod 7, Surface); - -// Курсор -if isCursorVisible then DrawSprite(sprArrow, CursorPoint.X, CursorPoint.Y, (RealTicks shr 6) mod 8, Surface); - -{$IFDEF COUNTTICKS} -DXOutText(10, 10, fnt16, inttostr(cntTicks), Surface); -{$ENDIF} - -inc(Frames); -inc(CountTicks, Lag); -if CountTicks >= 1000 then - begin - FPS:= Frames; - Frames:= 0; - CountTicks:= 0; - end; -if cShowFPS then DXOutText(cScreenWidth - 50, 10, fnt16, inttostr(FPS) + ' fps', Surface) -end; - -procedure AddCaption(s: shortstring; Color, Group: LongWord); -var i, t, m, k: LongWord; -begin -i:= 0; -while (i < cMaxCaptions) and (Captions[i].Group <> Group)do inc(i); -if i < cMaxCaptions then - begin - while (i < Pred(cMaxCaptions)) do - begin - Captions[i]:= Captions[Succ(i)]; - inc(i) - end; - Captions[Pred(cMaxCaptions)].EndTime:= 0 - end; - -if Captions[Pred(cMaxCaptions)].EndTime > 0 then - begin - m:= Pred(cMaxCaptions); - for i:= 1 to m do - Captions[Pred(i)]:= Captions[i]; - Captions[m].EndTime:= 0 - end else - begin - m:= 0; - while (m < cMaxCaptions)and(Captions[m].EndTime > 0) do inc(m) - end; - -k:= 0; -for i:= 0 to Pred(cMaxCaptions) do - for t:= 0 to Pred(cMaxCaptions) do - if (Captions[t].EndTime > 0)and(Captions[t].StorePos = k) then inc(k); - -Captions[m].r:= RenderString(s, Color, k); -Captions[m].StorePos:= k; -Captions[m].Group:= Group; -Captions[m].EndTime:= RealTicks + 1200 -end; - -procedure MoveWorld; -const PrevSentPointTime: LongWord = 0; -var s: string[9]; -begin -if not (CurrentTeam.ExtDriven and isCursorVisible) then SDL_GetMouseState(@CursorPoint.X, @CursorPoint.Y); - -if (FollowGear <> nil) then - if abs(CursorPoint.X - prevPoint.X + CursorPoint.Y - prevpoint.Y) > 4 then - begin - FollowGear:= nil; - AdjustMPoint; - exit - end - else begin - CursorPoint.x:= (CursorPoint.x + (round(FollowGear.X + Sign(FollowGear.dX) * 100) + WorldDx)) div 2; - CursorPoint.y:= (CursorPoint.y + (round(FollowGear.Y) + WorldDy)) div 2 - end; - -if ((CursorPoint.X = prevPoint.X)and(CursorPoint.Y = prevpoint.Y)) then exit; - -if isCursorVisible then - begin - if (not CurrentTeam.ExtDriven)and(GameTicks >= PrevSentPointTime + cSendCursorPosTime) then - begin - s[0]:= #9; - s[1]:= 'P'; - PInteger(@s[2])^:= CursorPoint.X - WorldDx; - PInteger(@s[6])^:= CursorPoint.Y - WorldDy; - SendIPC(s); - PrevSentPointTime:= GameTicks - end; - end; -if isCursorVisible or (FollowGear <> nil) then - begin - if CursorPoint.X < cScreenEdgesDist then - begin - WorldDx:= WorldDx - CursorPoint.X + cScreenEdgesDist; - CursorPoint.X:= cScreenEdgesDist - end else - if CursorPoint.X > cScreenWidth - cScreenEdgesDist then - begin - WorldDx:= WorldDx - CursorPoint.X + cScreenWidth - cScreenEdgesDist; - CursorPoint.X:= cScreenWidth - cScreenEdgesDist - end; - if CursorPoint.Y < cScreenEdgesDist then - begin - WorldDy:= WorldDy - CursorPoint.Y + cScreenEdgesDist; - CursorPoint.Y:= cScreenEdgesDist - end else - if CursorPoint.Y > cScreenHeight - cScreenEdgesDist then - begin - WorldDy:= WorldDy - CursorPoint.Y + cScreenHeight - cScreenEdgesDist; - CursorPoint.Y:= cScreenHeight - cScreenEdgesDist - end; - end else - begin - WorldDx:= WorldDx - CursorPoint.X + (cScreenWidth shr 1); - WorldDy:= WorldDy - CursorPoint.Y + (cScreenHeight shr 1); - CursorPoint.X:= (cScreenWidth shr 1); - CursorPoint.Y:= (cScreenHeight shr 1); - end; -SDL_WarpMouse(CursorPoint.X, CursorPoint.Y); -prevPoint:= CursorPoint; -if WorldDy < cScreenHeight - cLandYShift - cVisibleWater then WorldDy:= cScreenHeight - cLandYShift - cVisibleWater; -if WorldDy > 2048 then WorldDy:= 2048; -if WorldDx < -2048 then WorldDx:= -2048; -if WorldDx > cScreenWidth then WorldDx:= cScreenWidth; -end; - -procedure AdjustMPoint; -begin -prevPoint.x:= cScreenWidth div 2; -prevPoint.y:= cScreenHeight div 2; -SDL_WarpMouse(prevPoint.X, prevPoint.Y); -end; - -initialization -FillChar(Captions, sizeof(Captions), 0) - -end. +(* + * Hedgewars, a worms-like game + * Copyright (c) 2004, 2005 Andrey Korotaev + * + * 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.