diff -r 1d9e0a541c62 -r 803b277e4894 hedgewars/CCHandlers.inc --- a/hedgewars/CCHandlers.inc Sat Mar 06 01:26:12 2010 +0000 +++ b/hedgewars/CCHandlers.inc Sat Mar 06 10:54:24 2010 +0000 @@ -1,20 +1,20 @@ (* - * Hedgewars, a free turn based strategy game - * Copyright (c) 2004-2009 Andrey Korotaev - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published by - * the Free Software Foundation; version 2 of the License - * - * This program is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU General Public License for more details. - * - * You should have received a copy of the GNU General Public License - * along with this program; if not, write to the Free Software - * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA - *) +* Hedgewars, a free turn based strategy game +* Copyright (c) 2004-2009 Andrey Korotaev +* +* This program is free software; you can redistribute it and/or modify +* it under the terms of the GNU General Public License as published by +* the Free Software Foundation; version 2 of the License +* +* This program is distributed in the hope that it will be useful, +* but WITHOUT ANY WARRANTY; without even the implied warranty of +* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +* GNU General Public License for more details. +* +* You should have received a copy of the GNU General Public License +* along with this program; if not, write to the Free Software +* Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA +*) function CheckNoTeamOrHH: boolean; var bRes: boolean; @@ -22,7 +22,7 @@ bRes:= (CurrentTeam = nil) or (CurrentHedgehog^.Gear = nil); {$IFDEF DEBUGFILE} if bRes then - if CurrentTeam = nil then AddFileLog('CONSOLE: CurTeam = nil') +if CurrentTeam = nil then AddFileLog('CONSOLE: CurTeam = nil') else AddFileLog('CONSOLE: CurTeam <> nil, Gear = nil'); {$ENDIF} CheckNoTeamOrHH:= bRes; @@ -42,10 +42,10 @@ procedure chConfirm(var s: shortstring); begin if GameState = gsConfirm then - begin - SendIPC('Q'); - GameState:= gsExit - end + begin + SendIPC('Q'); + GameState:= gsExit + end else begin GameState:= gsChat; @@ -63,12 +63,12 @@ var i, c: LongInt; begin if isDeveloperMode then - begin - val(s, i, c); - if (c <> 0) or (i = 0) then exit; - TryDo(i <= cNetProtoVersion, 'Protocol version mismatch: engine is too old', true); - TryDo(i >= cNetProtoVersion, 'Protocol version mismatch: engine is too new', true) - end +begin +val(s, i, c); +if (c <> 0) or (i = 0) then exit; +TryDo(i <= cNetProtoVersion, 'Protocol version mismatch: engine is too old', true); +TryDo(i >= cNetProtoVersion, 'Protocol version mismatch: engine is too new', true) +end end; procedure chAddTeam(var s: shortstring); @@ -76,22 +76,22 @@ ts, cs: shortstring; begin if isDeveloperMode then - begin - SplitBySpace(s, cs); - SplitBySpace(cs, ts); - val(cs, Color); - TryDo(Color <> 0, 'Error: black team color', true); +begin +SplitBySpace(s, cs); +SplitBySpace(cs, ts); +val(cs, Color); +TryDo(Color <> 0, 'Error: black team color', true); - // color is always little endian so the mask must be constant also in big endian archs - Color:= Color or $FF000000; - - AddTeam(Color); - CurrentTeam^.TeamName:= ts; - CurrentTeam^.PlayerHash:= s; - if GameType in [gmtDemo, gmtSave] then CurrentTeam^.ExtDriven:= true; +// color is always little endian so the mask must be constant also in big endian archs +Color:= Color or $FF000000; + +AddTeam(Color); +CurrentTeam^.TeamName:= ts; +CurrentTeam^.PlayerHash:= s; +if GameType in [gmtDemo, gmtSave] then CurrentTeam^.ExtDriven:= true; - CurrentTeam^.voicepack:= AskForVoicepack('Default') - end +CurrentTeam^.voicepack:= AskForVoicepack('Default') +end end; procedure chTeamLocal(var s: shortstring); @@ -146,22 +146,22 @@ begin if (not isDeveloperMode) or (CurrentTeam = nil) then exit; with CurrentTeam^ do - begin - SplitBySpace(id, s); - CurrentHedgehog:= @Hedgehogs[HedgehogsNumber]; - val(id, CurrentHedgehog^.BotLevel); - Gear:= AddGear(0, 0, gtHedgehog, 0, _0, _0, 0); - SplitBySpace(s, id); - val(s, Gear^.Health); - TryDo(Gear^.Health > 0, 'Invalid hedgehog health', true); - PHedgehog(Gear^.Hedgehog)^.Team:= CurrentTeam; + begin + SplitBySpace(id, s); + CurrentHedgehog:= @Hedgehogs[HedgehogsNumber]; + val(id, CurrentHedgehog^.BotLevel); + Gear:= AddGear(0, 0, gtHedgehog, 0, _0, _0, 0); + SplitBySpace(s, id); + val(s, Gear^.Health); + TryDo(Gear^.Health > 0, 'Invalid hedgehog health', true); + PHedgehog(Gear^.Hedgehog)^.Team:= CurrentTeam; if (GameFlags and gfSharedAmmo) <> 0 then CurrentHedgehog^.AmmoStore:= Clan^.ClanIndex else CurrentHedgehog^.AmmoStore:= TeamsCount - 1; - CurrentHedgehog^.Gear:= Gear; - CurrentHedgehog^.Name:= id; + CurrentHedgehog^.Gear:= Gear; + CurrentHedgehog^.Name:= id; CurrHedgehog:= HedgehogsNumber; - inc(HedgehogsNumber) - end + inc(HedgehogsNumber) + end end; procedure chSetHat(var s: shortstring); @@ -170,12 +170,12 @@ with CurrentTeam^ do begin if not CurrentHedgehog^.King then - if (s = '') or - (((GameFlags and gfKing) <> 0) and (s = 'crown')) or - ((Length(s) > 39) and (Copy(s,1,8) = 'Reserved') and (Copy(s,9,32) <> PlayerHash)) then - CurrentHedgehog^.Hat:= 'NoHat' - else - CurrentHedgehog^.Hat:= s + if (s = '') or + (((GameFlags and gfKing) <> 0) and (s = 'crown')) or + ((Length(s) > 39) and (Copy(s,1,8) = 'Reserved') and (Copy(s,9,32) <> PlayerHash)) then + CurrentHedgehog^.Hat:= 'NoHat' + else + CurrentHedgehog^.Hat:= s end; end; @@ -206,7 +206,7 @@ if s[byte(s[0])]='"' then Delete(s, byte(s[0]), 1); b:= KeyNameToCode(id); if b = 0 then OutError(errmsgUnknownVariable + ' "' + id + '"', false) - else CurrentTeam^.Binds[b]:= s + else CurrentTeam^.Binds[b]:= s end; procedure chCurU_p(var s: shortstring); @@ -263,7 +263,7 @@ if CheckNoTeamOrHH then exit; if not CurrentTeam^.ExtDriven then SendIPC('l'); with CurrentHedgehog^.Gear^ do - Message:= Message and not gm_Left + Message:= Message and not gm_Left end; procedure chRight_p(var s: shortstring); @@ -280,7 +280,7 @@ if CheckNoTeamOrHH then exit; if not CurrentTeam^.ExtDriven then SendIPC('r'); with CurrentHedgehog^.Gear^ do - Message:= Message and not gm_Right + Message:= Message and not gm_Right end; procedure chUp_p(var s: shortstring); @@ -297,7 +297,7 @@ if CheckNoTeamOrHH then exit; if not CurrentTeam^.ExtDriven then SendIPC('u'); with CurrentHedgehog^.Gear^ do - Message:= Message and not gm_Up + Message:= Message and not gm_Up end; procedure chDown_p(var s: shortstring); @@ -314,7 +314,7 @@ if CheckNoTeamOrHH then exit; if not CurrentTeam^.ExtDriven then SendIPC('d'); with CurrentHedgehog^.Gear^ do - Message:= Message and not gm_Down + Message:= Message and not gm_Down end; procedure chPrecise_p(var s: shortstring); @@ -331,7 +331,7 @@ if CheckNoTeamOrHH then exit; if not CurrentTeam^.ExtDriven then SendIPC('z'); with CurrentHedgehog^.Gear^ do - Message:= Message and not gm_Precise + Message:= Message and not gm_Precise end; procedure chLJump(var s: shortstring); @@ -357,26 +357,26 @@ if CheckNoTeamOrHH then exit; bShowFinger:= false; with CurrentHedgehog^.Gear^ do - begin - {$IFDEF DEBUGFILE}AddFileLog('/+attack: hedgehog''s Gear^.State = '+inttostr(State));{$ENDIF} - if ((State and gstHHDriven) <> 0) then + begin + {$IFDEF DEBUGFILE}AddFileLog('/+attack: hedgehog''s Gear^.State = '+inttostr(State));{$ENDIF} + if ((State and gstHHDriven) <> 0) then begin FollowGear:= CurrentHedgehog^.Gear; if not CurrentTeam^.ExtDriven then SendIPC('A'); Message:= Message or gm_Attack end - end + end end; procedure chAttack_m(var s: shortstring); begin if CheckNoTeamOrHH then exit; with CurrentHedgehog^.Gear^ do - begin - if not CurrentTeam^.ExtDriven and + begin + if not CurrentTeam^.ExtDriven and ((Message and gm_Attack) <> 0) then SendIPC('a'); - Message:= Message and not gm_Attack - end + Message:= Message and not gm_Attack + end end; procedure chSwitch(var s: shortstring); @@ -384,7 +384,7 @@ if CheckNoTeamOrHH then exit; if not CurrentTeam^.ExtDriven then SendIPC('S'); with CurrentHedgehog^.Gear^ do - Message:= Message or gm_Switch + Message:= Message or gm_Switch end; procedure chNextTurn(var s: shortstring); @@ -401,9 +401,9 @@ SendIPC('s' + s); if copy(s, 1, 4) = '/me ' then - s:= #2'* ' + UserNick + ' ' + copy(s, 5, Length(s) - 4) + s:= #2'* ' + UserNick + ' ' + copy(s, 5, Length(s) - 4) else - s:= #1 + UserNick + ': ' + s; + s:= #1 + UserNick + ': ' + s; AddChatString(s) end; @@ -424,10 +424,10 @@ if not CurrentTeam^.ExtDriven then SendIPC(s); with CurrentHedgehog^.Gear^ do - begin - Message:= Message or gm_Timer; - MsgParam:= byte(s[1]) - ord('0') - end + begin + Message:= Message or gm_Timer; + MsgParam:= byte(s[1]) - ord('0') + end end; procedure chSlot(var s: shortstring); @@ -439,10 +439,10 @@ if slot > cMaxSlotIndex then exit; if not CurrentTeam^.ExtDriven then SendIPC(char(byte(s[1]) + 79)); with CurrentHedgehog^.Gear^ do - begin - Message:= Message or gm_Slot; - MsgParam:= slot - end + begin + Message:= Message or gm_Slot; + MsgParam:= slot + end end; procedure chSetWeapon(var s: shortstring); @@ -454,10 +454,10 @@ if not CurrentTeam^.ExtDriven then SendIPC('w' + s); with CurrentHedgehog^.Gear^ do - begin - Message:= Message or gm_Weapon; - MsgParam:= byte(s[1]) - end + begin + Message:= Message or gm_Weapon; + MsgParam:= byte(s[1]) + end end; procedure chTaunt(var s: shortstring); @@ -469,10 +469,10 @@ if not CurrentTeam^.ExtDriven then SendIPC('t' + s); with CurrentHedgehog^.Gear^ do - begin - Message:= Message or gm_Animate; - MsgParam:= byte(s[1]) - end + begin + Message:= Message or gm_Animate; + MsgParam:= byte(s[1]) + end end; procedure chHogSay(var s: shortstring); @@ -481,7 +481,7 @@ begin text:= copy(s, 2, Length(s)-1); if CheckNoTeamOrHH - or ((CurrentHedgehog^.Gear^.State and gstHHDriven) = 0) then +or ((CurrentHedgehog^.Gear^.State and gstHHDriven) = 0) then begin chSay(text); exit @@ -493,11 +493,11 @@ begin Gear:= AddVisualGear(0, 0, vgtSpeechBubble); if Gear <> nil then - begin - Gear^.Hedgehog:= CurrentHedgehog; - Gear^.Text:= text; - Gear^.FrameTicks:= byte(s[1]) - end + begin + Gear^.Hedgehog:= CurrentHedgehog; + Gear^.Text:= text; + Gear^.FrameTicks:= byte(s[1]) + end end else begin @@ -520,42 +520,42 @@ begin if CheckNoTeamOrHH then exit; if bShowAmmoMenu then - begin - bSelected:= true; - exit - end; + begin + bSelected:= true; + exit + end; with CurrentHedgehog^.Gear^, - CurrentHedgehog^ do - if (State and gstHHChooseTarget) <> 0 then - begin - isCursorVisible:= false; - if not CurrentTeam^.ExtDriven then - begin - if fromAI then - begin - TargetPoint.X:= putX; - TargetPoint.Y:= putY - end else - begin - TargetPoint.X:= CursorPoint.X - WorldDx; - TargetPoint.Y:= cScreenHeight - CursorPoint.Y - WorldDy; - end; - SendIPCXY('p', TargetPoint.X, TargetPoint.Y); - end - else - begin - TargetPoint.X:= putX; - TargetPoint.Y:= putY - end; - {$IFDEF DEBUGFILE}AddFilelog('put: ' + inttostr(TargetPoint.X) + ', ' + inttostr(TargetPoint.Y));{$ENDIF} - State:= State and not gstHHChooseTarget; - if (Ammo^[CurSlot, CurAmmo].Propz and ammoprop_AttackingPut) <> 0 then - Message:= Message or gm_Attack; - end - else - if CurrentTeam^.ExtDriven then - OutError('got /put while not being in choose target mode', false) + CurrentHedgehog^ do + if (State and gstHHChooseTarget) <> 0 then + begin + isCursorVisible:= false; + if not CurrentTeam^.ExtDriven then + begin + if fromAI then + begin + TargetPoint.X:= putX; + TargetPoint.Y:= putY + end else + begin + TargetPoint.X:= CursorPoint.X - WorldDx; + TargetPoint.Y:= cScreenHeight - CursorPoint.Y - WorldDy; + end; + SendIPCXY('p', TargetPoint.X, TargetPoint.Y); + end + else + begin + TargetPoint.X:= putX; + TargetPoint.Y:= putY + end; + {$IFDEF DEBUGFILE}AddFilelog('put: ' + inttostr(TargetPoint.X) + ', ' + inttostr(TargetPoint.Y));{$ENDIF} + State:= State and not gstHHChooseTarget; + if (Ammo^[CurSlot, CurAmmo].Propz and ammoprop_AttackingPut) <> 0 then + Message:= Message or gm_Attack; + end + else + if CurrentTeam^.ExtDriven then + OutError('got /put while not being in choose target mode', false) end; procedure chPut(var s: shortstring); @@ -578,50 +578,50 @@ procedure chSetMap(var s: shortstring); begin if isDeveloperMode then - begin - Pathz[ptMapCurrent]:= Pathz[ptMaps] + '/' + s; - InitStepsFlags:= InitStepsFlags or cifMap - end +begin +Pathz[ptMapCurrent]:= Pathz[ptMaps] + '/' + s; +InitStepsFlags:= InitStepsFlags or cifMap +end end; procedure chSetTheme(var s: shortstring); begin if isDeveloperMode then - begin - Pathz[ptCurrTheme]:= Pathz[ptThemes] + '/' + s; - InitStepsFlags:= InitStepsFlags or cifTheme - end +begin +Pathz[ptCurrTheme]:= Pathz[ptThemes] + '/' + s; +InitStepsFlags:= InitStepsFlags or cifTheme +end end; procedure chSetSeed(var s: shortstring); begin if isDeveloperMode then - begin - SetRandomSeed(s); - cSeed:= s; - InitStepsFlags:= InitStepsFlags or cifRandomize - end +begin +SetRandomSeed(s); +cSeed:= s; +InitStepsFlags:= InitStepsFlags or cifRandomize +end end; procedure chAmmoMenu(var s: shortstring); begin if CheckNoTeamOrHH then - bShowAmmoMenu:= true +bShowAmmoMenu:= true else - with CurrentTeam^ do +with CurrentTeam^ do with Hedgehogs[CurrHedgehog] do - begin - bSelected:= false; + begin + bSelected:= false; - if bShowAmmoMenu then bShowAmmoMenu:= false - else if ((Gear^.State and (gstAttacking or gstAttacked)) <> 0) or (MultiShootAttacks > 0) - or ((Gear^.State and gstHHDriven) = 0) then else bShowAmmoMenu:= true - end + if bShowAmmoMenu then bShowAmmoMenu:= false + else if ((Gear^.State and (gstAttacking or gstAttacked)) <> 0) or (MultiShootAttacks > 0) + or ((Gear^.State and gstHHDriven) = 0) then else bShowAmmoMenu:= true + end end; procedure chFullScr(var s: shortstring); var flags: Longword = 0; - ico: PSDL_Surface; + ico: PSDL_Surface; {$IFDEF DEBUGFILE} buf: array[byte] of char; {$ENDIF} @@ -629,66 +629,66 @@ window: PSDL_Window; {$ENDIF} begin - if Length(s) = 0 then cFullScreen:= not cFullScreen - else cFullScreen:= s = '1'; + if Length(s) = 0 then cFullScreen:= not cFullScreen + else cFullScreen:= s = '1'; {$IFDEF DEBUGFILE} - AddFileLog('Prepare to change video parameters...'); + AddFileLog('Prepare to change video parameters...'); {$ENDIF} - flags:= SDL_OPENGL;// or SDL_RESIZABLE; + flags:= SDL_OPENGL;// or SDL_RESIZABLE; - if cFullScreen then - begin - flags:= flags or SDL_FULLSCREEN; - cScreenWidth:= cInitWidth; - cScreenHeight:= cInitHeight - end; + if cFullScreen then + begin + flags:= flags or SDL_FULLSCREEN; + cScreenWidth:= cInitWidth; + cScreenHeight:= cInitHeight + end; - // load window icon - {$IFNDEF DARWIN} - ico:= LoadImage(Pathz[ptGraphics] + '/hwengine', ifIgnoreCaps); - {$ELSE} - ico:= LoadImage(Pathz[ptGraphics] + '/hwengine_mac', ifIgnoreCaps); - {$ENDIF} - if ico <> nil then - begin - SDL_WM_SetIcon(ico, 0); - SDL_FreeSurface(ico) - end; - - // set window caption - SDL_WM_SetCaption('Hedgewars', nil); - - if SDLPrimSurface <> nil then - begin + // load window icon + {$IFNDEF DARWIN} + ico:= LoadImage(Pathz[ptGraphics] + '/hwengine', ifIgnoreCaps); + {$ELSE} + ico:= LoadImage(Pathz[ptGraphics] + '/hwengine_mac', ifIgnoreCaps); + {$ENDIF} + if ico <> nil then + begin + SDL_WM_SetIcon(ico, 0); + SDL_FreeSurface(ico) + end; + + // set window caption + SDL_WM_SetCaption('Hedgewars', nil); + + if SDLPrimSurface <> nil then + begin {$IFDEF DEBUGFILE} - AddFileLog('Freeing old primary surface...'); + AddFileLog('Freeing old primary surface...'); {$ENDIF} - SDL_FreeSurface(SDLPrimSurface); - end; - + SDL_FreeSurface(SDLPrimSurface); + end; + {$IFDEF SDL13} - window:= SDL_CreateWindow('Hedgewars', 0, 0, cScreenWidth, cScreenHeight, - SDL_WINDOW_OPENGL or SDL_WINDOW_SHOWN - {$IFDEF IPHONEOS} or SDL_WINDOW_BORDERLESS{$ENDIF}); - SDL_CreateRenderer(window, -1, 0); - PixelFormat:= nil; - - SDL_SetRenderDrawColor(0, 0, 0, 255); - SDL_RenderFill(nil); - SDL_RenderPresent(); + window:= SDL_CreateWindow('Hedgewars', 0, 0, cScreenWidth, cScreenHeight, + SDL_WINDOW_OPENGL or SDL_WINDOW_SHOWN + {$IFDEF IPHONEOS} or SDL_WINDOW_BORDERLESS{$ENDIF}); + SDL_CreateRenderer(window, -1, 0); + PixelFormat:= nil; + + SDL_SetRenderDrawColor(0, 0, 0, 255); + SDL_RenderFill(nil); + SDL_RenderPresent(); {$ELSE} - SDLPrimSurface:= SDL_SetVideoMode(cScreenWidth, cScreenHeight, cBits, flags); - SDLTry(SDLPrimSurface <> nil, true); - PixelFormat:= SDLPrimSurface^.format; + SDLPrimSurface:= SDL_SetVideoMode(cScreenWidth, cScreenHeight, cBits, flags); + SDLTry(SDLPrimSurface <> nil, true); + PixelFormat:= SDLPrimSurface^.format; {$ENDIF} {$IFDEF DEBUGFILE} - AddFileLog('Setting up OpenGL...'); - AddFileLog('SDL video driver: ' + shortstring(SDL_VideoDriverName(buf, sizeof(buf)))); + AddFileLog('Setting up OpenGL...'); + AddFileLog('SDL video driver: ' + shortstring(SDL_VideoDriverName(buf, sizeof(buf)))); {$ENDIF} - SetupOpenGL(); + SetupOpenGL(); end; procedure chVol_p(var s: shortstring); @@ -711,17 +711,14 @@ procedure chPause(var s: shortstring); begin if gameType <> gmtNet then - isPaused:= not isPaused; + isPaused:= not isPaused; SDL_ShowCursor(ord(isPaused)) end; procedure chRotateMask(var s: shortstring); begin -inc(cTagsMaskIndex); -if cTagsMaskIndex > High(cTagsMasks) then cTagsMaskIndex:= Low(cTagsMasks); - -// HACK: skip "health only" if all hogs are invulnerable -if ((GameFlags and gfInvulnerable) <> 0) and ((cTagsMasks[cTagsMaskIndex] and not htTransparent) = htHealth) then chRotateMask(s); +if ((GameFlags and gfInvulnerable) = 0) then cTagsMask:= cTagsMasks[cTagsMask] else cTagsMask:= cTagsMasksNoHealth[cTagsMask]; +addfilelog('tagmask = ' + inttostr(ctagsmask)); end; procedure chAddTrigger(var s: shortstring); @@ -736,7 +733,7 @@ i:= 0; while (i < MAXPARAMS) and - (Length(s) > 0) do + (Length(s) > 0) do begin SplitBySpace(s, tmp); val(s, params[i]); @@ -745,19 +742,19 @@ end; case c of - 's': begin // sTYPE TICKS LIVES GEARTYPE X Y GEARTRIGGER - TryDo(i = 7, errmsgWrongNumber, true); - AddTriggerSpawner(params[0], params[1], params[2], TGearType(params[3]), params[4], params[5], params[6]); - end; - 'C': begin - TryDo(i = 3, errmsgWrongNumber, true); - AddTriggerSuccess(params[0], params[1], params[2]); - end; - 'F': begin - TryDo(i = 3, errmsgWrongNumber, true); - AddTriggerFail(params[0], params[1], params[2]); - end; - end +'s': begin // sTYPE TICKS LIVES GEARTYPE X Y GEARTRIGGER + TryDo(i = 7, errmsgWrongNumber, true); + AddTriggerSpawner(params[0], params[1], params[2], TGearType(params[3]), params[4], params[5], params[6]); + end; +'C': begin + TryDo(i = 3, errmsgWrongNumber, true); + AddTriggerSuccess(params[0], params[1], params[2]); + end; +'F': begin + TryDo(i = 3, errmsgWrongNumber, true); + AddTriggerFail(params[0], params[1], params[2]); + end; +end end; procedure chSpeedup_p(var s: shortstring);