1 (*
2 * Hedgewars, a free turn based strategy game
3 * Copyright (c) 2004-2015 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., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA
17 *)
18
19 {$INCLUDE "options.inc"}
20
21 unit uIO;
22 interface
23 uses SDLh, uTypes;
24
25 procedure initModule;
26 procedure freeModule;
27
28 procedure InitIPC;
29 procedure SendIPC(s: shortstring);
30 procedure SendIPCXY(cmd: char; X, Y: LongInt);
31 procedure SendIPCRaw(p: pointer; len: Longword);
32 procedure SendIPCAndWaitReply(s: shortstring);
33 procedure FlushMessages(Lag: Longword);
34 procedure LoadRecordFromFile(fileName: shortstring);
35 procedure SendStat(sit: TStatInfoType; s: shortstring);
36 procedure IPCWaitPongEvent;
37 procedure IPCCheckSock;
38 procedure NetGetNextCmd;
39 procedure doPut(putX, putY: LongInt; fromAI: boolean);
40
41 implementation
42 uses uConsole, uConsts, uVariables, uCommands, uUtils, uDebug, uLocale, uSound;
43
44 const
45 cSendEmptyPacketTime = 1000;
46 cSendBufferSize = 1024;
47
48 type PCmd = ^TCmd;
49 TCmd = packed record
50 Next: PCmd;
51 loTime: Word;
52 case byte of
53 1: (len: byte;
54 cmd: Char);
55 2: (str: shortstring);
56 end;
57
58 var IPCSock: PTCPSocket;
59 fds: PSDLNet_SocketSet;
60 isPonged: boolean;
61 SocketString: shortstring;
62
63 headcmd: PCmd;
64 lastcmd: PCmd;
65
66 flushDelayTicks: LongWord;
67 sendBuffer: record
68 buf: array[0..Pred(cSendBufferSize)] of byte;
69 count: Word;
70 end;
71
AddCmdnull72 function AddCmd(Time: Word; str: shortstring): PCmd;
73 var command: PCmd;
74 begin
75 if (lastcmd <> nil)
76 and (lastcmd^.cmd = '+') // don't overwrite timestamped msg with non-timestamped one
77 and (str[1] <> 'F')
78 and (str[1] <> 'G')
79 and (str[1] <> 's')
80 and (str[1] <> 'h')
81 and (str[1] <> 'b')
82 then
83 begin
84 command:= lastcmd;
85 end else
86 begin
87 new(command);
88
89 if headcmd = nil then
90 begin
91 headcmd:= command;
92 lastcmd:= command
93 end
94 else
95 begin
96 lastcmd^.Next:= command;
97 lastcmd:= command
98 end;
99 end;
100
101 FillChar(command^, sizeof(TCmd), 0);
102 command^.loTime:= Time;
103 command^.str:= str;
104 if (command^.cmd <> 'F') and (command^.cmd <> 'G') then dec(command^.len, 2); // cut timestamp
105
106 AddCmd:= command;
107 end;
108
109 procedure RemoveCmd;
110 var tmp: PCmd;
111 begin
112 tmp:= headcmd;
113 headcmd:= headcmd^.Next;
114 if headcmd = nil then
115 lastcmd:= nil;
116 dispose(tmp)
117 end;
118
119 procedure InitIPC;
120 var ipaddr: TIPAddress;
121 begin
122 WriteToConsole('Init SDL_Net... ');
123 SDLCheck(SDLNet_Init = 0, 'SDLNet_Init', true);
124 fds:= SDLNet_AllocSocketSet(1);
125 SDLCheck(fds <> nil, 'SDLNet_AllocSocketSet', true);
126 WriteLnToConsole(msgOK);
127 WriteToConsole('Establishing IPC connection to tcp 127.0.0.1:' + IntToStr(ipcPort) + ' ');
128 {$HINTS OFF}
129 SDLCheck(SDLNet_ResolveHost(ipaddr, PChar('127.0.0.1'), ipcPort) = 0, 'SDLNet_ResolveHost', true);
130 {$HINTS ON}
131 IPCSock:= SDLNet_TCP_Open(ipaddr);
132 SDLCheck(IPCSock <> nil, 'SDLNet_TCP_Open', true);
133 WriteLnToConsole(msgOK)
134 end;
135
136 procedure ParseChatCommand(command: shortstring; message: shortstring;
137 messageStartIndex: Byte);
138 var
139 text: shortstring;
140 begin
141 text:= copy(message, messageStartIndex,
142 Length(message) - messageStartIndex + 1);
143 ParseCommand(command + text, true);
144 WriteLnToConsole(text)
145 end;
146
147 procedure ParseIPCCommand(s: shortstring);
148 var loTicks: Word;
149 isProcessed: boolean;
150 nick, msg: shortstring;
151 i: LongInt;
152 begin
153 isProcessed := true;
154
155 case s[1] of
156 '!': begin AddFileLog('Ping? Pong!'); isPonged:= true; end;
157 '?': SendIPC(_S'!');
158 'e': ParseCommand(copy(s, 2, Length(s) - 1), true);
159 'E': OutError(copy(s, 2, Length(s) - 1), true);
160 'W': OutError(copy(s, 2, Length(s) - 1), false);
161 'M': ParseCommand('landcheck ' + s, true);
162 'o': if fastUntilLag then ParseCommand('forcequit', true);
163 'T': case s[2] of
164 'L': GameType:= gmtLocal;
165 'D': GameType:= gmtDemo;
166 'N': GameType:= gmtNet;
167 'S': GameType:= gmtSave;
168 'V': GameType:= gmtRecord;
169 else OutError(errmsgIncorrectUse + ' IPC "T" :' + s[2], true) end;
170 'V': begin
171 if s[2] = '.' then
172 ParseCommand('campvar ' + copy(s, 3, length(s) - 2), true);
173 end;
174 'v': begin
175 if s[2] = '.' then
176 ParseCommand('missvar ' + copy(s, 3, length(s) - 2), true);
177 end;
178 'I': ParseCommand('pause server', true);
179 's': if gameType = gmtNet then
180 ParseChatCommand('chatmsg ', s, 2)
181 else
182 isProcessed:= false;
183 'b': if gameType = gmtNet then
184 // parse team message from net
185 // expected format: <PLAYER NAME>]<MESSAGE>
186 begin
187 i:= 2;
188 nick:= '';
189 while (i <= length(s)) and (s[i] <> ']') do
190 begin
191 nick:= nick + s[i];
192 inc(i)
193 end;
194
195 inc(i);
196 msg:= '';
197 while (i <= length(s)) do
198 begin
199 msg:= msg + s[i];
200 inc(i)
201 end;
202 s:= 'b' + Format(shortstring(trmsg[sidChatTeam]), nick, msg);
203 if (nick = '') or (msg = '') then
204 isProcessed:= false
205 else
206 ParseChatCommand('chatmsg ' + #4, s, 2);
207 end
208 else
209 isProcessed:= false;
210 else
211 isProcessed:= false;
212 end;
213
214 if (not isProcessed) then
215 begin
216 loTicks:= SDLNet_Read16(@s[byte(s[0]) - 1]);
217 AddCmd(loTicks, s);
218 AddFileLog('[IPC in] ' + sanitizeCharForLog(s[1]) + ' ticks ' + IntToStr(lastcmd^.loTime));
219 end
220 end;
221
222 procedure IPCCheckSock;
223 var i: LongInt;
224 s: shortstring;
225 begin
226 if IPCSock = nil then
227 exit;
228
229 fds^.numsockets:= 0;
230 SDLNet_AddSocket(fds, IPCSock);
231
232 while SDLNet_CheckSockets(fds, 0) > 0 do
233 begin
234 i:= SDLNet_TCP_Recv(IPCSock, @s[1], 255 - Length(SocketString));
235 if i > 0 then
236 begin
237 s[0]:= char(i);
238 SocketString:= SocketString + s;
239 while (Length(SocketString) > 1) and (Length(SocketString) > byte(SocketString[1])) do
240 begin
241 ParseIPCCommand(copy(SocketString, 2, byte(SocketString[1])));
242 Delete(SocketString, 1, Succ(byte(SocketString[1])))
243 end
244 end
245 else
246 OutError('IPC connection lost', true)
247 end;
248 end;
249
250 procedure LoadRecordFromFile(fileName: shortstring);
251 var f : File;
252 ss : shortstring = '';
253 i : LongInt;
254 s : shortstring;
255 begin
256
257 // set RDNLY on file open
258 filemode:= 0;
259 {$I-}
260 assign(f, fileName);
261 reset(f, 1);
262 if checkFails(IOResult = 0, 'Error opening file ' + fileName, true) then
263 exit;
264
265 i:= 0; // avoid compiler hints
266 s[0]:= #0;
267 repeat
268 BlockRead(f, s[1], 255 - Length(ss), i);
269 if i > 0 then
270 begin
271 s[0]:= char(i);
272 ss:= ss + s;
273 while (Length(ss) > 1)and(Length(ss) > byte(ss[1])) and allOK do
274 begin
275 ParseIPCCommand(copy(ss, 2, byte(ss[1])));
276 Delete(ss, 1, Succ(byte(ss[1])));
277 end
278 end
279 until (i = 0) or (not allOK);
280
281 close(f)
282 {$I+}
283 end;
284
285 procedure SendStat(sit: TStatInfoType; s: shortstring);
286 const stc: array [TStatInfoType] of char = ('r', 'D', 'k', 'K', 'H', 'T', 'P', 's', 'S', 'B', 'c', 'g', 'p', 'R', 'h');
287 var buf: shortstring;
288 begin
289 buf:= 'i' + stc[sit] + s;
290 SendIPCRaw(@buf[0], length(buf) + 1)
291 end;
292
293 function isSyncedCommand(c: char): boolean;
294 begin
295 case c of
296 '+', '#', 'L', 'l', 'R', 'r', 'U'
297 , 'u', 'D', 'd', 'Z', 'z', 'A', 'a'
298 , 'S', 'j', 'J', ',', 'c', 'N', 'p'
299 , 'P', 'w', 't', '1', '2', '3', '4'
300 , '5', 'f', 'g': isSyncedCommand:= true;
301 else
302 isSyncedCommand:= ((byte(c) >= 128) and (byte(c) <= 128 + cMaxSlotIndex))
303 end
304 end;
305
306 procedure flushBuffer();
307 begin
308 if IPCSock <> nil then
309 begin
310 SDLNet_TCP_Send(IPCSock, @sendBuffer.buf, sendBuffer.count);
311 flushDelayTicks:= 0;
312 sendBuffer.count:= 0
313 end
314 end;
315
316 procedure SendIPC(s: shortstring);
317 begin
318 if IPCSock <> nil then
319 begin
320 if s[0] > #251 then
321 s[0]:= #251;
322
323 SDLNet_Write16(GameTicks, @s[Succ(byte(s[0]))]);
324
325 AddFileLog('[IPC out] '+ sanitizeCharForLog(s[1]));
326 inc(s[0], 2);
327
328 if isSyncedCommand(s[1]) then
329 begin
330 if sendBuffer.count + byte(s[0]) >= cSendBufferSize then
331 flushBuffer();
332
333 Move(s, sendBuffer.buf[sendBuffer.count], byte(s[0]) + 1);
334 inc(sendBuffer.count, byte(s[0]) + 1);
335
336 if (s[1] = 'N') or (s[1] = '#') then
337 flushBuffer();
338 end else
339 SDLNet_TCP_Send(IPCSock, @s, Succ(byte(s[0])))
340 end
341 end;
342
343 procedure SendIPCRaw(p: pointer; len: Longword);
344 begin
345 if IPCSock <> nil then
346 begin
347 SDLNet_TCP_Send(IPCSock, p, len)
348 end
349 end;
350
351 procedure SendIPCXY(cmd: char; X, Y: LongInt);
352 var s: shortstring;
353 begin
354 s[0]:= #9;
355 s[1]:= cmd;
356 SDLNet_Write32(X, @s[2]);
357 SDLNet_Write32(Y, @s[6]);
358 SendIPC(s)
359 end;
360
361 procedure IPCWaitPongEvent;
362 begin
363 isPonged:= false;
364 repeat
365 IPCCheckSock;
366 SDL_Delay(1)
367 until isPonged or (not allOK)
368 end;
369
370 procedure SendIPCAndWaitReply(s: shortstring);
371 begin
372 SendIPC(s);
373 SendIPC(_S'?');
374 IPCWaitPongEvent
375 end;
376
377 procedure FlushMessages(Lag: Longword);
378 begin
379 inc(flushDelayTicks, Lag);
380 if (flushDelayTicks >= cSendEmptyPacketTime) then
381 begin
382 if sendBuffer.count = 0 then
383 SendIPC(_S'+');
384
385 flushBuffer()
386 end
387 end;
388
389 procedure NetGetNextCmd;
390 var tmpflag: boolean;
391 s: shortstring;
392 x32, y32: LongInt;
393 begin
394 tmpflag:= true;
395
396 while (headcmd <> nil)
397 and (tmpflag or (headcmd^.cmd = '#')) // '#' is the only cmd which can be sent within same tick after 'N'
398 and ((GameTicks = LongWord(hiTicks shl 16 + headcmd^.loTime))
399 or (headcmd^.cmd = 's') // for these commands time is not specified
400 or (headcmd^.cmd = 'h') // seems the hedgewars protocol does not allow remote synced commands
401 or (headcmd^.cmd = '#') // must be synced for saves to work
402 or (headcmd^.cmd = 'b')
403 or (headcmd^.cmd = 'F')
404 or (headcmd^.cmd = 'G')) do
405 begin
406 case headcmd^.cmd of
407 '+': ; // do nothing - it is just an empty packet
408 '#': begin
409 AddFileLog('hiTicks increment by remote message');
410 inc(hiTicks);
411 end;
412 'L': ParseCommand('+left', true);
413 'l': ParseCommand('-left', true);
414 'R': ParseCommand('+right', true);
415 'r': ParseCommand('-right', true);
416 'U': ParseCommand('+up', true);
417 'u': ParseCommand('-up', true);
418 'D': ParseCommand('+down', true);
419 'd': ParseCommand('-down', true);
420 'Z': ParseCommand('+precise', true);
421 'z': ParseCommand('-precise', true);
422 'A': ParseCommand('+attack', true);
423 'a': ParseCommand('-attack', true);
424 'S': ParseCommand('switch', true);
425 'j': ParseCommand('ljump', true);
426 'J': ParseCommand('hjump', true);
427 ',': ParseCommand('skip', true);
428 'c': begin
429 s:= copy(headcmd^.str, 2, Pred(headcmd^.len));
430 ParseCommand('gencmd ' + s, true);
431 end;
432 's': ParseChatCommand('chatmsg ', headcmd^.str, 2);
433 'b': ParseChatCommand('chatmsg ' + #4, headcmd^.str, 2);
434 'F': ParseCommand('teamgone u' + copy(headcmd^.str, 2, Pred(headcmd^.len)), true);
435 'G': ParseCommand('teamback u' + copy(headcmd^.str, 2, Pred(headcmd^.len)), true);
436 'f': ParseCommand('teamgone s' + copy(headcmd^.str, 2, Pred(headcmd^.len)), true);
437 'g': ParseCommand('teamback s' + copy(headcmd^.str, 2, Pred(headcmd^.len)), true);
438 'N': begin
439 tmpflag:= false;
440 lastTurnChecksum:= SDLNet_Read32(@headcmd^.str[2]);
441 AddFileLog('got cmd "N": time '+IntToStr(hiTicks shl 16 + headcmd^.loTime))
442 end;
443 'p': begin
444 x32:= SDLNet_Read32(@(headcmd^.str[2]));
445 y32:= SDLNet_Read32(@(headcmd^.str[6]));
446 doPut(x32, y32, false)
447 end;
448 'P': begin
449 // these are equations solved for CursorPoint
450 // SDLNet_Read16(@(headcmd^.X)) == CursorPoint.X - WorldDx;
451 // SDLNet_Read16(@(headcmd^.Y)) == cScreenHeight - CursorPoint.Y - WorldDy;
452 if CurrentTeam^.ExtDriven then
453 begin
454 TargetCursorPoint.X:= LongInt(SDLNet_Read32(@(headcmd^.str[2]))) + WorldDx;
455 TargetCursorPoint.Y:= cScreenHeight - LongInt(SDLNet_Read32(@(headcmd^.str[6]))) - WorldDy;
456 if not bShowAmmoMenu and autoCameraOn then
457 CursorPoint:= TargetCursorPoint
458 end
459 end;
460 'w': ParseCommand('setweap ' + headcmd^.str[2], true);
461 't': ParseCommand('taunt ' + headcmd^.str[2], true);
462 'h': ParseCommand('hogsay ' + copy(headcmd^.str, 2, Pred(headcmd^.len)), true);
463 '1'..'5': ParseCommand('timer ' + headcmd^.cmd, true);
464 else
465 if (byte(headcmd^.cmd) >= 128) and (byte(headcmd^.cmd) <= 128 + cMaxSlotIndex) then
466 ParseCommand('slot ' + char(byte(headcmd^.cmd) - 79), true)
467 else
468 OutError('Unexpected protocol command: ' + headcmd^.cmd, True)
469 end;
470 RemoveCmd
471 end;
472
473 if (headcmd <> nil) and tmpflag and (not CurrentTeam^.hasGone) then
474 checkFails(GameTicks < LongWord(hiTicks shl 16) + headcmd^.loTime,
475 'oops, queue error. in buffer: ' + headcmd^.cmd +
476 ' (' + IntToStr(GameTicks) + ' > ' +
477 IntToStr(hiTicks shl 16 + headcmd^.loTime) + ')',
478 true);
479
480 isInLag:= (headcmd = nil) and tmpflag and (not CurrentTeam^.hasGone);
481
482 if isInLag and fastUntilLag then
483 begin
484 ParseCommand('spectate 0', true);
485 fastUntilLag:= false
486 end;
487 end;
488
489 procedure chFatalError(var s: shortstring);
490 begin
491 SendIPC('E' + s);
492 // TODO: should we try to clean more stuff here?
493 SDL_Quit;
494
495 if IPCSock <> nil then
496 halt(HaltFatalError)
497 else
498 halt(HaltFatalErrorNoIPC);
499 end;
500
501 procedure doPut(putX, putY: LongInt; fromAI: boolean);
502 begin
503 if CheckNoTeamOrHH or isPaused then
504 exit;
505 bShowFinger:= false;
506 if (not CurrentTeam^.ExtDriven) and bShowAmmoMenu then
507 begin
508 bSelected:= true;
509 exit
510 end;
511
512 with CurrentHedgehog^.Gear^,
513 CurrentHedgehog^ do
514 if (State and gstChooseTarget) <> 0 then
515 if ((((Ammoz[CurAmmoType].Ammo.Propz and ammoprop_AttackInMove) <> 0) or ((State and gstMoving) = 0)) or ((Ammoz[CurAmmoType].Ammo.Propz and ammoprop_AttackingPut) = 0)) then
516 begin
517 if (Ammoz[CurAmmoType].Ammo.Propz and ammoprop_NoTargetAfter) <> 0 then
518 isCursorVisible:= false;
519 if not CurrentTeam^.ExtDriven then
520 begin
521 if fromAI then
522 begin
523 TargetPoint.X:= putX;
524 TargetPoint.Y:= putY
525 end
526 else
527 begin
528 TargetPoint.X:= CursorPoint.X - WorldDx;
529 TargetPoint.Y:= cScreenHeight - CursorPoint.Y - WorldDy;
530 end;
531 if (WorldEdge <> weBounce) and ((Ammoz[CurAmmoType].Ammo.Propz and ammoprop_NoWrapTarget) = 0) then
532 TargetPoint.X:= CalcWorldWrap(TargetPoint.X, 0);
533 SendIPCXY('p', TargetPoint.X, TargetPoint.Y);
534 end
535 else
536 begin
537 if (Ammoz[CurAmmoType].Ammo.Propz and ammoprop_NoWrapTarget) = 0 then
538 TargetPoint.X:= CalcWorldWrap(TargetPoint.X, 0);
539 TargetPoint.X:= putX;
540 TargetPoint.Y:= putY
541 end;
542 AddFileLog('put: ' + inttostr(TargetPoint.X) + ', ' + inttostr(TargetPoint.Y));
543 State:= State and (not gstChooseTarget);
544 if (Ammoz[CurAmmoType].Ammo.Propz and ammoprop_AttackingPut) <> 0 then
545 Message:= Message or (gmAttack and InputMask);
546 Message:= Message and (not (gmHJump or gmLJump or gmLeft or gmRight or gmUp or gmDown));
547 end
548 else
549 PlaySound(sndDenied)
550 else
551 if CurrentTeam^.ExtDriven then
552 OutError('Got /put while not being in choose target mode', false)
553 end;
554
555 procedure initModule;
556 begin
557 RegisterVariable('fatal', @chFatalError, true );
558
559 IPCSock:= nil;
560 fds:= nil;
561
562 headcmd:= nil;
563 lastcmd:= nil;
564 isPonged:= false;
565 SocketString:= '';
566
567 hiTicks:= 0;
568 flushDelayTicks:= 0;
569 sendBuffer.count:= 0;
570 end;
571
572 procedure freeModule;
573 begin
574 while headcmd <> nil do RemoveCmd;
575 SDLNet_FreeSocketSet(fds);
576 SDLNet_TCP_Close(IPCSock);
577 SDLNet_Quit();
578
579 end;
580
581 end.
582