author  nemo 
Sat, 06 Mar 2010 21:32:04 +0000  
changeset 2963  0f0789204802 
parent 2962  38237a443f74 
child 2990  b62e567f17b9 
permissions  rwrr 
4  1 
(* 
2947  2 
* Hedgewars, a free turn based strategy game 
3 
* Copyright (c) 20042009 Andrey Korotaev <unC0Rr@gmail.com> 

4 
* 

5 
* This program is free software; you can redistribute it and/or modify 

6 
* it under the terms of the GNU General Public License as published by 

7 
* the Free Software Foundation; version 2 of the License 

8 
* 

9 
* This program is distributed in the hope that it will be useful, 

10 
* but WITHOUT ANY WARRANTY; without even the implied warranty of 

11 
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 

12 
* GNU General Public License for more details. 

13 
* 

14 
* You should have received a copy of the GNU General Public License 

15 
* along with this program; if not, write to the Free Software 

16 
* Foundation, Inc., 59 Temple Place  Suite 330, Boston, MA 021111307, USA 

17 
*) 

4  18 

19 
function CheckNoTeamOrHH: boolean; 

2695  20 
var bRes: boolean; 
4  21 
begin 
2695  22 
bRes:= (CurrentTeam = nil) or (CurrentHedgehog^.Gear = nil); 
4  23 
{$IFDEF DEBUGFILE} 
2695  24 
if bRes then 
2947  25 
if CurrentTeam = nil then AddFileLog('CONSOLE: CurTeam = nil') 
351  26 
else AddFileLog('CONSOLE: CurTeam <> nil, Gear = nil'); 
4  27 
{$ENDIF} 
2695  28 
CheckNoTeamOrHH:= bRes; 
4  29 
end; 
30 
//////////////////////////////////////////////////////////////////////////////// 

31 
procedure chQuit(var s: shortstring); 

1022  32 
const prevGState: TGameState = gsConfirm; 
4  33 
begin 
1022  34 
if GameState <> gsConfirm then 
35 
begin 

36 
prevGState:= GameState; 

37 
GameState:= gsConfirm 

38 
end else 

39 
GameState:= prevGState 

40 
end; 

41 

42 
procedure chConfirm(var s: shortstring); 

43 
begin 

44 
if GameState = gsConfirm then 

2947  45 
begin 
46 
SendIPC('Q'); 

47 
GameState:= gsExit 

48 
end 

2130
708758635955
Please don't take away my checkin privileges  Tiy asked me to keep working on this
nemo
parents:
2125
diff
changeset

49 
else 
708758635955
Please don't take away my checkin privileges  Tiy asked me to keep working on this
nemo
parents:
2125
diff
changeset

50 
begin 
708758635955
Please don't take away my checkin privileges  Tiy asked me to keep working on this
nemo
parents:
2125
diff
changeset

51 
GameState:= gsChat; 
708758635955
Please don't take away my checkin privileges  Tiy asked me to keep working on this
nemo
parents:
2125
diff
changeset

52 
KeyPressChat(27); 
708758635955
Please don't take away my checkin privileges  Tiy asked me to keep working on this
nemo
parents:
2125
diff
changeset

53 
KeyPressChat(47); 
708758635955
Please don't take away my checkin privileges  Tiy asked me to keep working on this
nemo
parents:
2125
diff
changeset

54 
KeyPressChat(116); 
708758635955
Please don't take away my checkin privileges  Tiy asked me to keep working on this
nemo
parents:
2125
diff
changeset

55 
KeyPressChat(101); 
708758635955
Please don't take away my checkin privileges  Tiy asked me to keep working on this
nemo
parents:
2125
diff
changeset

56 
KeyPressChat(97); 
708758635955
Please don't take away my checkin privileges  Tiy asked me to keep working on this
nemo
parents:
2125
diff
changeset

57 
KeyPressChat(109); 
708758635955
Please don't take away my checkin privileges  Tiy asked me to keep working on this
nemo
parents:
2125
diff
changeset

58 
KeyPressChat(32) 
708758635955
Please don't take away my checkin privileges  Tiy asked me to keep working on this
nemo
parents:
2125
diff
changeset

59 
end 
4  60 
end; 
61 

205  62 
procedure chCheckProto(var s: shortstring); 
371  63 
var i, c: LongInt; 
205  64 
begin 
65 
if isDeveloperMode then 

2947  66 
begin 
67 
val(s, i, c); 

68 
if (c <> 0) or (i = 0) then exit; 

69 
TryDo(i <= cNetProtoVersion, 'Protocol version mismatch: engine is too old', true); 

70 
TryDo(i >= cNetProtoVersion, 'Protocol version mismatch: engine is too new', true) 

71 
end 

205  72 
end; 
73 

4  74 
procedure chAddTeam(var s: shortstring); 
549  75 
var Color: Longword; 
2874
3c7c2bf1ba38
A simple hat reservation mechanism. Can be worked around with a little effort, but to make it useful, you'd have to get everyone you played with to work around it too. Quite a bit of effort for a small reward feature.
nemo
parents:
2855
diff
changeset

76 
ts, cs: shortstring; 
4  77 
begin 
145  78 
if isDeveloperMode then 
2947  79 
begin 
80 
SplitBySpace(s, cs); 

81 
SplitBySpace(cs, ts); 

82 
val(cs, Color); 

83 
TryDo(Color <> 0, 'Error: black team color', true); 

351  84 

2947  85 
// color is always little endian so the mask must be constant also in big endian archs 
86 
Color:= Color or $FF000000; 

87 

88 
AddTeam(Color); 

89 
CurrentTeam^.TeamName:= ts; 

90 
CurrentTeam^.PlayerHash:= s; 

91 
if GameType in [gmtDemo, gmtSave] then CurrentTeam^.ExtDriven:= true; 

1654  92 

2947  93 
CurrentTeam^.voicepack:= AskForVoicepack('Default') 
94 
end 

4  95 
end; 
96 

97 
procedure chTeamLocal(var s: shortstring); 

98 
begin 

99 
if not isDeveloperMode then exit; 

