author  unc0rr 
Sun, 16 Aug 2009 11:55:41 +0000  
changeset 2313  0ffdcae7653c 
parent 2253  ecd10eaa5daf 
child 2314  953771a06c64 
permissions  rwrr 
4  1 
(* 
1066  2 
* Hedgewars, a free turn based strategy game 
1656
209cf0e2fc36
Finish voicepacks support in engine (not tested though)
unc0rr
parents:
1654
diff
changeset

3 
* Copyright (c) 20042009 Andrey Korotaev <unC0Rr@gmail.com> 
4  4 
* 
183  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 

4  8 
* 
183  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. 

4  13 
* 
183  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 

4  17 
*) 
18 

19 
function CheckNoTeamOrHH: boolean; 

351  20 
var Result: boolean; 
4  21 
begin 
602  22 
Result:= (CurrentTeam = nil) or (CurrentHedgehog^.Gear = nil); 
4  23 
{$IFDEF DEBUGFILE} 
24 
if Result then 

25 
if CurrentTeam = nil then AddFileLog('CONSOLE: CurTeam = nil') 

351  26 
else AddFileLog('CONSOLE: CurTeam <> nil, Gear = nil'); 
4  27 
{$ENDIF} 
351  28 
CheckNoTeamOrHH:= Result 
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 

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 

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 

72 
end; 

73 

4  74 
procedure chAddTeam(var s: shortstring); 
549  75 
var Color: Longword; 
605  76 
ts: shortstring; 
4  77 
begin 
145  78 
if isDeveloperMode then 
79 
begin 

605  80 
SplitBySpace(s, ts); 
549  81 
val(s, Color); 
82 
TryDo(Color <> 0, 'Error: black team color', true); 

351  83 

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

84 
Color:= Color or $FF000000; 
7513452b1d51
Now game looks almost like it did before switching to OpenGL
unc0rr
parents:
753
diff
changeset

85 

549  86 
AddTeam(Color); 
605  87 
CurrentTeam^.TeamName:= ts; 
1654  88 
if GameType in [gmtDemo, gmtSave] then CurrentTeam^.ExtDriven:= true; 
89 

90 
CurrentTeam^.voicepack:= AskForVoicepack('Default') 

546  91 
end 
4  92 
end; 
93 

94 
procedure chTeamLocal(var s: shortstring); 

95 
begin 

96 
if not isDeveloperMode then exit; 

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

351  98 
CurrentTeam^.ExtDriven:= true 
4  99 
end; 
100 

101 
procedure chGrave(var s: shortstring); 

102 
begin 

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

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

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

351  106 
CurrentTeam^.GraveName:= s 
4  107 
end; 
108 

109 
procedure chFort(var s: shortstring); 

110 
begin 

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

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

351  114 
CurrentTeam^.FortName:= s 
4  115 
end; 
116 

1654  117 
procedure chVoicepack(var s: shortstring); 
118 
begin 

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

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

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

122 
CurrentTeam^.voicepack:= AskForVoicepack(s) 

123 
end; 

124 

312  125 
procedure chAddHH(var id: shortstring); 
4  126 
var s: shortstring; 
127 
Gear: PGear; 

128 
begin 

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

129 
if (not isDeveloperMode) or (CurrentTeam = nil) then exit; 
312  130 
with CurrentTeam^ do 
1242  131 
begin 
132 
SplitBySpace(id, s); 

133 
CurrentHedgehog:= @Hedgehogs[HedgehogsNumber]; 

134 
val(id, CurrentHedgehog^.BotLevel); 

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

136 
SplitBySpace(s, id); 

137 
val(s, Gear^.Health); 

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

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

140 
CurrentHedgehog^.AmmoStore:= TeamsCount  1; // FIXME HACK to get ammostores work 

141 
CurrentHedgehog^.Gear:= Gear; 

142 
CurrentHedgehog^.Name:= id; 

143 
inc(HedgehogsNumber) 

144 
end 

145 
end; 

146 

147 
procedure chSetHat(var s: shortstring); 

148 
begin 

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

150 
with CurrentTeam^ do 

151 
if s = '' then 

152 
CurrentHedgehog^.Hat:= 'NoHat' 

153 
else 

154 
CurrentHedgehog^.Hat:= s 

4  155 
end; 
156 

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

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

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

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

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

161 
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

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

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

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

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

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

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

