hedgewars: comparison hedgewars/CCHandlers.inc

equal deleted inserted replaced

-:1d9e0a541c62
+:803b277e4894
 (*
 * Hedgewars, a free turn based strategy game
 * Copyright (c) 2004-2009 Andrey Korotaev <unC0Rr@gmail.com>
 *
 * 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;
 begin
 bRes:= (CurrentTeam = nil) or (CurrentHedgehog^.Gear = nil);
 {$IFDEF DEBUGFILE}
 if bRes then
 if CurrentTeam = nil then AddFileLog('CONSOLE: CurTeam = nil')
 else AddFileLog('CONSOLE: CurTeam <> nil, Gear = nil');
 {$ENDIF}
 CheckNoTeamOrHH:= bRes;
 end;
 ////////////////////////////////////////////////////////////////////////////////
 end;
 procedure chConfirm(var s: shortstring);
 begin
 if GameState = gsConfirm then
-	begin
+begin
-	SendIPC('Q');
+SendIPC('Q');
-	GameState:= gsExit
+GameState:= gsExit
-	end
+end
 else
 begin
 GameState:= gsChat;
 KeyPressChat(27);
 KeyPressChat(47);
 procedure chCheckProto(var s: shortstring);
 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
 end;
 procedure chAddTeam(var s: shortstring);
 var Color: Longword;
 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);
 // 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
 end;
 procedure chTeamLocal(var s: shortstring);
 begin
 if not isDeveloperMode then exit;
 var s: shortstring;
 Gear: PGear;
 begin
 if (not isDeveloperMode) or (CurrentTeam = nil) then exit;
 with CurrentTeam^ do
-	begin
+begin
-	SplitBySpace(id, s);
+SplitBySpace(id, s);
-	CurrentHedgehog:= @Hedgehogs[HedgehogsNumber];
+CurrentHedgehog:= @Hedgehogs[HedgehogsNumber];
-	val(id, CurrentHedgehog^.BotLevel);
+val(id, CurrentHedgehog^.BotLevel);
-	Gear:= AddGear(0, 0, gtHedgehog, 0, _0, _0, 0);
+Gear:= AddGear(0, 0, gtHedgehog, 0, _0, _0, 0);
-	SplitBySpace(s, id);
+SplitBySpace(s, id);
-	val(s, Gear^.Health);
+val(s, Gear^.Health);
-	TryDo(Gear^.Health > 0, 'Invalid hedgehog health', true);
+TryDo(Gear^.Health > 0, 'Invalid hedgehog health', true);
-	PHedgehog(Gear^.Hedgehog)^.Team:= CurrentTeam;
+PHedgehog(Gear^.Hedgehog)^.Team:= CurrentTeam;
 if (GameFlags and gfSharedAmmo) <> 0 then CurrentHedgehog^.AmmoStore:= Clan^.ClanIndex
 else CurrentHedgehog^.AmmoStore:= TeamsCount - 1;
-	CurrentHedgehog^.Gear:= Gear;
+CurrentHedgehog^.Gear:= Gear;
-	CurrentHedgehog^.Name:= id;
+CurrentHedgehog^.Name:= id;
 CurrHedgehog:= HedgehogsNumber;