100 
if CurrentTeam = nil then OutError(errmsgIncorrectUse + ' "/rdriven"', true); 

351  101 
CurrentTeam^.ExtDriven:= true 
4  102 
end; 
103 

104 
procedure chGrave(var s: shortstring); 

105 
begin 

106 
if CurrentTeam = nil then OutError(errmsgIncorrectUse + ' "/grave"', true); 

107 
if s[1]='"' then Delete(s, 1, 1); 

108 
if s[byte(s[0])]='"' then Delete(s, byte(s[0]), 1); 

351  109 
CurrentTeam^.GraveName:= s 
4  110 
end; 
111 

112 
procedure chFort(var s: shortstring); 

113 
begin 

764
7513452b1d51
Now game looks almost like it did before switching to OpenGL
unc0rr
parents:
753
diff
changeset

114 
if CurrentTeam = nil then OutError(errmsgIncorrectUse + ' "/fort"', true); 
4  115 
if s[1]='"' then Delete(s, 1, 1); 
116 
if s[byte(s[0])]='"' then Delete(s, byte(s[0]), 1); 

351  117 
CurrentTeam^.FortName:= s 
4  118 
end; 
119 

1654  120 
procedure chVoicepack(var s: shortstring); 
121 
begin 

122 
if CurrentTeam = nil then OutError(errmsgIncorrectUse + ' "/voicepack"', true); 

123 
if s[1]='"' then Delete(s, 1, 1); 

124 
if s[byte(s[0])]='"' then Delete(s, byte(s[0]), 1); 

125 
CurrentTeam^.voicepack:= AskForVoicepack(s) 

126 
end; 

127 

2747  128 
procedure chFlag(var s: shortstring); 
129 
begin 

130 
if CurrentTeam = nil then OutError(errmsgIncorrectUse + ' "/flag"', true); 

131 
if s[1]='"' then Delete(s, 1, 1); 

132 
if s[byte(s[0])]='"' then Delete(s, byte(s[0]), 1); 

133 
CurrentTeam^.flag:= s 

134 
end; 

135 

2786  136 
procedure chScript(var s: shortstring); 
137 
begin 

138 
if s[1]='"' then Delete(s, 1, 1); 

139 
if s[byte(s[0])]='"' then Delete(s, byte(s[0]), 1); 

140 
ScriptLoad(s) 

141 
end; 

142 

312  143 
procedure chAddHH(var id: shortstring); 
4  144 
var s: shortstring; 
145 
Gear: PGear; 

146 
begin 

394
4c017ae1226a
 Implement hack to let ammo stores work without needed assistance of frontend
unc0rr
parents:
393
diff
changeset

147 
if (not isDeveloperMode) or (CurrentTeam = nil) then exit; 
312  148 
with CurrentTeam^ do 
2947  149 
begin 
150 
SplitBySpace(id, s); 

151 
CurrentHedgehog:= @Hedgehogs[HedgehogsNumber]; 

152 
val(id, CurrentHedgehog^.BotLevel); 

153 
Gear:= AddGear(0, 0, gtHedgehog, 0, _0, _0, 0); 

154 
SplitBySpace(s, id); 

155 
val(s, Gear^.Health); 

156 
TryDo(Gear^.Health > 0, 'Invalid hedgehog health', true); 

157 
PHedgehog(Gear^.Hedgehog)^.Team:= CurrentTeam; 

2881  158 
if (GameFlags and gfSharedAmmo) <> 0 then CurrentHedgehog^.AmmoStore:= Clan^.ClanIndex 
159 
else CurrentHedgehog^.AmmoStore:= TeamsCount  1; 

2947  160 
CurrentHedgehog^.Gear:= Gear; 
161 
CurrentHedgehog^.Name:= id; 

2808
8f48b538d591
Need this too to set it to last hog for current switch alg
nemo
parents:
2800
diff
changeset

162 
CurrHedgehog:= HedgehogsNumber; 
2947  163 
inc(HedgehogsNumber) 
164 
end 

1242  165 
end; 
166 

167 
procedure chSetHat(var s: shortstring); 

168 
begin 

169 
if (not isDeveloperMode) or (CurrentTeam = nil) then exit; 

170 
with CurrentTeam^ do 

2726  171 
begin 
172 
if not CurrentHedgehog^.King then 

2947  173 
if (s = '') or 
174 
(((GameFlags and gfKing) <> 0) and (s = 'crown')) or 

175 
((Length(s) > 39) and (Copy(s,1,8) = 'Reserved') and (Copy(s,9,32) <> PlayerHash)) then 

176 
CurrentHedgehog^.Hat:= 'NoHat' 

177 
else 

178 
CurrentHedgehog^.Hat:= s 

2726  179 
end; 
4  180 
end; 
181 

604
2f1165467a66
Let hedgehog position be taken from config, still more work is needed
unc0rr
parents:
602
diff
changeset

182 
procedure chSetHHCoords(var x: shortstring); 
2f1165467a66
Let hedgehog position be taken from config, still more work is needed
unc0rr
parents:
602
diff
changeset

183 
var y: shortstring; 
2f1165467a66
Let hedgehog position be taken from config, still more work is needed
unc0rr
parents:
602
diff
changeset

184 
t: Longint; 
2f1165467a66
Let hedgehog position be taken from config, still more work is needed
unc0rr
parents:
602
diff
changeset

185 
begin 
2f1165467a66
Let hedgehog position be taken from config, still more work is needed
unc0rr
parents:
602
diff
changeset

186 
if (not isDeveloperMode) or (CurrentHedgehog = nil) or (CurrentHedgehog^.Gear = nil) then exit; 
2f1165467a66
Let hedgehog position be taken from config, still more work is needed
unc0rr
parents:
602
diff
changeset

187 
SplitBySpace(x, y); 
2f1165467a66
Let hedgehog position be taken from config, still more work is needed
unc0rr
parents:
602
diff
changeset

188 
val(x, t); 
2f1165467a66
Let hedgehog position be taken from config, still more work is needed
unc0rr
parents:
602
diff
changeset