168 

288  169 
procedure chAddAmmoStore(var descr: shortstring); 
170 
begin 

171 
AddAmmoStore(descr) 

172 
end; 

173 

4  174 
procedure chBind(var id: shortstring); 
175 
var s: shortstring; 

371  176 
b: LongInt; 
4  177 
begin 
178 
if CurrentTeam = nil then exit; 

179 
SplitBySpace(id, s); 

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

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

182 
b:= KeyNameToCode(id); 

351  183 
if b = 0 then OutError(errmsgUnknownVariable + ' "' + id + '"', false) 
184 
else CurrentTeam^.Binds[b]:= s 

4  185 
end; 
186 

187 
procedure chLeft_p(var s: shortstring); 

188 
begin 

189 
if CheckNoTeamOrHH then exit; 

176  190 
bShowFinger:= false; 
351  191 
if not CurrentTeam^.ExtDriven then SendIPC('L'); 
602  192 
with CurrentHedgehog^.Gear^ do 
4  193 
Message:= Message or gm_Left 
194 
end; 

195 

196 
procedure chLeft_m(var s: shortstring); 

197 
begin 

198 
if CheckNoTeamOrHH then exit; 

351  199 
if not CurrentTeam^.ExtDriven then SendIPC('l'); 
602  200 
with CurrentHedgehog^.Gear^ do 
4  201 
Message:= Message and not gm_Left 
202 
end; 

203 

204 
procedure chRight_p(var s: shortstring); 

205 
begin 

206 
if CheckNoTeamOrHH then exit; 

176  207 
bShowFinger:= false; 
351  208 
if not CurrentTeam^.ExtDriven then SendIPC('R'); 
602  209 
with CurrentHedgehog^.Gear^ do 
4  210 
Message:= Message or gm_Right 
211 
end; 

212 

213 
procedure chRight_m(var s: shortstring); 

214 
begin 

215 
if CheckNoTeamOrHH then exit; 

351  216 
if not CurrentTeam^.ExtDriven then SendIPC('r'); 
602  217 
with CurrentHedgehog^.Gear^ do 
4  218 
Message:= Message and not gm_Right 
219 
end; 

220 

221 
procedure chUp_p(var s: shortstring); 

222 
begin 

223 
if CheckNoTeamOrHH then exit; 

176  224 
bShowFinger:= false; 
351  225 
if not CurrentTeam^.ExtDriven then SendIPC('U'); 
602  226 
with CurrentHedgehog^.Gear^ do 
4  227 
Message:= Message or gm_Up 
228 
end; 

229 

230 
procedure chUp_m(var s: shortstring); 

231 
begin 

232 
if CheckNoTeamOrHH then exit; 

351  233 
if not CurrentTeam^.ExtDriven then SendIPC('u'); 
602  234 
with CurrentHedgehog^.Gear^ do 
4  235 
Message:= Message and not gm_Up 
236 
end; 

237 

238 
procedure chDown_p(var s: shortstring); 

239 
begin 

240 
if CheckNoTeamOrHH then exit; 

176  241 
bShowFinger:= false; 
351  242 
if not CurrentTeam^.ExtDriven then SendIPC('D'); 
602  243 
with CurrentHedgehog^.Gear^ do 
4  244 
Message:= Message or gm_Down 
245 
end; 

246 

247 
procedure chDown_m(var s: shortstring); 

248 
begin 

249 
if CheckNoTeamOrHH then exit; 

351  250 
if not CurrentTeam^.ExtDriven then SendIPC('d'); 
602  251 
with CurrentHedgehog^.Gear^ do 
4  252 
Message:= Message and not gm_Down 
253 
end; 

254 

1639  255 
procedure chPrecise_p(var s: shortstring); 
256 
begin 

257 
if CheckNoTeamOrHH then exit; 

258 
bShowFinger:= false; 

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

260 
with CurrentHedgehog^.Gear^ do 

261 
Message:= Message or gm_Precise 

262 
end; 

263 

264 
procedure chPrecise_m(var s: shortstring); 

265 
begin 

266 
if CheckNoTeamOrHH then exit; 

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

268 
with CurrentHedgehog^.Gear^ do 

269 
Message:= Message and not gm_Precise 

270 
end; 

271 

4  272 
procedure chLJump(var s: shortstring); 
273 
begin 