-	inc(HedgehogsNumber)
+inc(HedgehogsNumber)
-	end
+end
 end;
 procedure chSetHat(var s: shortstring);
 begin
 if (not isDeveloperMode) or (CurrentTeam = nil) then exit;
 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
 end;
 end;
 procedure chSetHHCoords(var x: shortstring);
 var y: shortstring;
 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 + '"', false)
 else CurrentTeam^.Binds[b]:= s
 end;
 procedure chCurU_p(var s: shortstring);
 begin
 CursorMovementY:= -1;
 procedure chLeft_m(var s: shortstring);
 begin
 if CheckNoTeamOrHH then exit;
 if not CurrentTeam^.ExtDriven then SendIPC('l');
 with CurrentHedgehog^.Gear^ do
 Message:= Message and not gm_Left
 end;
 procedure chRight_p(var s: shortstring);
 begin
 if CheckNoTeamOrHH then exit;
 procedure chRight_m(var s: shortstring);
 begin
 if CheckNoTeamOrHH then exit;
 if not CurrentTeam^.ExtDriven then SendIPC('r');
 with CurrentHedgehog^.Gear^ do
 Message:= Message and not gm_Right
 end;
 procedure chUp_p(var s: shortstring);
 begin
 if CheckNoTeamOrHH then exit;
 procedure chUp_m(var s: shortstring);
 begin
 if CheckNoTeamOrHH then exit;
 if not CurrentTeam^.ExtDriven then SendIPC('u');
 with CurrentHedgehog^.Gear^ do
 Message:= Message and not gm_Up
 end;
 procedure chDown_p(var s: shortstring);
 begin
 if CheckNoTeamOrHH then exit;
 procedure chDown_m(var s: shortstring);
 begin
 if CheckNoTeamOrHH then exit;
 if not CurrentTeam^.ExtDriven then SendIPC('d');
 with CurrentHedgehog^.Gear^ do
 Message:= Message and not gm_Down
 end;
 procedure chPrecise_p(var s: shortstring);
 begin
 if CheckNoTeamOrHH then exit;
 procedure chPrecise_m(var s: shortstring);
 begin
 if CheckNoTeamOrHH then exit;
 if not CurrentTeam^.ExtDriven then SendIPC('z');
 with CurrentHedgehog^.Gear^ do
 Message:= Message and not gm_Precise
 end;
 procedure chLJump(var s: shortstring);
 begin
 if CheckNoTeamOrHH then exit;
 procedure chAttack_p(var s: shortstring);
 begin
 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
 FollowGear:= CurrentHedgehog^.Gear;
 if not CurrentTeam^.ExtDriven then SendIPC('A');
 Message:= Message or gm_Attack
 end
 end
 end;
 procedure chAttack_m(var s: shortstring);
 begin
 if CheckNoTeamOrHH then exit;
 with CurrentHedgehog^.Gear^ do
 begin
 if not CurrentTeam^.ExtDriven and
 ((Message and gm_Attack) <> 0) then SendIPC('a');
 Message:= Message and not gm_Attack
 end
 end;
 procedure chSwitch(var s: shortstring);
 begin
 if CheckNoTeamOrHH then exit;
 if not CurrentTeam^.ExtDriven then SendIPC('S');
 with CurrentHedgehog^.Gear^ do
 Message:= Message or gm_Switch
 end;
 procedure chNextTurn(var s: shortstring);
 begin
 TryDo(AllInactive, '/nextturn called when not all gears are inactive', true);
 procedure chSay(var s: shortstring);
 begin
 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;
 procedure chTeamSay(var s: shortstring);
 if (s[0] <> #1) or (s[1] < '1') or (s[1] > '5') or CheckNoTeamOrHH then exit;
 bShowFinger:= false;
 if not CurrentTeam^.ExtDriven then SendIPC(s);
 with CurrentHedgehog^.Gear^ do
 begin
 Message:= Message or gm_Timer;
 MsgParam:= byte(s[1]) - ord('0')
 end
 end;
 procedure chSlot(var s: shortstring);
 var slot: LongWord;
 begin
 bShowFinger:= false;
 slot:= byte(s[1]) - 49;
 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
 end;
 procedure chSetWeapon(var s: shortstring);
 begin
 if (s[0] <> #1) or CheckNoTeamOrHH then exit;
 if TAmmoType(s[1]) > High(TAmmoType) then exit;
 if not CurrentTeam^.ExtDriven then SendIPC('w' + s);
 with CurrentHedgehog^.Gear^ do
 begin
 Message:= Message or gm_Weapon;
 MsgParam:= byte(s[1])
 end
 end;
 procedure chTaunt(var s: shortstring);
 begin
 if (s[0] <> #1) or CheckNoTeamOrHH then exit;
 if TWave(s[1]) > High(TWave) then exit;
 if not CurrentTeam^.ExtDriven then SendIPC('t' + s);
 with CurrentHedgehog^.Gear^ do
 begin
 Message:= Message or gm_Animate;
 MsgParam:= byte(s[1])
 end
 end;
 procedure chHogSay(var s: shortstring);
 var Gear: PVisualGear;
 text: shortstring;
 begin
 text:= copy(s, 2, Length(s)-1);
 if CheckNoTeamOrHH
 or ((CurrentHedgehog^.Gear^.State and gstHHDriven) = 0) then
 begin
 chSay(text);
 exit
 end;
 if byte(s[1]) < 4 then
 begin
 Gear:= AddVisualGear(0, 0, vgtSpeechBubble);
 if Gear <> nil then
 begin
 Gear^.Hedgehog:= CurrentHedgehog;
 Gear^.Text:= text;
 Gear^.FrameTicks:= byte(s[1])
 end
 end
 else
 begin
 SpeechType:= byte(s[1])-3;
 SpeechText:= text
 procedure doPut(putX, putY: LongInt; fromAI: boolean);
 begin
 if CheckNoTeamOrHH then exit;
 if bShowAmmoMenu then
-	begin
+begin
-	bSelected:= true;
+bSelected:= true;
-	exit
+exit
-	end;
+end;
 with CurrentHedgehog^.Gear^,
-	CurrentHedgehog^ do
+CurrentHedgehog^ do
-	if (State and gstHHChooseTarget) <> 0 then
+if (State and gstHHChooseTarget) <> 0 then
-		begin
+begin
-		isCursorVisible:= false;
+isCursorVisible:= false;
-		if not CurrentTeam^.ExtDriven then
+if not CurrentTeam^.ExtDriven then
-			begin
+begin
-			if fromAI then
+if fromAI then
-				begin
+begin
-				TargetPoint.X:= putX;
+TargetPoint.X:= putX;
-				TargetPoint.Y:= putY
+TargetPoint.Y:= putY
-				end else
+end else
-				begin
+begin
-				TargetPoint.X:= CursorPoint.X - WorldDx;
+TargetPoint.X:= CursorPoint.X - WorldDx;
-				TargetPoint.Y:= cScreenHeight - CursorPoint.Y - WorldDy;
+TargetPoint.Y:= cScreenHeight - CursorPoint.Y - WorldDy;
-				end;
+end;
-			SendIPCXY('p', TargetPoint.X, TargetPoint.Y);
+SendIPCXY('p', TargetPoint.X, TargetPoint.Y);
-			end
+end
-		else
+else
-			begin
+begin
-			TargetPoint.X:= putX;
+TargetPoint.X:= putX;
-			TargetPoint.Y:= putY
+TargetPoint.Y:= putY
-			end;
+end;
-		{$IFDEF DEBUGFILE}AddFilelog('put: ' + inttostr(TargetPoint.X) + ', ' + inttostr(TargetPoint.Y));{$ENDIF}
+{$IFDEF DEBUGFILE}AddFilelog('put: ' + inttostr(TargetPoint.X) + ', ' + inttostr(TargetPoint.Y));{$ENDIF}
-		State:= State and not gstHHChooseTarget;
+State:= State and not gstHHChooseTarget;
-		if (Ammo^[CurSlot, CurAmmo].Propz and ammoprop_AttackingPut) <> 0 then
+if (Ammo^[CurSlot, CurAmmo].Propz and ammoprop_AttackingPut) <> 0 then
-			Message:= Message or gm_Attack;
+Message:= Message or gm_Attack;
-		end
+end
-	else
+else
-		if CurrentTeam^.ExtDriven then
+if CurrentTeam^.ExtDriven then
-			OutError('got /put while not being in choose target mode', false)
+OutError('got /put while not being in choose target mode', false)
 end;
 procedure chPut(var s: shortstring);
 begin
 doPut(0, 0, false)
 end;
 procedure chSetMap(var s: shortstring);
 begin
 if isDeveloperMode then
 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
 end;
 procedure chSetSeed(var s: shortstring);
 begin
 if isDeveloperMode then
 begin
 SetRandomSeed(s);
 cSeed:= s;
 InitStepsFlags:= InitStepsFlags or cifRandomize
 end
 end;
 procedure chAmmoMenu(var s: shortstring);
 begin
 if CheckNoTeamOrHH then
 bShowAmmoMenu:= true
 else
 with CurrentTeam^ do
 with Hedgehogs[CurrHedgehog] do
 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
 end;
 procedure chFullScr(var s: shortstring);
 var flags: Longword = 0;
-	ico: PSDL_Surface;
+ico: PSDL_Surface;
 {$IFDEF DEBUGFILE}
 buf: array[byte] of char;
 {$ENDIF}
 {$IFDEF SDL13}
 window: PSDL_Window;
 {$ENDIF}
 begin
-	if Length(s) = 0 then cFullScreen:= not cFullScreen
+if Length(s) = 0 then cFullScreen:= not cFullScreen
-	else cFullScreen:= s = '1';
+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
+if cFullScreen then
-	begin
+begin
-		flags:= flags or SDL_FULLSCREEN;
+flags:= flags or SDL_FULLSCREEN;
-		cScreenWidth:= cInitWidth;
+cScreenWidth:= cInitWidth;
-		cScreenHeight:= cInitHeight
+cScreenHeight:= cInitHeight
-	end;
+end;
-	// load window icon
+// load window icon
-	{$IFNDEF DARWIN}
+{$IFNDEF DARWIN}
-	ico:= LoadImage(Pathz[ptGraphics] + '/hwengine', ifIgnoreCaps);
+ico:= LoadImage(Pathz[ptGraphics] + '/hwengine', ifIgnoreCaps);
-	{$ELSE}
+{$ELSE}
-	ico:= LoadImage(Pathz[ptGraphics] + '/hwengine_mac', ifIgnoreCaps);
+ico:= LoadImage(Pathz[ptGraphics] + '/hwengine_mac', ifIgnoreCaps);
-	{$ENDIF}
+{$ENDIF}
-	if ico <> nil then
+if ico <> nil then
-		begin
+begin
-		SDL_WM_SetIcon(ico, 0);
+SDL_WM_SetIcon(ico, 0);
-		SDL_FreeSurface(ico)
+SDL_FreeSurface(ico)
-		end;
+end;
-	// set window caption
+// set window caption
-	SDL_WM_SetCaption('Hedgewars', nil);
+SDL_WM_SetCaption('Hedgewars', nil);
-	if SDLPrimSurface <> nil then
+if SDLPrimSurface <> nil then
-	begin
+begin
 {$IFDEF DEBUGFILE}
-		AddFileLog('Freeing old primary surface...');
+AddFileLog('Freeing old primary surface...');
 {$ENDIF}
-		SDL_FreeSurface(SDLPrimSurface);
+SDL_FreeSurface(SDLPrimSurface);
-	end;
+end;
 {$IFDEF SDL13}
-	window:= SDL_CreateWindow('Hedgewars', 0, 0, cScreenWidth, cScreenHeight,
+window:= SDL_CreateWindow('Hedgewars', 0, 0, cScreenWidth, cScreenHeight,
-		SDL_WINDOW_OPENGL or SDL_WINDOW_SHOWN
+SDL_WINDOW_OPENGL or SDL_WINDOW_SHOWN
-	        {$IFDEF IPHONEOS} or SDL_WINDOW_BORDERLESS{$ENDIF});
+{$IFDEF IPHONEOS} or SDL_WINDOW_BORDERLESS{$ENDIF});
-	SDL_CreateRenderer(window, -1, 0);
+SDL_CreateRenderer(window, -1, 0);
-	PixelFormat:= nil;
+PixelFormat:= nil;
-	SDL_SetRenderDrawColor(0, 0, 0, 255);
+SDL_SetRenderDrawColor(0, 0, 0, 255);
-	SDL_RenderFill(nil);
+SDL_RenderFill(nil);
-	SDL_RenderPresent();
+SDL_RenderPresent();
 {$ELSE}
-	SDLPrimSurface:= SDL_SetVideoMode(cScreenWidth, cScreenHeight, cBits, flags);
+SDLPrimSurface:= SDL_SetVideoMode(cScreenWidth, cScreenHeight, cBits, flags);
-	SDLTry(SDLPrimSurface <> nil, true);
+SDLTry(SDLPrimSurface <> nil, true);
-	PixelFormat:= SDLPrimSurface^.format;
+PixelFormat:= SDLPrimSurface^.format;
 {$ENDIF}
 {$IFDEF DEBUGFILE}
-	AddFileLog('Setting up OpenGL...');
+AddFileLog('Setting up OpenGL...');
-	AddFileLog('SDL video driver: ' + shortstring(SDL_VideoDriverName(buf, sizeof(buf))));
+AddFileLog('SDL video driver: ' + shortstring(SDL_VideoDriverName(buf, sizeof(buf))));
 {$ENDIF}
-	SetupOpenGL();
+SetupOpenGL();
 end;
 procedure chVol_p(var s: shortstring);
 begin
 inc(cVolumeDelta, 3)
 end;
 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 ((GameFlags and gfInvulnerable) = 0) then cTagsMask:= cTagsMasks[cTagsMask] else cTagsMask:= cTagsMasksNoHealth[cTagsMask];
-if cTagsMaskIndex > High(cTagsMasks) then cTagsMaskIndex:= Low(cTagsMasks);
+addfilelog('tagmask = ' + inttostr(ctagsmask));
-// HACK: skip "health only" if all hogs are invulnerable
-if ((GameFlags and gfInvulnerable) <> 0) and ((cTagsMasks[cTagsMaskIndex] and not htTransparent) = htHealth) then chRotateMask(s);
 end;
 procedure chAddTrigger(var s: shortstring);
 const MAXPARAMS = 16;
 var params: array[0..Pred(MAXPARAMS)] of Longword;
 c:= s[1];
 Delete(s, 1, 1);
 i:= 0;
 while (i < MAXPARAMS) and
 (Length(s) > 0) do
 begin
 SplitBySpace(s, tmp);
 val(s, params[i]);
 s:= tmp;
 inc(i)
 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
 end;
 procedure chSpeedup_p(var s: shortstring);
 begin
 isSpeed:= true

changeset 2947	803b277e4894
parent 2905	f3c79f7193a9
child 2948	3f21a9dc93d0