189 
CurrentHedgehog^.Gear^.X:= int2hwFloat(t); 
2f1165467a66
Let hedgehog position be taken from config, still more work is needed
unc0rr
parents:
602
diff
changeset

190 
val(y, t); 
2f1165467a66
Let hedgehog position be taken from config, still more work is needed
unc0rr
parents:
602
diff
changeset

191 
CurrentHedgehog^.Gear^.Y:= int2hwFloat(t) 
2f1165467a66
Let hedgehog position be taken from config, still more work is needed
unc0rr
parents:
602
diff
changeset

192 
end; 
2f1165467a66
Let hedgehog position be taken from config, still more work is needed
unc0rr
parents:
602
diff
changeset

193 

288  194 
procedure chAddAmmoStore(var descr: shortstring); 
195 
begin 

196 
AddAmmoStore(descr) 

197 
end; 

198 

4  199 
procedure chBind(var id: shortstring); 
200 
var s: shortstring; 

371  201 
b: LongInt; 
4  202 
begin 
203 
if CurrentTeam = nil then exit; 

204 
SplitBySpace(id, s); 

205 
if s[1]='"' then Delete(s, 1, 1); 

206 
if s[byte(s[0])]='"' then Delete(s, byte(s[0]), 1); 

207 
b:= KeyNameToCode(id); 

351  208 
if b = 0 then OutError(errmsgUnknownVariable + ' "' + id + '"', false) 
2947  209 
else CurrentTeam^.Binds[b]:= s 
4  210 
end; 
211 

2428  212 
procedure chCurU_p(var s: shortstring); 
213 
begin 

214 
CursorMovementY:= 1; 

215 
end; 

216 

217 
procedure chCurU_m(var s: shortstring); 

218 
begin 

219 
CursorMovementY:= 0; 

220 
end; 

221 

222 
procedure chCurD_p(var s: shortstring); 

223 
begin 

224 
CursorMovementY:= 1; 

225 
end; 

226 

227 
procedure chCurD_m(var s: shortstring); 

228 
begin 

229 
CursorMovementY:= 0; 

230 
end; 

231 

232 
procedure chCurL_p(var s: shortstring); 

233 
begin 

234 
CursorMovementX:= 1; 

235 
end; 

236 

237 
procedure chCurL_m(var s: shortstring); 

238 
begin 

239 
CursorMovementX:= 0; 

240 
end; 

241 

242 
procedure chCurR_p(var s: shortstring); 

243 
begin 

244 
CursorMovementX:= 1; 

245 
end; 

246 

247 
procedure chCurR_m(var s: shortstring); 

248 
begin 

249 
CursorMovementX:= 0; 

250 
end; 

251 

4  252 
procedure chLeft_p(var s: shortstring); 
253 
begin 

254 
if CheckNoTeamOrHH then exit; 

176  255 
bShowFinger:= false; 
351  256 
if not CurrentTeam^.ExtDriven then SendIPC('L'); 
602  257 
with CurrentHedgehog^.Gear^ do 
4  258 
Message:= Message or gm_Left 
259 
end; 

260 

261 
procedure chLeft_m(var s: shortstring); 

262 
begin 

263 
if CheckNoTeamOrHH then exit; 

351  264 
if not CurrentTeam^.ExtDriven then SendIPC('l'); 
602  265 
with CurrentHedgehog^.Gear^ do 
2947  266 
Message:= Message and not gm_Left 
4  267 
end; 
268 

269 
procedure chRight_p(var s: shortstring); 

270 
begin 

271 
if CheckNoTeamOrHH then exit; 

176  272 
bShowFinger:= false; 
351  273 
if not CurrentTeam^.ExtDriven then SendIPC('R'); 
602  274 
with CurrentHedgehog^.Gear^ do 
4  275 
Message:= Message or gm_Right 
276 
end; 

277 

278 
procedure chRight_m(var s: shortstring); 

279 
begin 

280 
if CheckNoTeamOrHH then exit; 

351  281 
if not CurrentTeam^.ExtDriven then SendIPC('r'); 
602  282 
with CurrentHedgehog^.Gear^ do 
2947  283 
Message:= Message and not gm_Right 
4  284 
end; 
285 

286 
procedure chUp_p(var s: shortstring); 

287 
begin 

288 
if CheckNoTeamOrHH then exit; 

176  289 
bShowFinger:= false; 
351  290 
if not CurrentTeam^.ExtDriven then SendIPC('U'); 
602  291 
with CurrentHedgehog^.Gear^ do 
4  292 
Message:= Message or gm_Up 
293 
end; 

294 

295 
procedure chUp_m(var s: shortstring); 

296 
begin 

297 
if CheckNoTeamOrHH then exit; 

351  298 
if not CurrentTeam^.ExtDriven then SendIPC('u'); 
602  299 
with CurrentHedgehog^.Gear^ do 
2947  300 
Message:= Message and not gm_Up 
4  301 
end; 
302 

303 
procedure chDown_p(var s: shortstring); 

304 
begin 

305 
if CheckNoTeamOrHH then exit; 

176  306 
bShowFinger:= false; 
351  307 
if not CurrentTeam^.ExtDriven then SendIPC('D'); 
602  308 
with CurrentHedgehog^.Gear^ do 
4  309 
Message:= Message or gm_Down 
310 
end; 

311 

312 
procedure chDown_m(var s: shortstring); 

313 
begin 

314 
if CheckNoTeamOrHH then exit; 

351  315 
if not CurrentTeam^.ExtDriven then SendIPC('d'); 
602  316 
with CurrentHedgehog^.Gear^ do 
2947  317 
Message:= Message and not gm_Down 
4  318 
end; 
319 

1639  320 
procedure chPrecise_p(var s: shortstring); 
321 
begin 

322 
if CheckNoTeamOrHH then exit; 

323 
bShowFinger:= false; 

324 
if not CurrentTeam^.ExtDriven then SendIPC('Z'); 

325 
with CurrentHedgehog^.Gear^ do 

326 
Message:= Message or gm_Precise 

327 
end; 

328 

329 
procedure chPrecise_m(var s: shortstring); 

330 
begin 

331 
if CheckNoTeamOrHH then exit; 