274 
if CheckNoTeamOrHH then exit; 

176  275 
bShowFinger:= false; 
351  276 
if not CurrentTeam^.ExtDriven then SendIPC('j'); 
602  277 
with CurrentHedgehog^.Gear^ do 
4  278 
Message:= Message or gm_LJump 
279 
end; 

280 

281 
procedure chHJump(var s: shortstring); 

282 
begin 

283 
if CheckNoTeamOrHH then exit; 

176  284 
bShowFinger:= false; 
351  285 
if not CurrentTeam^.ExtDriven then SendIPC('J'); 
602  286 
with CurrentHedgehog^.Gear^ do 
4  287 
Message:= Message or gm_HJump 
288 
end; 

289 

290 
procedure chAttack_p(var s: shortstring); 

291 
begin 

292 
if CheckNoTeamOrHH then exit; 

176  293 
bShowFinger:= false; 
602  294 
with CurrentHedgehog^.Gear^ do 
4  295 
begin 
2079  296 
{$IFDEF DEBUGFILE}AddFileLog('/+attack: hedgehog''s Gear^.State = '+inttostr(State));{$ENDIF} 
929
9456e1e77369
 Continue preparation for implementing attack from rope and parachute
unc0rr
parents:
927
diff
changeset

297 
if ((State and gstHHDriven) <> 0) then 
4  298 
begin 
602  299 
FollowGear:= CurrentHedgehog^.Gear; 
351  300 
if not CurrentTeam^.ExtDriven then SendIPC('A'); 
4  301 
Message:= Message or gm_Attack 
302 
end 

303 
end 

304 
end; 

305 

306 
procedure chAttack_m(var s: shortstring); 

307 
begin 

308 
if CheckNoTeamOrHH then exit; 

602  309 
with CurrentHedgehog^.Gear^ do 
4  310 
begin 
351  311 
if not CurrentTeam^.ExtDriven and 
95  312 
((Message and gm_Attack) <> 0) then SendIPC('a'); 
313 
Message:= Message and not gm_Attack 

4  314 
end 
315 
end; 

316 

317 
procedure chSwitch(var s: shortstring); 

318 
begin 

319 
if CheckNoTeamOrHH then exit; 

351  320 
if not CurrentTeam^.ExtDriven then SendIPC('S'); 
602  321 
with CurrentHedgehog^.Gear^ do 
4  322 
Message:= Message or gm_Switch 
323 
end; 

324 

325 
procedure chNextTurn(var s: shortstring); 

326 
begin 

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

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

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

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

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

331 
{$IFDEF DEBUGFILE}AddFileLog('Doing SwitchHedgehog: time '+inttostr(GameTicks));{$ENDIF} 
4  332 
end; 
333 

334 
procedure chSay(var s: shortstring); 

335 
begin 

1356  336 
SendIPC('s' + s); 
1378  337 

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

1379  339 
s:= '* ' + UserNick + ' ' + copy(s, 5, Length(s)  4) 
1378  340 
else 
341 
s:= UserNick + ': ' + s; 

342 

1356  343 
AddChatString(s) 
4  344 
end; 
345 

2124  346 
procedure chTeamSay(var s: shortstring); 
347 
var text: shortstring; 

348 
begin 

349 
SendIPC('b' + s); 

350 

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

352 

353 
AddChatString(text) 

354 
end; 

355 

4  356 
procedure chTimer(var s: shortstring); 
357 
begin 

