hedgewars/uIO.pas
changeset 1 30f2d1037d5d
child 4 bcbd7adb4e4b
equal deleted inserted replaced
0:475c0f2f9d17 1:30f2d1037d5d
       
     1 (*
       
     2  * Hedgewars, a worms-like game
       
     3  * Copyright (c) 2004, 2005 Andrey Korotaev <unC0Rr@gmail.com>
       
     4  *
       
     5  * Distributed under the terms of the BSD-modified licence:
       
     6  *
       
     7  * Permission is hereby granted, free of charge, to any person obtaining a copy
       
     8  * of this software and associated documentation files (the "Software"), to deal
       
     9  * with the Software without restriction, including without limitation the
       
    10  * rights to use, copy, modify, merge, publish, distribute, sublicense, and/or
       
    11  * sell copies of the Software, and to permit persons to whom the Software is
       
    12  * furnished to do so, subject to the following conditions:
       
    13  *
       
    14  * 1. Redistributions of source code must retain the above copyright notice,
       
    15  *    this list of conditions and the following disclaimer.
       
    16  * 2. Redistributions in binary form must reproduce the above copyright notice,
       
    17  *    this list of conditions and the following disclaimer in the documentation
       
    18  *    and/or other materials provided with the distribution.
       
    19  * 3. The name of the author may not be used to endorse or promote products
       
    20  *    derived from this software without specific prior written permission.
       
    21  *
       
    22  * THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR IMPLIED
       
    23  * WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
       
    24  * MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO
       
    25  * EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
       
    26  * SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
       
    27  * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS;
       
    28  * OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
       
    29  * WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
       
    30  * OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
       
    31  * ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
       
    32  *)
       
    33 
       
    34 unit uIO;
       
    35 interface
       
    36 uses SDLh;
       
    37 {$INCLUDE options.inc}
       
    38 
       
    39 const ipcPort: Word = 0;
       
    40 
       
    41 procedure SendIPC(s: shortstring);
       
    42 procedure SendIPCAndWaitReply(s: shortstring);
       
    43 procedure IPCCheckSock;
       
    44 procedure InitIPC;
       
    45 procedure CloseIPC;
       
    46 procedure NetGetNextCmd;
       
    47 
       
    48 implementation
       
    49 uses uConsole, uConsts, uWorld, uMisc;
       
    50 const isPonged: boolean = false;
       
    51 var  IPCSock: PTCPSocket;
       
    52      fds: PSDLNet_SocketSet;
       
    53 
       
    54      extcmd: array[word] of packed record
       
    55                                    Time: LongWord;
       
    56                                    case byte of
       
    57                                         1: (len: byte;
       
    58                                             cmd: Char;
       
    59                                             X, Y: integer;);
       
    60                                         2: (str: shortstring);
       
    61                                    end;
       
    62      cmdcurpos: integer = 0;
       
    63      cmdendpos: integer = -1;
       
    64 
       
    65 procedure InitIPC;
       
    66 var ipaddr: TIPAddress;
       
    67 begin
       
    68 WriteToConsole('Init SDL_Net... ');
       
    69 SDLTry(SDLNet_Init = 0, true);
       
    70 fds:= SDLNet_AllocSocketSet(1);
       
    71 SDLTry(fds <> nil, true);
       
    72 WriteLnToConsole(msgOK);
       
    73 WriteToConsole('Establishing IPC connection... ');
       
    74 SDLTry(SDLNet_ResolveHost(ipaddr, '127.0.0.1', ipcPort) = 0, true);
       
    75 IPCSock:= SDLNet_TCP_Open(ipaddr);
       
    76 SDLTry(IPCSock <> nil, true);
       
    77 WriteLnToConsole(msgOK)
       
    78 end;
       
    79 
       
    80 procedure CloseIPC;
       
    81 begin
       
    82 SDLNet_FreeSocketSet(fds);
       
    83 SDLNet_TCP_Close(IPCSock);
       
    84 SDLNet_Quit
       
    85 end;
       
    86 
       
    87 procedure ParseIPCCommand(s: shortstring);
       
    88 begin
       
    89 case s[1] of
       
    90      '!': isPonged:= true;
       
    91      '?': SendIPC('!');
       
    92      'e': ParseCommand(copy(s, 2, Length(s) - 1));
       
    93      'E': OutError(copy(s, 2, Length(s) - 1), true);
       
    94      'W': OutError(copy(s, 2, Length(s) - 1), false);
       
    95      'T': case s[2] of
       
    96                'L': GameType:= gmtLocal;
       
    97                'D': GameType:= gmtDemo;
       
    98                'N': GameType:= gmtNet;
       
    99                else OutError(errmsgIncorrectUse + ' IPC "T" :' + s[2], true) end;
       
   100      else
       
   101      inc(cmdendpos);
       
   102      extcmd[cmdendpos].Time := PLongWord(@s[byte(s[0]) - 3])^;
       
   103      extcmd[cmdendpos].str  := s;
       
   104      {$IFDEF DEBUGFILE}AddFileLog('IPC in: '+s[1]+' ticks '+inttostr(extcmd[cmdendpos].Time)+' at '+inttostr(cmdendpos));{$ENDIF}
       
   105      dec(extcmd[cmdendpos].len, 4)
       
   106      end
       
   107 end;
       
   108 
       
   109 procedure IPCCheckSock;
       
   110 const ss: string = '';
       
   111 var i: integer;
       
   112     buf: array[0..255] of byte;
       
   113     s: shortstring absolute buf;
       
   114 begin
       
   115 fds.numsockets:= 0;
       
   116 SDLNet_AddSocket(fds, IPCSock);
       
   117 
       
   118 while SDLNet_CheckSockets(fds, 0) > 0 do
       
   119       begin
       
   120       i:= SDLNet_TCP_Recv(IPCSock, @buf[1], 255);
       
   121       if i > 0 then
       
   122          begin
       
   123          buf[0]:= i;
       
   124          ss:= ss + s;
       
   125          while (Length(ss) > 1)and(Length(ss) > byte(ss[1])) do
       
   126                begin
       
   127                ParseIPCCommand(copy(ss, 2, byte(ss[1])));
       
   128                Delete(ss, 1, Succ(byte(ss[1])))
       
   129                end
       
   130          end else OutError('IPC connection lost', true)
       
   131       end;
       
   132 end;
       
   133 
       
   134 procedure SendIPC(s: shortstring);
       
   135 begin
       
   136 //WriteLnToConsole(s);
       
   137 if s[0]>#251 then s[0]:= #251;
       
   138 PLongWord(@s[Succ(byte(s[0]))])^:= GameTicks;
       
   139 {$IFDEF DEBUGFILE}AddFileLog('IPC send: '+s);{$ENDIF}
       
   140 inc(s[0],4);
       
   141 SDLNet_TCP_Send(IPCSock, @s, Succ(byte(s[0])))
       
   142 end;
       
   143 
       
   144 procedure SendIPCAndWaitReply(s: shortstring);
       
   145 begin
       
   146 SendIPC(s);
       
   147 s:= '?';
       
   148 SDLNet_TCP_Send(IPCSock, @s, Succ(byte(s[0])));
       
   149 isPonged:= false;
       
   150 repeat
       
   151    IPCCheckSock;
       
   152    SDL_Delay(1)
       
   153 until isPonged
       
   154 end;
       
   155 
       
   156 procedure NetGetNextCmd;
       
   157 var tmpflag: boolean;
       
   158 begin
       
   159 while (cmdcurpos <= cmdendpos)and(extcmd[cmdcurpos].cmd = 's') do
       
   160       begin
       
   161       WriteLnToConsole('> ' + copy(extcmd[cmdcurpos].str, 2, Pred(extcmd[cmdcurpos].len)));
       
   162       AddCaption('> ' + copy(extcmd[cmdcurpos].str, 2, Pred(extcmd[cmdcurpos].len)), $FFFFFF, capgrpNetSay);
       
   163       inc(cmdcurpos)
       
   164       end;
       
   165          
       
   166 if cmdcurpos <= cmdendpos then
       
   167    if GameTicks > extcmd[cmdcurpos].Time then
       
   168       outerror('oops, queue error. in buffer: '+extcmd[cmdcurpos].cmd+' ('+inttostr(GameTicks)+' > '+inttostr(extcmd[cmdcurpos].Time)+')', true);
       
   169 
       
   170 tmpflag:= true;
       
   171 while (cmdcurpos <= cmdendpos)and(GameTicks = extcmd[cmdcurpos].Time) do
       
   172    begin
       
   173    case extcmd[cmdcurpos].cmd of
       
   174         'L': ParseCommand('/+left');
       
   175         'l': ParseCommand('/-left');
       
   176         'R': ParseCommand('/+right');
       
   177         'r': ParseCommand('/-right');
       
   178         'U': ParseCommand('/+up');
       
   179         'u': ParseCommand('/-up');
       
   180         'D': ParseCommand('/+down');
       
   181         'd': ParseCommand('/-down');
       
   182         'A': ParseCommand('/+attack');
       
   183         'a': ParseCommand('/-attack');
       
   184         'S': ParseCommand('/switch');
       
   185         'j': ParseCommand('/ljump');
       
   186         'J': ParseCommand('/hjump');
       
   187         'N': begin
       
   188              tmpflag:= false;
       
   189              {$IFDEF DEBUGFILE}AddFileLog('got cmd "N": time '+inttostr(extcmd[cmdcurpos].Time)){$ENDIF}
       
   190              end;
       
   191         'p': begin
       
   192              TargetPoint.X:= extcmd[cmdcurpos].X;
       
   193              TargetPoint.Y:= extcmd[cmdcurpos].Y;
       
   194              ParseCommand('/put')
       
   195              end;
       
   196         'P': begin
       
   197              CursorPoint.X:= extcmd[cmdcurpos].X + WorldDx;
       
   198              CursorPoint.Y:= extcmd[cmdcurpos].Y + WorldDy;
       
   199              end;
       
   200         '1'..'5': ParseCommand('/timer ' + extcmd[cmdcurpos].cmd);
       
   201         #128..#131: ParseCommand('/slot ' + char(byte(extcmd[cmdcurpos].cmd) - 79))
       
   202         end;
       
   203    inc(cmdcurpos)
       
   204    end;
       
   205 isInLag:= (cmdcurpos > cmdendpos) and tmpflag
       
   206 end;
       
   207 
       
   208 end.