332 
if not CurrentTeam^.ExtDriven then SendIPC('z'); 

333 
with CurrentHedgehog^.Gear^ do 

2947  334 
Message:= Message and not gm_Precise 
1639  335 
end; 
336 

4  337 
procedure chLJump(var s: shortstring); 
338 
begin 

339 
if CheckNoTeamOrHH then exit; 

176  340 
bShowFinger:= false; 
351  341 
if not CurrentTeam^.ExtDriven then SendIPC('j'); 
602  342 
with CurrentHedgehog^.Gear^ do 
4  343 
Message:= Message or gm_LJump 
344 
end; 

345 

346 
procedure chHJump(var s: shortstring); 

347 
begin 

348 
if CheckNoTeamOrHH then exit; 

176  349 
bShowFinger:= false; 
351  350 
if not CurrentTeam^.ExtDriven then SendIPC('J'); 
602  351 
with CurrentHedgehog^.Gear^ do 
4  352 
Message:= Message or gm_HJump 
353 
end; 

354 

355 
procedure chAttack_p(var s: shortstring); 

356 
begin 

357 
if CheckNoTeamOrHH then exit; 

176  358 
bShowFinger:= false; 
602  359 
with CurrentHedgehog^.Gear^ do 
2947  360 
begin 
361 
{$IFDEF DEBUGFILE}AddFileLog('/+attack: hedgehog''s Gear^.State = '+inttostr(State));{$ENDIF} 

362 
if ((State and gstHHDriven) <> 0) then 

4  363 
begin 
602  364 
FollowGear:= CurrentHedgehog^.Gear; 
351  365 
if not CurrentTeam^.ExtDriven then SendIPC('A'); 
4  366 
Message:= Message or gm_Attack 
367 
end 

2947  368 
end 
4  369 
end; 
370 

371 
procedure chAttack_m(var s: shortstring); 

372 
begin 

373 
if CheckNoTeamOrHH then exit; 

602  374 
with CurrentHedgehog^.Gear^ do 
2947  375 
begin 
376 
if not CurrentTeam^.ExtDriven and 

95  377 
((Message and gm_Attack) <> 0) then SendIPC('a'); 
2947  378 
Message:= Message and not gm_Attack 
379 
end 

4  380 
end; 
381 

382 
procedure chSwitch(var s: shortstring); 

383 
begin 

384 
if CheckNoTeamOrHH then exit; 

351  385 
if not CurrentTeam^.ExtDriven then SendIPC('S'); 
602  386 
with CurrentHedgehog^.Gear^ do 
2947  387 
Message:= Message or gm_Switch 
4  388 
end; 
389 

390 
procedure chNextTurn(var s: shortstring); 

391 
begin 