2313  358 
if (s[0] <> #1) or (s[1] < '1') or (s[1] > '5') 
359 
or (CurrentTeam = nil) 

360 
or (CurrentHedgehog^.Gear = nil) then exit; 

176  361 
bShowFinger:= false; 
926
d231e007452a
Timer as hedgehog message (avoid possible desync in very rare cases)
unc0rr
parents:
917
diff
changeset

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

363 
with CurrentHedgehog^.Gear^ do 
d231e007452a
Timer as hedgehog message (avoid possible desync in very rare cases)
unc0rr
parents:
917
diff
changeset

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

365 
Message:= Message or gm_Timer; 
d231e007452a
Timer as hedgehog message (avoid possible desync in very rare cases)
unc0rr
parents:
917
diff
changeset

366 
MsgParam:= byte(s[1])  ord('0') 
d231e007452a
Timer as hedgehog message (avoid possible desync in very rare cases)
unc0rr
parents:
917
diff
changeset

367 
end 
4  368 
end; 
369 

370 
procedure chSlot(var s: shortstring); 

371 
var slot: LongWord; 

372 
begin 

95  373 
if (s[0] <> #1) or CheckNoTeamOrHH then exit; 
176  374 
bShowFinger:= false; 
4  375 
slot:= byte(s[1])  49; 
10  376 
if slot > cMaxSlotIndex then exit; 
351  377 
if not CurrentTeam^.ExtDriven then SendIPC(char(byte(s[1]) + 79)); 
783  378 
with CurrentHedgehog^.Gear^ do 
4  379 
begin 
783  380 
Message:= Message or gm_Slot; 
381 
MsgParam:= slot 

382 
end 

383 
end; 

384 

385 
procedure chSetWeapon(var s: shortstring); 

386 
begin 

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

784  388 

1850  389 
if TAmmoType(s[1]) > High(TAmmoType) then exit; 
784  390 

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

392 

783  393 
with CurrentHedgehog^.Gear^ do 
394 
begin 

395 
Message:= Message or gm_Weapon; 

1850  396 
MsgParam:= byte(s[1]) 
4  397 
end 
398 
end; 

399 

1035  400 
procedure chTaunt(var s: shortstring); 
401 
begin 

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

403 

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

405 

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

407 

408 
with CurrentHedgehog^.Gear^ do 

409 
begin 

410 
Message:= Message or gm_Animate; 

411 
MsgParam:= byte(s[1]) 

412 
end 

413 
end; 

414 

2017  415 
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

416 
var Gear: PVisualGear; 
2017  417 
text: shortstring; 
418 
begin 

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

2110  420 
if CheckNoTeamOrHH 
2111  421 
or ((CurrentHedgehog^.Gear^.State and gstHHDriven) = 0) then 
2017  422 
begin 
423 
chSay(text); 

424 
exit 

425 
end; 

426 

427 
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

428 

2017  429 
if byte(s[1]) < 4 then 
430 
begin 

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

431 
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

432 
if Gear <> nil then 
9a8ccc7bc3d8
Fix crash caused by speechbubbles when restoring from save or joining already started net game
unc0rr
parents:
2111
diff
changeset

433 
begin 
9a8ccc7bc3d8
Fix crash caused by speechbubbles when restoring from save or joining already started net game
unc0rr
parents:
2111
diff
changeset

434 
Gear^.Hedgehog:= CurrentHedgehog; 
9a8ccc7bc3d8
Fix crash caused by speechbubbles when restoring from save or joining already started net game
unc0rr
parents:
2111
diff
changeset

435 
Gear^.Text:= text; 
9a8ccc7bc3d8
Fix crash caused by speechbubbles when restoring from save or joining already started net game
unc0rr
parents:
2111
diff
changeset

436 
Gear^.FrameTicks:= byte(s[1]) 
9a8ccc7bc3d8
Fix crash caused by speechbubbles when restoring from save or joining already started net game
unc0rr
parents:
2111
diff
changeset

437 
end 
2017  438 
end 
439 
else 

440 
begin 

2022  441 
SpeechType:= byte(s[1])3; 
2017  442 
SpeechText:= text 
443 
end; 

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

444 

2017  445 
end; 
446 

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

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

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

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

450 

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

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

452 

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

453 
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

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

455 

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

456 
procedure doPut(putX, putY: LongInt; fromAI: boolean); 
4  457 
begin 
458 
if CheckNoTeamOrHH then exit; 

162  459 
if bShowAmmoMenu then 
460 
begin 

461 
bSelected:= true; 

462 
exit 

463 
end; 

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

464 

602  465 
with CurrentHedgehog^.Gear^, 
466 
CurrentHedgehog^ do 

4  467 
if (State and gstHHChooseTarget) <> 0 then 
468 
begin 

469 
isCursorVisible:= false; 

351  470 
if not CurrentTeam^.ExtDriven then 
4  471 
begin 
543
465e2ec8f05f
 Better randomness of placing hedgehogs on the land
unc0rr
parents:
542
diff
changeset

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

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

474 
TargetPoint.X:= putX; 
465e2ec8f05f
 Better randomness of placing hedgehogs on the land
unc0rr
parents:
542
diff
changeset

475 
TargetPoint.Y:= putY 
465e2ec8f05f
 Better randomness of placing hedgehogs on the land
unc0rr
parents:
542
diff
changeset

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

477 
begin 
2171
8208946331ba
Smaxx refactor of LoadImage to use flags, iphone changes by koda (mostly use of rgba instead of rgb)
nemo
parents:
2162
diff
changeset

478 
{$IFDEF SDL13} 
8208946331ba
Smaxx refactor of LoadImage to use flags, iphone changes by koda (mostly use of rgba instead of rgb)
nemo
parents:
2162
diff
changeset

479 
SDL_GetMouseState(0, @TargetPoint.X, @TargetPoint.Y); 
8208946331ba
Smaxx refactor of LoadImage to use flags, iphone changes by koda (mostly use of rgba instead of rgb)
nemo
parents:
2162
diff
changeset

480 
{$ELSE} 
8208946331ba
Smaxx refactor of LoadImage to use flags, iphone changes by koda (mostly use of rgba instead of rgb)
nemo
parents:
2162
diff
changeset

481 
SDL_GetMouseState(@TargetPoint.X, @TargetPoint.Y); 
8208946331ba
Smaxx refactor of LoadImage to use flags, iphone changes by koda (mostly use of rgba instead of rgb)
nemo
parents:
2162
diff
changeset

482 
{$ENDIF} 
2205  483 
dec(TargetPoint.X, cScreenWidth div 2); 
543
465e2ec8f05f
 Better randomness of placing hedgehogs on the land
unc0rr
parents:
542
diff
changeset

484 
dec(TargetPoint.X, WorldDx); 
465e2ec8f05f
 Better randomness of placing hedgehogs on the land
unc0rr
parents:
542
diff
changeset

485 
dec(TargetPoint.Y, WorldDy) 
465e2ec8f05f
 Better randomness of placing hedgehogs on the land
unc0rr
parents:
542
diff
changeset

486 
end; 
154
5667e6f38704
Network protocol uses integers in network byte order
unc0rr
parents:
145
diff
changeset

487 
SendIPCXY('p', TargetPoint.X, TargetPoint.Y); 
4  488 
end; 
927
2c1675344a6f
Remove AltSlot and AltAmmo fields of Hedgehog record, as they are not actually needed
unc0rr
parents:
926
diff
changeset

489 
State:= State and not gstHHChooseTarget; 
351  490 
if (Ammo^[CurSlot, CurAmmo].Propz and ammoprop_AttackingPut) <> 0 then 
263  491 
Message:= Message or gm_Attack; 
351  492 
end else if CurrentTeam^.ExtDriven then 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

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

494 

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

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

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

497 
doPut(0, 0, false) 
4  498 
end; 
499 

500 
procedure chCapture(var s: shortstring); 

501 
begin 

502 
flagMakeCapture:= true 

503 
end; 

504 

48  505 
procedure chSkip(var s: shortstring); 
506 
begin 

351  507 
if not CurrentTeam^.ExtDriven then SendIPC(','); 
871  508 
uStats.Skipped; 
917  509 
skipFlag:= true 
48  510 
end; 
511 

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

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

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

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

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

516 
Pathz[ptMapCurrent]:= Pathz[ptMaps] + '/' + s; 
e09f7c952a40
Send run parameters by cmd line, game parameters by IPC... breaks network game
unc0rr
parents:
48
diff
changeset

517 
InitStepsFlags:= InitStepsFlags or cifMap 
e09f7c952a40
Send run parameters by cmd line, game parameters by IPC... breaks network game
unc0rr
parents:
48
diff
changeset

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

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

520 

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

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

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

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

524 
begin 
80  525 
Pathz[ptCurrTheme]:= Pathz[ptThemes] + '/' + s; 
55
e09f7c952a40
Send run parameters by cmd line, game parameters by IPC... breaks network game
unc0rr
parents:
48
diff
changeset

526 
InitStepsFlags:= InitStepsFlags or cifTheme 
e09f7c952a40
Send run parameters by cmd line, game parameters by IPC... breaks network game
unc0rr
parents:
48
diff
changeset

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

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

529 

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

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

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

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

533 
begin 
102  534 
SetRandomSeed(s); 
81  535 
cSeed:= s; 
55
e09f7c952a40
Send run parameters by cmd line, game parameters by IPC... breaks network game
unc0rr
parents:
48
diff
changeset

536 
InitStepsFlags:= InitStepsFlags or cifRandomize 
e09f7c952a40
Send run parameters by cmd line, game parameters by IPC... breaks network game
unc0rr
parents:
48
diff
changeset

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

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

539 

161  540 
procedure chAmmoMenu(var s: shortstring); 
541 
begin 

542 
if CheckNoTeamOrHH then exit; 

543 
with CurrentTeam^ do 

544 
with Hedgehogs[CurrHedgehog] do 

545 
begin 

162  546 
bSelected:= false; 
682  547 

161  548 
if bShowAmmoMenu then bShowAmmoMenu:= false 
351  549 
else if ((Gear^.State and (gstAttacking or gstAttacked)) <> 0) or (AttacksNum > 0) 
550 
or ((Gear^.State and gstHHDriven) = 0) then else bShowAmmoMenu:= true 

161  551 
end 
552 
end; 

553 

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

554 
procedure chFullScr(var s: shortstring); 
2920ab2bf329
Switching between fullscreen and windowed modes on 'F' key
unc0rr
parents:
162
diff
changeset

555 
var flags: Longword; 
192  556 
{$IFDEF DEBUGFILE} 
557 
buf: array[byte] of char; 

558 
{$ENDIF} 

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

559 
begin 
1051
dfdd5dfe97d4
Enable fullscreen switching back, now it's bound on F12
unc0rr
parents:
1035
diff
changeset

560 
if Length(s) = 0 then cFullScreen:= not cFullScreen 
166
2920ab2bf329
Switching between fullscreen and windowed modes on 'F' key
unc0rr
parents:
162
diff
changeset

561 
else cFullScreen:= s = '1'; 
192  562 

905  563 
{$IFDEF DEBUGFILE} 
564 
AddFileLog('Prepare to change video parameters...'); 

565 
{$ENDIF} 

2253  566 

753  567 
SDL_GL_SetAttribute(SDL_GL_DOUBLEBUFFER, 1); 
2253  568 
{$IFDEF IPHONEOS} 
569 
//remove these if they cause incompatibility 

570 
SDL_GL_SetAttribute(SDL_GL_DOUBLEBUFFER, 0); 

571 
SDL_GL_SetAttribute(SDL_GL_RETAINED_BACKING, 1); 

572 
SDL_GL_SetAttribute(SDL_GL_DEPTH_SIZE, 0); 

573 
{$ENDIF} 

753  574 

1127  575 
flags:= SDL_OPENGL;// or SDL_RESIZABLE; 
1121
d595dc56b4f3
Remember initial resolution settings to use when switching to fullscreen mode
unc0rr
parents:
1120
diff
changeset

576 
if cFullScreen then 
d595dc56b4f3
Remember initial resolution settings to use when switching to fullscreen mode
unc0rr
parents:
1120
diff
changeset

577 
begin 
d595dc56b4f3
Remember initial resolution settings to use when switching to fullscreen mode
unc0rr
parents:
1120
diff
changeset

578 
flags:= flags or SDL_FULLSCREEN; 
d595dc56b4f3
Remember initial resolution settings to use when switching to fullscreen mode
unc0rr
parents:
1120
diff
changeset

579 
cScreenWidth:= cInitWidth; 
d595dc56b4f3
Remember initial resolution settings to use when switching to fullscreen mode
unc0rr
parents:
1120
diff
changeset

580 
cScreenHeight:= cInitHeight 
d595dc56b4f3
Remember initial resolution settings to use when switching to fullscreen mode
unc0rr
parents:
1120
diff
changeset

581 
end 
d595dc56b4f3
Remember initial resolution settings to use when switching to fullscreen mode
unc0rr
parents:
1120
diff
changeset

582 
else SDL_WM_SetCaption('Hedgewars', nil); 
905  583 
{$IFDEF DEBUGFILE} 
584 
AddFileLog('Freeing old primary surface...'); 

585 
{$ENDIF} 

1525  586 
if SDLPrimSurface <> nil then SDL_FreeSurface(SDLPrimSurface); 
904  587 

1836  588 
{$IFDEF DARWIN} 
2240
7ce9e6b7be3b
Removal of older WAV files, now useless thanks to OpenAL
koda
parents:
2205
diff
changeset

589 
//remove the topbar from Mac and iPhone 
1836  590 
flags:= flags or SDL_NOFRAME; 
591 
{$ENDIF} 

2240
7ce9e6b7be3b
Removal of older WAV files, now useless thanks to OpenAL
koda
parents:
2205
diff
changeset

592 

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

593 
SDLPrimSurface:= SDL_SetVideoMode(cScreenWidth, cScreenHeight, cBits, flags); 
904  594 
SDLTry(SDLPrimSurface <> nil, true); 
192  595 

905  596 
{$IFDEF DEBUGFILE} 
597 
AddFileLog('Setting up OpenGL...'); 

598 
{$ENDIF} 

753  599 
SetupOpenGL(); 
600 

192  601 
{$IFDEF DEBUGFILE} 
602 
AddFileLog('SDL video driver: ' + string(SDL_VideoDriverName(buf, sizeof(buf)))); 

603 
{$ENDIF} 

351  604 
PixelFormat:= SDLPrimSurface^.format 
166
2920ab2bf329
Switching between fullscreen and windowed modes on 'F' key
unc0rr
parents:
162
diff
changeset

605 
end; 
161  606 

175  607 
procedure chVol_p(var s: shortstring); 
174  608 
begin 
175  609 
inc(cVolumeDelta, 3) 
174  610 
end; 
611 

175  612 
procedure chVol_m(var s: shortstring); 
174  613 
begin 
175  614 
dec(cVolumeDelta, 3) 
174  615 
end; 
616 

176  617 
procedure chFindhh(var s: shortstring); 
618 
begin 

619 
if CheckNoTeamOrHH then exit; 

620 
bShowFinger:= true; 

602  621 
FollowGear:= CurrentHedgehog^.Gear 
176  622 
end; 
623 

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

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

625 
begin 
1743  626 
if gameType <> gmtNet then 
627 
isPaused:= not isPaused; 

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

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

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

630 

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

631 
procedure chRotateMask(var s: shortstring); 
691  632 
const map: array[0..7] of byte = (7,4,0,1,2,3,0,5); 
539
6a9bf1852bbc
Ability to choose which info is shown above hedgehogs
unc0rr
parents:
534
diff
changeset

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

634 
cTagsMask:= map[cTagsMask] 
6a9bf1852bbc
Ability to choose which info is shown above hedgehogs
unc0rr
parents:
534
diff
changeset

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

636 

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

640 
i: LongInt; 

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

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

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

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

645 
Delete(s, 1, 1); 
615  646 

647 
i:= 0; 

648 
while (i < MAXPARAMS) and 

649 
(Length(s) > 0) do 

650 
begin 

651 
SplitBySpace(s, tmp); 

652 
val(s, params[i]); 

653 
s:= tmp; 

654 
inc(i) 

655 
end; 

656 

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

657 
case c of 
613  658 
's': begin // sTYPE TICKS LIVES GEARTYPE X Y GEARTRIGGER 
615  659 
TryDo(i = 7, errmsgWrongNumber, true); 
660 
AddTriggerSpawner(params[0], params[1], params[2], TGearType(params[3]), params[4], params[5], params[6]); 

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

661 
end; 
613  662 
'C': begin 
615  663 
TryDo(i = 3, errmsgWrongNumber, true); 
664 
AddTriggerSuccess(params[0], params[1], params[2]); 

665 
end; 

666 
'F': begin 

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

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

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

670 
end 
589  671 
end; 
626  672 

673 
procedure chSpeedup_p(var s: shortstring); 

674 
begin 

675 
isSpeed:= true 

676 
end; 

677 

678 
procedure chSpeedup_m(var s: shortstring); 

679 
begin 

680 
isSpeed:= false 

681 
end; 

946  682 

2162  683 
procedure chZoomIn(var s: shortstring); 
684 
begin 

685 
if zoom < 4.0 then zoom:= zoom + 0.25; 

686 
end; 

687 

688 
procedure chZoomOut(var s: shortstring); 

689 
begin 

690 
if zoom > 0.25 then zoom:= zoom  0.25; 

691 
end; 

692 

946  693 
procedure chChat(var s: shortstring); 
694 
begin 

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

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

696 
KeyPressChat(27) 
946  697 
end; 
991  698 

699 
procedure chHistory(var s: shortstring); 

700 
begin 

701 
uChat.showAll:= not uChat.showAll 

702 
end; 