hedgewars/uIO.pas
branchexperimental3D
changeset 4812 f924be23ffb4
parent 4555 85150dfb5959
child 4814 e19791f08443
child 4815 f2a3e1a51f4d
equal deleted inserted replaced
4347:0ddb100fea61 4812:f924be23ffb4
    18 
    18 
    19 {$INCLUDE "options.inc"}
    19 {$INCLUDE "options.inc"}
    20 
    20 
    21 unit uIO;
    21 unit uIO;
    22 interface
    22 interface
    23 uses SDLh;
    23 uses SDLh, uTypes;
    24 
    24 
    25 var ipcPort: Word = 0;
    25 var ipcPort: Word = 0;
    26     hiTicks: Word;
    26     hiTicks: Word;
    27 
    27 
    28 procedure initModule;
    28 procedure initModule;
    33 procedure SendIPCRaw(p: pointer; len: Longword);
    33 procedure SendIPCRaw(p: pointer; len: Longword);
    34 procedure SendIPCAndWaitReply(s: shortstring);
    34 procedure SendIPCAndWaitReply(s: shortstring);
    35 procedure SendIPCTimeInc;
    35 procedure SendIPCTimeInc;
    36 procedure SendKeepAliveMessage(Lag: Longword);
    36 procedure SendKeepAliveMessage(Lag: Longword);
    37 procedure LoadRecordFromFile(fileName: shortstring);
    37 procedure LoadRecordFromFile(fileName: shortstring);
       
    38 procedure SendStat(sit: TStatInfoType; s: shortstring);
    38 procedure IPCWaitPongEvent;
    39 procedure IPCWaitPongEvent;
    39 procedure IPCCheckSock;
    40 procedure IPCCheckSock;
    40 procedure InitIPC;
    41 procedure InitIPC;
    41 procedure CloseIPC;
    42 procedure CloseIPC;
    42 procedure NetGetNextCmd;
    43 procedure NetGetNextCmd;
       
    44 procedure doPut(putX, putY: LongInt; fromAI: boolean);
    43 
    45 
    44 implementation
    46 implementation
    45 uses uConsole, uConsts, uWorld, uMisc, uLand, uChat, uTeams;
    47 uses uConsole, uConsts, uVariables, uCommands, uUtils, uDebug;
    46 
    48 
    47 type PCmd = ^TCmd;
    49 type PCmd = ^TCmd;
    48      TCmd = packed record
    50      TCmd = packed record
    49             Next: PCmd;
    51             Next: PCmd;
    50             loTime: Word;
    52             loTime: Word;
    61 
    63 
    62     headcmd: PCmd;
    64     headcmd: PCmd;
    63     lastcmd: PCmd;
    65     lastcmd: PCmd;
    64 
    66 
    65     SendEmptyPacketTicks: LongWord;
    67     SendEmptyPacketTicks: LongWord;
    66 
       
    67 
    68 
    68 function AddCmd(Time: Word; str: shortstring): PCmd;
    69 function AddCmd(Time: Word; str: shortstring): PCmd;
    69 var command: PCmd;
    70 var command: PCmd;
    70 begin
    71 begin
    71 new(command);
    72 new(command);
   126      '!': begin {$IFDEF DEBUGFILE}AddFileLog('Ping? Pong!');{$ENDIF}isPonged:= true; end;
   127      '!': begin {$IFDEF DEBUGFILE}AddFileLog('Ping? Pong!');{$ENDIF}isPonged:= true; end;
   127      '?': SendIPC('!');
   128      '?': SendIPC('!');
   128      'e': ParseCommand(copy(s, 2, Length(s) - 1), true);
   129      'e': ParseCommand(copy(s, 2, Length(s) - 1), true);
   129      'E': OutError(copy(s, 2, Length(s) - 1), true);
   130      'E': OutError(copy(s, 2, Length(s) - 1), true);
   130      'W': OutError(copy(s, 2, Length(s) - 1), false);
   131      'W': OutError(copy(s, 2, Length(s) - 1), false);
   131      'M': CheckLandDigest(s);
   132      'M': ParseCommand('landcheck ' + s, true);
   132      'T': case s[2] of
   133      'T': case s[2] of
   133                'L': GameType:= gmtLocal;
   134                'L': GameType:= gmtLocal;
   134                'D': GameType:= gmtDemo;
   135                'D': GameType:= gmtDemo;
   135                'N': GameType:= gmtNet;
   136                'N': GameType:= gmtNet;
   136                'S': GameType:= gmtSave;
   137                'S': GameType:= gmtSave;
   137                else OutError(errmsgIncorrectUse + ' IPC "T" :' + s[2], true) end;
   138                else OutError(errmsgIncorrectUse + ' IPC "T" :' + s[2], true) end;
   138      else
   139      else
   139      loTicks:= SDLNet_Read16(@s[byte(s[0]) - 1]);
   140      loTicks:= SDLNet_Read16(@s[byte(s[0]) - 1]);
   140      AddCmd(loTicks, s);
   141      AddCmd(loTicks, s);
   141      {$IFDEF DEBUGFILE}AddFileLog('IPC in: '+s[1]+' ticks '+inttostr(lastcmd^.loTime));{$ENDIF}
   142      {$IFDEF DEBUGFILE}AddFileLog('[IPC in] '+s[1]+' ticks '+IntToStr(lastcmd^.loTime));{$ENDIF}
   142      end
   143      end
   143 end;
   144 end;
   144 
   145 
   145 procedure IPCCheckSock;
   146 procedure IPCCheckSock;
   146 const ss: shortstring = '';
   147 const ss: shortstring = '';
   201 until i = 0;
   202 until i = 0;
   202 
   203 
   203 close(f)
   204 close(f)
   204 end;
   205 end;
   205 
   206 
       
   207 procedure SendStat(sit: TStatInfoType; s: shortstring);
       
   208 const stc: array [TStatInfoType] of char = 'rDkKHTPsSB';
       
   209 var buf: shortstring;
       
   210 begin
       
   211 buf:= 'i' + stc[sit] + s;
       
   212 SendIPCRaw(@buf[0], length(buf) + 1)
       
   213 end;
       
   214 
       
   215 
   206 procedure SendIPC(s: shortstring);
   216 procedure SendIPC(s: shortstring);
   207 begin
   217 begin
   208 if IPCSock <> nil then
   218 if IPCSock <> nil then
   209     begin
   219     begin
   210     SendEmptyPacketTicks:= 0;
   220     SendEmptyPacketTicks:= 0;
   211     if s[0]>#251 then s[0]:= #251;
   221     if s[0]>#251 then s[0]:= #251;
   212     SDLNet_Write16(GameTicks, @s[Succ(byte(s[0]))]);
   222     SDLNet_Write16(GameTicks, @s[Succ(byte(s[0]))]);
   213     {$IFDEF DEBUGFILE}AddFileLog('IPC send: '+ s[1]);{$ENDIF}
   223     {$IFDEF DEBUGFILE}AddFileLog('[IPC out] '+ s[1]);{$ENDIF}
   214     inc(s[0], 2);
   224     inc(s[0], 2);
   215     SDLNet_TCP_Send(IPCSock, @s, Succ(byte(s[0])))
   225     SDLNet_TCP_Send(IPCSock, @s, Succ(byte(s[0])))
   216     end
   226     end
   217 end;
   227 end;
   218 
   228 
   235 end;
   245 end;
   236 
   246 
   237 procedure SendIPCTimeInc;
   247 procedure SendIPCTimeInc;
   238 const timeinc: shortstring = '#';
   248 const timeinc: shortstring = '#';
   239 begin
   249 begin
   240 {$IFDEF DEBUGFILE}AddFileLog('IPC Send #');{$ENDIF}
   250 {$IFDEF DEBUGFILE}AddFileLog('[IPC out] <time increment>');{$ENDIF}
   241 SendIPCRaw(@timeinc, 2)
   251 SendIPCRaw(@timeinc, 2)
   242 end;
   252 end;
   243 
   253 
   244 procedure IPCWaitPongEvent;
   254 procedure IPCWaitPongEvent;
   245 begin
   255 begin
   273 
   283 
   274 while (headcmd <> nil)
   284 while (headcmd <> nil)
   275     and (tmpflag or (headcmd^.cmd = '#')) // '#' is the only cmd which can be sent within same tick after 'N'
   285     and (tmpflag or (headcmd^.cmd = '#')) // '#' is the only cmd which can be sent within same tick after 'N'
   276     and ((GameTicks = hiTicks shl 16 + headcmd^.loTime)
   286     and ((GameTicks = hiTicks shl 16 + headcmd^.loTime)
   277         or (headcmd^.cmd = 's') // for these commands time is not specified
   287         or (headcmd^.cmd = 's') // for these commands time is not specified
       
   288         or (headcmd^.cmd = 'h') // seems the hedgewars protocol does not allow remote synced commands
   278         or (headcmd^.cmd = '#')
   289         or (headcmd^.cmd = '#')
   279         or (headcmd^.cmd = 'b')
   290         or (headcmd^.cmd = 'b')
   280         or (headcmd^.cmd = 'F')) do
   291         or (headcmd^.cmd = 'F')) do
   281     begin
   292     begin
   282     case headcmd^.cmd of
   293     case headcmd^.cmd of
   296         'a': ParseCommand('-attack', true);
   307         'a': ParseCommand('-attack', true);
   297         'S': ParseCommand('switch', true);
   308         'S': ParseCommand('switch', true);
   298         'j': ParseCommand('ljump', true);
   309         'j': ParseCommand('ljump', true);
   299         'J': ParseCommand('hjump', true);
   310         'J': ParseCommand('hjump', true);
   300         ',': ParseCommand('skip', true);
   311         ',': ParseCommand('skip', true);
       
   312         'c': begin
       
   313             s:= copy(headcmd^.str, 2, Pred(headcmd^.len));
       
   314             ParseCommand('gencmd ' + s, true);
       
   315             end;
   301         's': begin
   316         's': begin
   302             s:= copy(headcmd^.str, 2, Pred(headcmd^.len));
   317             s:= copy(headcmd^.str, 2, Pred(headcmd^.len));
   303             AddChatString(s);
   318             ParseCommand('chatmsg ' + s, true);
   304             WriteLnToConsole(s)
   319             WriteLnToConsole(s)
   305             end;
   320             end;
   306         'b': begin
   321         'b': begin
   307             s:= copy(headcmd^.str, 2, Pred(headcmd^.len));
   322             s:= copy(headcmd^.str, 2, Pred(headcmd^.len));
   308             AddChatString(#4 + s);
   323             ParseCommand('chatmsg '#4 + s, true);
   309             WriteLnToConsole(s)
   324             WriteLnToConsole(s)
   310             end;
   325             end;
   311         'F': TeamGone(copy(headcmd^.str, 2, Pred(headcmd^.len)));
   326 // TODO: deprecate 'F'
       
   327         'F': ParseCommand('teamgone ' + copy(headcmd^.str, 2, Pred(headcmd^.len)), true);
   312         'N': begin
   328         'N': begin
   313             tmpflag:= false;
   329             tmpflag:= false;
   314             {$IFDEF DEBUGFILE}AddFileLog('got cmd "N": time '+inttostr(hiTicks shl 16 + headcmd^.loTime)){$ENDIF}
   330             {$IFDEF DEBUGFILE}AddFileLog('got cmd "N": time '+IntToStr(hiTicks shl 16 + headcmd^.loTime)){$ENDIF}
   315             end;
   331             end;
   316         'p': begin
   332         'p': begin
   317             x16:= SDLNet_Read16(@(headcmd^.X));
   333             x16:= SDLNet_Read16(@(headcmd^.X));
   318             y16:= SDLNet_Read16(@(headcmd^.Y));
   334             y16:= SDLNet_Read16(@(headcmd^.Y));
   319             doPut(x16, y16, false)
   335             doPut(x16, y16, false)
   340     end;
   356     end;
   341 
   357 
   342 if (headcmd <> nil) and tmpflag and (not CurrentTeam^.hasGone) then
   358 if (headcmd <> nil) and tmpflag and (not CurrentTeam^.hasGone) then
   343     TryDo(GameTicks < hiTicks shl 16 + headcmd^.loTime,
   359     TryDo(GameTicks < hiTicks shl 16 + headcmd^.loTime,
   344             'oops, queue error. in buffer: ' + headcmd^.cmd +
   360             'oops, queue error. in buffer: ' + headcmd^.cmd +
   345             ' (' + inttostr(GameTicks) + ' > ' +
   361             ' (' + IntToStr(GameTicks) + ' > ' +
   346             inttostr(hiTicks shl 16 + headcmd^.loTime) + ')',
   362             IntToStr(hiTicks shl 16 + headcmd^.loTime) + ')',
   347             true);
   363             true);
   348 
   364 
   349 isInLag:= (headcmd = nil) and tmpflag and (not CurrentTeam^.hasGone);
   365 isInLag:= (headcmd = nil) and tmpflag and (not CurrentTeam^.hasGone);
   350 
   366 
   351 if isInLag then fastUntilLag:= false
   367 if isInLag then fastUntilLag:= false
   352 end;
   368 end;
   353 
   369 
       
   370 procedure chFatalError(var s: shortstring);
       
   371 begin
       
   372     SendIPC('E' + s);
       
   373 end;
       
   374 
       
   375 procedure doPut(putX, putY: LongInt; fromAI: boolean);
       
   376 begin
       
   377 if CheckNoTeamOrHH or isPaused then exit;
       
   378 bShowFinger:= false;
       
   379 if not CurrentTeam^.ExtDriven and bShowAmmoMenu then
       
   380     begin
       
   381     bSelected:= true;
       
   382     exit
       
   383     end;
       
   384 
       
   385 with CurrentHedgehog^.Gear^,
       
   386     CurrentHedgehog^ do
       
   387     if (State and gstHHChooseTarget) <> 0 then
       
   388         begin
       
   389         isCursorVisible:= false;
       
   390         if not CurrentTeam^.ExtDriven then
       
   391             begin
       
   392             if fromAI then
       
   393                 begin
       
   394                 TargetPoint.X:= putX;
       
   395                 TargetPoint.Y:= putY
       
   396                 end else
       
   397                 begin
       
   398                 TargetPoint.X:= CursorPoint.X - WorldDx;
       
   399                 TargetPoint.Y:= cScreenHeight - CursorPoint.Y - WorldDy;
       
   400                 end;
       
   401             SendIPCXY('p', TargetPoint.X, TargetPoint.Y);
       
   402             end
       
   403         else
       
   404             begin
       
   405             TargetPoint.X:= putX;
       
   406             TargetPoint.Y:= putY
       
   407             end;
       
   408         {$IFDEF DEBUGFILE}AddFilelog('put: ' + inttostr(TargetPoint.X) + ', ' + inttostr(TargetPoint.Y));{$ENDIF}
       
   409         State:= State and not gstHHChooseTarget;
       
   410         if (Ammoz[CurAmmoType].Ammo.Propz and ammoprop_AttackingPut) <> 0 then
       
   411             Message:= Message or (gmAttack and InputMask);
       
   412         end
       
   413     else
       
   414         if CurrentTeam^.ExtDriven then
       
   415             OutError('got /put while not being in choose target mode', false)
       
   416 end;
       
   417 
   354 procedure initModule;
   418 procedure initModule;
   355 begin
   419 begin
       
   420     RegisterVariable('fatal', vtCommand, @chFatalError, true );
       
   421 
   356     IPCSock:= nil;
   422     IPCSock:= nil;
   357 
   423 
   358     headcmd:= nil;
   424     headcmd:= nil;
   359     lastcmd:= nil;
   425     lastcmd:= nil;
   360     isPonged:= false;   // was const
   426     isPonged:= false;   // was const