2045
b0588498bc3a
 Fix network (my crappy fault, triggered by nemo's patch)
unc0rr
parents:
2042
diff
changeset

392 
TryDo(AllInactive, '/nextturn called when not all gears are inactive', true); 
2046  393 

2045
b0588498bc3a
 Fix network (my crappy fault, triggered by nemo's patch)
unc0rr
parents:
2042
diff
changeset

394 
if not CurrentTeam^.ExtDriven then SendIPC('N'); 
b0588498bc3a
 Fix network (my crappy fault, triggered by nemo's patch)
unc0rr
parents:
2042
diff
changeset

395 
TickTrigger(trigTurns); 
b0588498bc3a
 Fix network (my crappy fault, triggered by nemo's patch)
unc0rr
parents:
2042
diff
changeset

396 
{$IFDEF DEBUGFILE}AddFileLog('Doing SwitchHedgehog: time '+inttostr(GameTicks));{$ENDIF} 
4  397 
end; 
398 

399 
procedure chSay(var s: shortstring); 

400 
begin 

1356  401 
SendIPC('s' + s); 
1378  402 

403 
if copy(s, 1, 4) = '/me ' then 

2947  404 
s:= #2'* ' + UserNick + ' ' + copy(s, 5, Length(s)  4) 
1378  405 
else 
2947  406 
s:= #1 + UserNick + ': ' + s; 
1378  407 

1356  408 
AddChatString(s) 
4  409 
end; 
410 

2124  411 
procedure chTeamSay(var s: shortstring); 
412 
begin 

413 
SendIPC('b' + s); 

414 

2962  415 
s:= #4 + '[Team] ' + UserNick + ': ' + s; 
2124  416 

2396  417 
AddChatString(s) 
2124  418 
end; 
419 

4  420 
procedure chTimer(var s: shortstring); 
421 
begin 

2314  422 
if (s[0] <> #1) or (s[1] < '1') or (s[1] > '5') or CheckNoTeamOrHH then exit; 
176  423 
bShowFinger:= false; 
2314  424 

926
d231e007452a
Timer as hedgehog message (avoid possible desync in very rare cases)
unc0rr
parents:
917
diff
changeset

425 
if not CurrentTeam^.ExtDriven then SendIPC(s); 
d231e007452a
Timer as hedgehog message (avoid possible desync in very rare cases)
unc0rr
parents:
917
diff
changeset

426 
with CurrentHedgehog^.Gear^ do 
2947  427 
begin 
428 
Message:= Message or gm_Timer; 

429 
MsgParam:= byte(s[1])  ord('0') 

430 
end 

4  431 
end; 
432 

433 
procedure chSlot(var s: shortstring); 

434 
var slot: LongWord; 

435 
begin 

95  436 
if (s[0] <> #1) or CheckNoTeamOrHH then exit; 
176  437 
bShowFinger:= false; 
4  438 
slot:= byte(s[1])  49; 
10  439 
if slot > cMaxSlotIndex then exit; 
351  440 
if not CurrentTeam^.ExtDriven then SendIPC(char(byte(s[1]) + 79)); 
783  441 
with CurrentHedgehog^.Gear^ do 
2947  442 
begin 
443 
Message:= Message or gm_Slot; 

444 
MsgParam:= slot 

445 
end 

783  446 
end; 
447 

448 
procedure chSetWeapon(var s: shortstring); 

449 
begin 

450 
if (s[0] <> #1) or CheckNoTeamOrHH then exit; 

784  451 

1850  452 
if TAmmoType(s[1]) > High(TAmmoType) then exit; 
784  453 

454 
if not CurrentTeam^.ExtDriven then SendIPC('w' + s); 

455 

783  456 
with CurrentHedgehog^.Gear^ do 
2947  457 
begin 
458 
Message:= Message or gm_Weapon; 

459 
MsgParam:= byte(s[1]) 

460 
end 

4  461 
end; 
462 

1035  463 
procedure chTaunt(var s: shortstring); 
464 
begin 

465 
if (s[0] <> #1) or CheckNoTeamOrHH then exit; 

466 

467 
if TWave(s[1]) > High(TWave) then exit; 

468 

469 
if not CurrentTeam^.ExtDriven then SendIPC('t' + s); 

470 

471 
with CurrentHedgehog^.Gear^ do 

2947  472 
begin 
473 
Message:= Message or gm_Animate; 

474 
MsgParam:= byte(s[1]) 

475 
end 

1035  476 
end; 
477 

2017  478 
procedure chHogSay(var s: shortstring); 
2042
905c554d62e6
Move Speech to visual gears. This checkin CRASHES on deletion of visual gear outside the doStep
nemo
parents:
2022
diff
changeset

479 
var Gear: PVisualGear; 
2017  480 
text: shortstring; 
481 
begin 

482 
text:= copy(s, 2, Length(s)1); 

2110  483 
if CheckNoTeamOrHH 
2947  484 
or ((CurrentHedgehog^.Gear^.State and gstHHDriven) = 0) then 
2017  485 
begin 
486 
chSay(text); 

487 
exit 

488 
end; 

489 

490 
if not CurrentTeam^.ExtDriven then SendIPC('h' + s); 

2042
905c554d62e6
Move Speech to visual gears. This checkin CRASHES on deletion of visual gear outside the doStep
nemo
parents:
2022
diff
changeset

491 

2017  492 
if byte(s[1]) < 4 then 
493 
begin 

2042
905c554d62e6
Move Speech to visual gears. This checkin CRASHES on deletion of visual gear outside the doStep
nemo
parents:
2022
diff
changeset

494 
Gear:= AddVisualGear(0, 0, vgtSpeechBubble); 
2114
9a8ccc7bc3d8
Fix crash caused by speechbubbles when restoring from save or joining already started net game
unc0rr
parents:
2111
diff
changeset

495 
if Gear <> nil then 
2947  496 
begin 
497 
Gear^.Hedgehog:= CurrentHedgehog; 

498 
Gear^.Text:= text; 

499 
Gear^.FrameTicks:= byte(s[1]) 

500 
end 

2017  501 
end 
502 
else 

503 
begin 

2022  504 
SpeechType:= byte(s[1])3; 
2017  505 
SpeechText:= text 
506 
end; 

2042
905c554d62e6
Move Speech to visual gears. This checkin CRASHES on deletion of visual gear outside the doStep
nemo
parents:
2022
diff
changeset

507 

2017  508 
end; 
509 

1821
6b6cf3389f92
Hedgehog drops a grave on "/newgrave" command. Patch by nemo
unc0rr
parents:
1743
diff
changeset

510 
procedure chNewGrave; 
6b6cf3389f92
Hedgehog drops a grave on "/newgrave" command. Patch by nemo
unc0rr
parents:
1743
diff
changeset

511 
begin 
6b6cf3389f92
Hedgehog drops a grave on "/newgrave" command. Patch by nemo
unc0rr
parents:
1743
diff
changeset

512 
if CheckNoTeamOrHH then exit; 
6b6cf3389f92
Hedgehog drops a grave on "/newgrave" command. Patch by nemo
unc0rr
parents:
1743
diff
changeset

513 

6b6cf3389f92
Hedgehog drops a grave on "/newgrave" command. Patch by nemo
unc0rr
parents:
1743
diff
changeset

514 
if not CurrentTeam^.ExtDriven then SendIPC('g'); 
6b6cf3389f92
Hedgehog drops a grave on "/newgrave" command. Patch by nemo
unc0rr
parents:
1743
diff
changeset

515 

6b6cf3389f92
Hedgehog drops a grave on "/newgrave" command. Patch by nemo
unc0rr
parents:
1743
diff
changeset

516 
AddGear(hwRound(CurrentHedgehog^.Gear^.X), hwRound(CurrentHedgehog^.Gear^.Y), gtGrave, 0, _0, _0, 0) 
6b6cf3389f92
Hedgehog drops a grave on "/newgrave" command. Patch by nemo
unc0rr
parents:
1743
diff
changeset

517 
end; 
6b6cf3389f92
Hedgehog drops a grave on "/newgrave" command. Patch by nemo
unc0rr
parents:
1743
diff
changeset

518 

543
465e2ec8f05f
 Better randomness of placing hedgehogs on the land
unc0rr
parents:
542
diff
changeset

519 
procedure doPut(putX, putY: LongInt; fromAI: boolean); 
4  520 
begin 
521 
if CheckNoTeamOrHH then exit; 

2963
0f0789204802
This might be all it takes to prevent the desync. needs local/remote testing. Also toggle 2nd barrel state on 0 movement
nemo
parents:
2962
diff
changeset

522 
if not CurrentTeam^.ExtDriven and bShowAmmoMenu then 
2947  523 
begin 
524 
bSelected:= true; 

525 
exit 

526 
end; 

543
465e2ec8f05f
 Better randomness of placing hedgehogs on the land
unc0rr
parents:
542
diff
changeset

527 

602  528 
with CurrentHedgehog^.Gear^, 
2947  529 
CurrentHedgehog^ do 
530 
if (State and gstHHChooseTarget) <> 0 then 

531 
begin 

532 
isCursorVisible:= false; 

533 
if not CurrentTeam^.ExtDriven then 

534 
begin 

535 
if fromAI then 

536 
begin 

537 
TargetPoint.X:= putX; 

538 
TargetPoint.Y:= putY 

539 
end else 

540 
begin 

541 
TargetPoint.X:= CursorPoint.X  WorldDx; 

542 
TargetPoint.Y:= cScreenHeight  CursorPoint.Y  WorldDy; 

543 
end; 

544 
SendIPCXY('p', TargetPoint.X, TargetPoint.Y); 

545 
end 

546 
else 

547 
begin 

548 
TargetPoint.X:= putX; 

549 
TargetPoint.Y:= putY 

550 
end; 

551 
{$IFDEF DEBUGFILE}AddFilelog('put: ' + inttostr(TargetPoint.X) + ', ' + inttostr(TargetPoint.Y));{$ENDIF} 

552 
State:= State and not gstHHChooseTarget; 

553 
if (Ammo^[CurSlot, CurAmmo].Propz and ammoprop_AttackingPut) <> 0 then 

554 
Message:= Message or gm_Attack; 

555 
end 

556 
else 

557 
if CurrentTeam^.ExtDriven then 

558 
OutError('got /put while not being in choose target mode', false) 

543
465e2ec8f05f
 Better randomness of placing hedgehogs on the land
unc0rr
parents:
542
diff
changeset

559 
end; 
465e2ec8f05f
 Better randomness of placing hedgehogs on the land
unc0rr
parents:
542
diff
changeset

560 

465e2ec8f05f
 Better randomness of placing hedgehogs on the land
unc0rr
parents:
542
diff
changeset

561 
procedure chPut(var s: shortstring); 
465e2ec8f05f
 Better randomness of placing hedgehogs on the land
unc0rr
parents:
542
diff
changeset

562 
begin 
465e2ec8f05f
 Better randomness of placing hedgehogs on the land
unc0rr
parents:
542
diff
changeset

563 
doPut(0, 0, false) 
4  564 
end; 
565 

566 
procedure chCapture(var s: shortstring); 

567 
begin 

568 
flagMakeCapture:= true 

569 
end; 

570 

48  571 
procedure chSkip(var s: shortstring); 
572 
begin 

351  573 
if not CurrentTeam^.ExtDriven then SendIPC(','); 
871  574 
uStats.Skipped; 
917  575 
skipFlag:= true 
48  576 
end; 
577 

55
e09f7c952a40
Send run parameters by cmd line, game parameters by IPC... breaks network game
unc0rr
parents:
48
diff
changeset

578 
procedure chSetMap(var s: shortstring); 
e09f7c952a40
Send run parameters by cmd line, game parameters by IPC... breaks network game
unc0rr
parents:
48
diff
changeset

579 
begin 
e09f7c952a40
Send run parameters by cmd line, game parameters by IPC... breaks network game
unc0rr
parents:
48
diff
changeset

580 
if isDeveloperMode then 
2947  581 
begin 
582 
Pathz[ptMapCurrent]:= Pathz[ptMaps] + '/' + s; 

583 
InitStepsFlags:= InitStepsFlags or cifMap 

584 
end 

55
e09f7c952a40
Send run parameters by cmd line, game parameters by IPC... breaks network game
unc0rr
parents:
48
diff
changeset

585 
end; 
e09f7c952a40
Send run parameters by cmd line, game parameters by IPC... breaks network game
unc0rr
parents:
48
diff
changeset

586 

e09f7c952a40
Send run parameters by cmd line, game parameters by IPC... breaks network game
unc0rr
parents:
48
diff
changeset

587 
procedure chSetTheme(var s: shortstring); 
e09f7c952a40
Send run parameters by cmd line, game parameters by IPC... breaks network game
unc0rr
parents:
48
diff
changeset

588 
begin 
e09f7c952a40
Send run parameters by cmd line, game parameters by IPC... breaks network game
unc0rr
parents:
48
diff
changeset

589 
if isDeveloperMode then 
2947  590 
begin 
591 
Pathz[ptCurrTheme]:= Pathz[ptThemes] + '/' + s; 

592 
InitStepsFlags:= InitStepsFlags or cifTheme 

593 
end 

55
e09f7c952a40
Send run parameters by cmd line, game parameters by IPC... breaks network game
unc0rr
parents:
48
diff
changeset

594 
end; 
e09f7c952a40
Send run parameters by cmd line, game parameters by IPC... breaks network game
unc0rr
parents:
48
diff
changeset

595 

e09f7c952a40
Send run parameters by cmd line, game parameters by IPC... breaks network game
unc0rr
parents:
48
diff
changeset

596 
procedure chSetSeed(var s: shortstring); 
e09f7c952a40
Send run parameters by cmd line, game parameters by IPC... breaks network game
unc0rr
parents:
48
diff
changeset

597 
begin 
e09f7c952a40
Send run parameters by cmd line, game parameters by IPC... breaks network game
unc0rr
parents:
48
diff
changeset

598 
if isDeveloperMode then 
2947  599 
begin 
600 
SetRandomSeed(s); 

601 
cSeed:= s; 

602 
InitStepsFlags:= InitStepsFlags or cifRandomize 

603 
end 

55
e09f7c952a40
Send run parameters by cmd line, game parameters by IPC... breaks network game
unc0rr
parents:
48
diff
changeset

604 
end; 
e09f7c952a40
Send run parameters by cmd line, game parameters by IPC... breaks network game
unc0rr
parents:
48
diff
changeset

605 

161  606 
procedure chAmmoMenu(var s: shortstring); 
607 
begin 

2855
7e6adeb57427
Show the ammo menu of the last local nonbot team when not local turn. needs testing
nemo
parents:
2853
diff
changeset

608 
if CheckNoTeamOrHH then 
2947  609 
bShowAmmoMenu:= true 
2855
7e6adeb57427
Show the ammo menu of the last local nonbot team when not local turn. needs testing
nemo
parents:
2853
diff
changeset

610 
else 
2947  611 
with CurrentTeam^ do 
2855
7e6adeb57427
Show the ammo menu of the last local nonbot team when not local turn. needs testing
nemo
parents:
2853
diff
changeset

612 
with Hedgehogs[CurrHedgehog] do 
2947  613 
begin 
614 
bSelected:= false; 

682  615 

2947  616 
if bShowAmmoMenu then bShowAmmoMenu:= false 
617 
else if ((Gear^.State and (gstAttacking or gstAttacked)) <> 0) or (MultiShootAttacks > 0) 

618 
or ((Gear^.State and gstHHDriven) = 0) then else bShowAmmoMenu:= true 

619 
end 

161  620 
end; 
621 

166
2920ab2bf329
Switching between fullscreen and windowed modes on 'F' key
unc0rr
parents:
162
diff
changeset

622 
procedure chFullScr(var s: shortstring); 
2671
7e0f88013fe8
smaller patches, one missing Skylowres, IMG_Init and Mix_Init (might require newer libraries), updates to SDL bindings, code cleanup, new compile flags
koda
parents:
2645
diff
changeset

623 
var flags: Longword = 0; 
2947  624 
ico: PSDL_Surface; 
192  625 
{$IFDEF DEBUGFILE} 
626 
buf: array[byte] of char; 

627 
{$ENDIF} 

2716
b9ca1bfca24f
complete the replacement of init/free wrappers for every unit
koda
parents:
2714
diff
changeset

628 
{$IFDEF SDL13} 
b9ca1bfca24f
complete the replacement of init/free wrappers for every unit
koda
parents:
2714
diff
changeset

629 
window: PSDL_Window; 
b9ca1bfca24f
complete the replacement of init/free wrappers for every unit
koda
parents:
2714
diff
changeset

630 
{$ENDIF} 
166
2920ab2bf329
Switching between fullscreen and windowed modes on 'F' key
unc0rr
parents:
162
diff
changeset

631 
begin 
2947  632 
if Length(s) = 0 then cFullScreen:= not cFullScreen 
633 
else cFullScreen:= s = '1'; 

192  634 

905  635 
{$IFDEF DEBUGFILE} 
2947  636 
AddFileLog('Prepare to change video parameters...'); 
905  637 
{$ENDIF} 
2253  638 

2947  639 
flags:= SDL_OPENGL;// or SDL_RESIZABLE; 
753  640 

2947  641 
if cFullScreen then 
642 
begin 

643 
flags:= flags or SDL_FULLSCREEN; 

644 
cScreenWidth:= cInitWidth; 

645 
cScreenHeight:= cInitHeight 

646 
end; 

2351
a4a17b8df591
Set window caption even in fullscreen mode (suggested by Smaxx)
unc0rr
parents:
2314
diff
changeset

647 

2947  648 
// load window icon 
649 
{$IFNDEF DARWIN} 

650 
ico:= LoadImage(Pathz[ptGraphics] + '/hwengine', ifIgnoreCaps); 

651 
{$ELSE} 

652 
ico:= LoadImage(Pathz[ptGraphics] + '/hwengine_mac', ifIgnoreCaps); 

653 
{$ENDIF} 

654 
if ico <> nil then 

655 
begin 

656 
SDL_WM_SetIcon(ico, 0); 

657 
SDL_FreeSurface(ico) 

658 
end; 

659 

660 
// set window caption 

661 
SDL_WM_SetCaption('Hedgewars', nil); 

662 

663 
if SDLPrimSurface <> nil then 

664 
begin 

2697  665 
{$IFDEF DEBUGFILE} 
2947  666 
AddFileLog('Freeing old primary surface...'); 
2697  667 
{$ENDIF} 
2947  668 
SDL_FreeSurface(SDLPrimSurface); 
669 
end; 

670 

2716
b9ca1bfca24f
complete the replacement of init/free wrappers for every unit
koda
parents:
2714
diff
changeset

671 
{$IFDEF SDL13} 
2947  672 
window:= SDL_CreateWindow('Hedgewars', 0, 0, cScreenWidth, cScreenHeight, 
2948
3f21a9dc93d0
Replace tabs with spaces using 'expand t 4' command
unc0rr
parents:
2947
diff
changeset

673 
SDL_WINDOW_OPENGL or SDL_WINDOW_SHOWN 
3f21a9dc93d0
Replace tabs with spaces using 'expand t 4' command
unc0rr
parents:
2947
diff
changeset

674 
{$IFDEF IPHONEOS} or SDL_WINDOW_BORDERLESS{$ENDIF}); 
3f21a9dc93d0
Replace tabs with spaces using 'expand t 4' command
unc0rr
parents:
2947
diff
changeset

675 
SDL_CreateRenderer(window, 1, 0); 
3f21a9dc93d0
Replace tabs with spaces using 'expand t 4' command
unc0rr
parents:
2947
diff
changeset

676 
PixelFormat:= nil; 
2947  677 

2948
3f21a9dc93d0
Replace tabs with spaces using 'expand t 4' command
unc0rr
parents:
2947
diff
changeset

678 
SDL_SetRenderDrawColor(0, 0, 0, 255); 
3f21a9dc93d0
Replace tabs with spaces using 'expand t 4' command
unc0rr
parents:
2947
diff
changeset

679 
SDL_RenderFill(nil); 
2947  680 
SDL_RenderPresent(); 
2716
b9ca1bfca24f
complete the replacement of init/free wrappers for every unit
koda
parents:
2714
diff
changeset

681 
{$ELSE} 
2947  682 
SDLPrimSurface:= SDL_SetVideoMode(cScreenWidth, cScreenHeight, cBits, flags); 
683 
SDLTry(SDLPrimSurface <> nil, true); 

684 
PixelFormat:= SDLPrimSurface^.format; 

2716
b9ca1bfca24f
complete the replacement of init/free wrappers for every unit
koda
parents:
2714
diff
changeset

685 
{$ENDIF} 
192  686 

905  687 
{$IFDEF DEBUGFILE} 
2947  688 
AddFileLog('Setting up OpenGL...'); 
689 
AddFileLog('SDL video driver: ' + shortstring(SDL_VideoDriverName(buf, sizeof(buf)))); 

905  690 
{$ENDIF} 
2947  691 
SetupOpenGL(); 
166
2920ab2bf329
Switching between fullscreen and windowed modes on 'F' key
unc0rr
parents:
162
diff
changeset

692 
end; 
161  693 

175  694 
procedure chVol_p(var s: shortstring); 
174  695 
begin 
175  696 
inc(cVolumeDelta, 3) 
174  697 
end; 
698 

175  699 
procedure chVol_m(var s: shortstring); 
174  700 
begin 
175  701 
dec(cVolumeDelta, 3) 
174  702 
end; 
703 

176  704 
procedure chFindhh(var s: shortstring); 
705 
begin 

706 
if CheckNoTeamOrHH then exit; 

707 
bShowFinger:= true; 

602  708 
FollowGear:= CurrentHedgehog^.Gear 
176  709 
end; 
710 

281
5b483aa9f2ab
Pause support (mouse cursor is released when the game is paused)
unc0rr
parents:
263
diff
changeset

711 
procedure chPause(var s: shortstring); 
5b483aa9f2ab
Pause support (mouse cursor is released when the game is paused)
unc0rr
parents:
263
diff
changeset

712 
begin 
1743  713 
if gameType <> gmtNet then 
2947  714 
isPaused:= not isPaused; 
281
5b483aa9f2ab
Pause support (mouse cursor is released when the game is paused)
unc0rr
parents:
263
diff
changeset

715 
SDL_ShowCursor(ord(isPaused)) 
5b483aa9f2ab
Pause support (mouse cursor is released when the game is paused)
unc0rr
parents:
263
diff
changeset

716 
end; 
539
6a9bf1852bbc
Ability to choose which info is shown above hedgehogs
unc0rr
parents:
534
diff
changeset

717 

6a9bf1852bbc
Ability to choose which info is shown above hedgehogs
unc0rr
parents:
534
diff
changeset

718 
procedure chRotateMask(var s: shortstring); 
6a9bf1852bbc
Ability to choose which info is shown above hedgehogs
unc0rr
parents:
534
diff
changeset

719 
begin 
2947  720 
if ((GameFlags and gfInvulnerable) = 0) then cTagsMask:= cTagsMasks[cTagsMask] else cTagsMask:= cTagsMasksNoHealth[cTagsMask]; 
539
6a9bf1852bbc
Ability to choose which info is shown above hedgehogs
unc0rr
parents:
534
diff
changeset

721 
end; 
6a9bf1852bbc
Ability to choose which info is shown above hedgehogs
unc0rr
parents:
534
diff
changeset

722 

589  723 
procedure chAddTrigger(var s: shortstring); 
615  724 
const MAXPARAMS = 16; 
725 
var params: array[0..Pred(MAXPARAMS)] of Longword; 

726 
i: LongInt; 

595
5ee863f2f568
Triggers PoC: targets are spawned right after the previous damaged
unc0rr
parents:
594
diff
changeset

727 
c: char; 
5ee863f2f568
Triggers PoC: targets are spawned right after the previous damaged
unc0rr
parents:
594
diff
changeset

728 
tmp: shortstring; 
589  729 
begin 
595
5ee863f2f568
Triggers PoC: targets are spawned right after the previous damaged
unc0rr
parents:
594
diff
changeset

730 
c:= s[1]; 
5ee863f2f568
Triggers PoC: targets are spawned right after the previous damaged
unc0rr
parents:
594
diff
changeset

731 
Delete(s, 1, 1); 
615  732 

733 
i:= 0; 

734 
while (i < MAXPARAMS) and 

2947  735 
(Length(s) > 0) do 
615  736 
begin 
737 
SplitBySpace(s, tmp); 

738 
val(s, params[i]); 

739 
s:= tmp; 

740 
inc(i) 

741 
end; 

742 

595
5ee863f2f568
Triggers PoC: targets are spawned right after the previous damaged
unc0rr
parents:
594
diff
changeset

743 
case c of 
2947  744 
's': begin // sTYPE TICKS LIVES GEARTYPE X Y GEARTRIGGER 
745 
TryDo(i = 7, errmsgWrongNumber, true); 

746 
AddTriggerSpawner(params[0], params[1], params[2], TGearType(params[3]), params[4], params[5], params[6]); 

747 
end; 

748 
'C': begin 

749 
TryDo(i = 3, errmsgWrongNumber, true); 

750 
AddTriggerSuccess(params[0], params[1], params[2]); 

751 
end; 

752 
'F': begin 

753 
TryDo(i = 3, errmsgWrongNumber, true); 

754 
AddTriggerFail(params[0], params[1], params[2]); 

755 
end; 

756 
end 

589  757 
end; 
626  758 

759 
procedure chSpeedup_p(var s: shortstring); 

760 
begin 

761 
isSpeed:= true 

762 
end; 

763 

764 
procedure chSpeedup_m(var s: shortstring); 

765 
begin 

766 
isSpeed:= false 

767 
end; 

946  768 

2162  769 
procedure chZoomIn(var s: shortstring); 
770 
begin 

2579  771 
{$IFDEF IPHONEOS} 
772 
if ZoomValue < 3.5 then 

773 
{$ELSE} 

774 
if ZoomValue < 3.0 then 

775 
{$ENDIF} 

776 
ZoomValue:= ZoomValue + 0.25; 

2162  777 
end; 
778 

779 
procedure chZoomOut(var s: shortstring); 

780 
begin 

2579  781 
{$IFDEF IPHONEOS} 
782 
if ZoomValue > 0.5 then 

783 
{$ELSE} 

784 
if ZoomValue > 1.0 then 

785 
{$ENDIF} 

786 
ZoomValue:= ZoomValue  0.25; 

2162  787 
end; 
788 

2379  789 
procedure chZoomReset(var s: shortstring); 
790 
begin 

791 
ZoomValue:= 2.0 

792 
end; 

793 

946  794 
procedure chChat(var s: shortstring); 
795 
begin 

990
dfa6a6fe1542
Implement history for chat (27 entries), no key binding yet
unc0rr
parents:
970
diff
changeset

796 
GameState:= gsChat; 
dfa6a6fe1542
Implement history for chat (27 entries), no key binding yet
unc0rr
parents:
970
diff
changeset

797 
KeyPressChat(27) 
946  798 
end; 
991  799 

800 
procedure chHistory(var s: shortstring); 

801 
begin 

802 
uChat.showAll:= not uChat.showAll 

803 
end; 