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