hedgewars/uIO.pas
author Wuzzy <Wuzzy2@mail.ru>
Thu, 03 Jan 2019 19:46:48 +0100
changeset 14519 5ac181cb2396
parent 14468 bd1db668b7c0
child 15098 8cb1eebee4a0
permissions -rw-r--r--
Fix bee targeting fail across wrap world edge Previously, the bee always aimed for the light area, no matter where you actually put the target. It also got confused whenever it flew across the wrap world edge. How the bee works now: 1) The placed bee target is *not* recalculated when it was placed in the "gray" part of the wrap world edge. This allows for more fine-tuning. 1a) Place target in light area: bee aims for target light area 1b) Place target in gray area: bee aims for target, but flies to gray area first 2) Bee target is recalculated whenever bee passes the wrap world edge.

(*
 * Hedgewars, a free turn based strategy game
 * Copyright (c) 2004-2015 Andrey Korotaev <unC0Rr@gmail.com>
 *
 * This program is free software; you can redistribute it and/or modify
 * it under the terms of the GNU General Public License as published by
 * the Free Software Foundation; version 2 of the License
 *
 * This program is distributed in the hope that it will be useful,
 * but WITHOUT ANY WARRANTY; without even the implied warranty of
 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 * GNU General Public License for more details.
 *
 * You should have received a copy of the GNU General Public License
 * along with this program; if not, write to the Free Software
 * Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
 *)

{$INCLUDE "options.inc"}

unit uIO;
interface
uses SDLh, uTypes;

procedure initModule;
procedure freeModule;

procedure InitIPC;
procedure SendIPC(s: shortstring);
procedure SendIPCXY(cmd: char; X, Y: LongInt);
procedure SendIPCRaw(p: pointer; len: Longword);
procedure SendIPCAndWaitReply(s: shortstring);
procedure FlushMessages(Lag: Longword);
procedure LoadRecordFromFile(fileName: shortstring);
procedure SendStat(sit: TStatInfoType; s: shortstring);
procedure IPCWaitPongEvent;
procedure IPCCheckSock;
procedure NetGetNextCmd;
procedure doPut(putX, putY: LongInt; fromAI: boolean);

implementation
uses uConsole, uConsts, uVariables, uCommands, uUtils, uDebug, uLocale;

const
    cSendEmptyPacketTime = 1000;
    cSendBufferSize = 1024;

type PCmd = ^TCmd;
     TCmd = packed record
            Next: PCmd;
            loTime: Word;
            case byte of
            1: (len: byte;
                cmd: Char);
            2: (str: shortstring);
            end;

var IPCSock: PTCPSocket;
    fds: PSDLNet_SocketSet;
    isPonged: boolean;
    SocketString: shortstring;

    headcmd: PCmd;
    lastcmd: PCmd;

    flushDelayTicks: LongWord;
    sendBuffer: record
                buf: array[0..Pred(cSendBufferSize)] of byte;
                count: Word;
                end;

function AddCmd(Time: Word; str: shortstring): PCmd;
var command: PCmd;
begin
    if (lastcmd <> nil)
            and (lastcmd^.cmd = '+') // don't overwrite timestamped msg with non-timestamped one
            and (str[1] <> 'F')
            and (str[1] <> 'G')
            and (str[1] <> 's')
            and (str[1] <> 'h')
            and (str[1] <> 'b')
    then
    begin
        command:= lastcmd;
    end else
    begin
        new(command);

        if headcmd = nil then
            begin
            headcmd:= command;
            lastcmd:= command
            end
        else
            begin
            lastcmd^.Next:= command;
            lastcmd:= command
            end;
    end;

    FillChar(command^, sizeof(TCmd), 0);
    command^.loTime:= Time;
    command^.str:= str;
    if (command^.cmd <> 'F') and (command^.cmd <> 'G') then dec(command^.len, 2); // cut timestamp

    AddCmd:= command;
end;

procedure RemoveCmd;
var tmp: PCmd;
begin
tmp:= headcmd;
headcmd:= headcmd^.Next;
if headcmd = nil then
    lastcmd:= nil;
dispose(tmp)
end;

procedure InitIPC;
var ipaddr: TIPAddress;
begin
    WriteToConsole('Init SDL_Net... ');
    SDLCheck(SDLNet_Init = 0, 'SDLNet_Init', true);
    fds:= SDLNet_AllocSocketSet(1);
    SDLCheck(fds <> nil, 'SDLNet_AllocSocketSet', true);
    WriteLnToConsole(msgOK);
    WriteToConsole('Establishing IPC connection to tcp 127.0.0.1:' + IntToStr(ipcPort) + ' ');
    {$HINTS OFF}
    SDLCheck(SDLNet_ResolveHost(ipaddr, PChar('127.0.0.1'), ipcPort) = 0, 'SDLNet_ResolveHost', true);
    {$HINTS ON}
    IPCSock:= SDLNet_TCP_Open(ipaddr);
    SDLCheck(IPCSock <> nil, 'SDLNet_TCP_Open', true);
    WriteLnToConsole(msgOK)
end;

procedure ParseChatCommand(command: shortstring; message: shortstring;
                           messageStartIndex: Byte);
var
    text: shortstring;
begin
    text:= copy(message, messageStartIndex,
                Length(message) - messageStartIndex + 1);
    ParseCommand(command + text, true);
    WriteLnToConsole(text)
end;

procedure ParseIPCCommand(s: shortstring);
var loTicks: Word;
    isProcessed: boolean;
    nick, msg: shortstring;
    i: LongInt;
begin
isProcessed := true;

case s[1] of
     '!': begin AddFileLog('Ping? Pong!'); isPonged:= true; end;
     '?': SendIPC(_S'!');
     'e': ParseCommand(copy(s, 2, Length(s) - 1), true);
     'E': OutError(copy(s, 2, Length(s) - 1), true);
     'W': OutError(copy(s, 2, Length(s) - 1), false);
     'M': ParseCommand('landcheck ' + s, true);
     'o': if fastUntilLag then ParseCommand('forcequit', true);
     'T': case s[2] of
               'L': GameType:= gmtLocal;
               'D': GameType:= gmtDemo;
               'N': GameType:= gmtNet;
               'S': GameType:= gmtSave;
               'V': GameType:= gmtRecord;
               else OutError(errmsgIncorrectUse + ' IPC "T" :' + s[2], true) end;
     'V': begin
              if s[2] = '.' then
                  ParseCommand('campvar ' + copy(s, 3, length(s) - 2), true);
          end;
     'v': begin
              if s[2] = '.' then
                  ParseCommand('missvar ' + copy(s, 3, length(s) - 2), true);
          end;
     'I': ParseCommand('pause server', true);
     's': if gameType = gmtNet then
             ParseChatCommand('chatmsg ', s, 2)
          else
             isProcessed:= false;
     'b': if gameType = gmtNet then
             // parse team message from net
             // expected format: <PLAYER NAME>]<MESSAGE>
             begin
             i:= 2;
             nick:= '';
             while (i <= length(s)) and (s[i] <> ']') do
                begin
                nick:= nick + s[i];
                inc(i)
                end;

             inc(i);
             msg:= '';
             while (i <= length(s)) do
                begin
                msg:= msg + s[i];
                inc(i)
                end;
             s:= 'b' + Format(shortstring(trmsg[sidChatTeam]), nick, msg);
             if (nick = '') or (msg = '') then
                 isProcessed:= false
             else
                 ParseChatCommand('chatmsg ' + #4, s, 2);
             end
          else
             isProcessed:= false;
     else
        isProcessed:= false;
     end;

    if (not isProcessed) then
    begin
        loTicks:= SDLNet_Read16(@s[byte(s[0]) - 1]);
        AddCmd(loTicks, s);
        AddFileLog('[IPC in] ' + sanitizeCharForLog(s[1]) + ' ticks ' + IntToStr(lastcmd^.loTime));
    end
end;

procedure IPCCheckSock;
var i: LongInt;
    s: shortstring;
begin
    if IPCSock = nil then
        exit;

    fds^.numsockets:= 0;
    SDLNet_AddSocket(fds, IPCSock);

    while SDLNet_CheckSockets(fds, 0) > 0 do
    begin
        i:= SDLNet_TCP_Recv(IPCSock, @s[1], 255 - Length(SocketString));
        if i > 0 then
        begin
            s[0]:= char(i);
            SocketString:= SocketString + s;
            while (Length(SocketString) > 1) and (Length(SocketString) > byte(SocketString[1])) do
            begin
                ParseIPCCommand(copy(SocketString, 2, byte(SocketString[1])));
                Delete(SocketString, 1, Succ(byte(SocketString[1])))
            end
        end
    else
        OutError('IPC connection lost', true)
    end;
end;

procedure LoadRecordFromFile(fileName: shortstring);
var f  : File;
    ss : shortstring = '';
    i  : LongInt;
    s  : shortstring;
begin

// set RDNLY on file open
filemode:= 0;
{$I-}
assign(f, fileName);
reset(f, 1);
if checkFails(IOResult = 0, 'Error opening file ' + fileName, true) then
    exit;

i:= 0; // avoid compiler hints
s[0]:= #0;
repeat
    BlockRead(f, s[1], 255 - Length(ss), i);
    if i > 0 then
        begin
        s[0]:= char(i);
        ss:= ss + s;
        while (Length(ss) > 1)and(Length(ss) > byte(ss[1])) and allOK do
            begin
            ParseIPCCommand(copy(ss, 2, byte(ss[1])));
            Delete(ss, 1, Succ(byte(ss[1])));
            end
        end
until (i = 0) or (not allOK);

close(f)
{$I+}
end;

procedure SendStat(sit: TStatInfoType; s: shortstring);
const stc: array [TStatInfoType] of char = ('r', 'D', 'k', 'K', 'H', 'T', 'P', 's', 'S', 'B', 'c', 'g', 'p', 'R', 'h');
var buf: shortstring;
begin
buf:= 'i' + stc[sit] + s;
SendIPCRaw(@buf[0], length(buf) + 1)
end;

function isSyncedCommand(c: char): boolean;
begin
    case c of
    '+', '#', 'L', 'l', 'R', 'r', 'U'
    , 'u', 'D', 'd', 'Z', 'z', 'A', 'a'
    , 'S', 'j', 'J', ',', 'c', 'N', 'p'
    , 'P', 'w', 't', '1', '2', '3', '4'
    , '5', 'f', 'g': isSyncedCommand:= true;
    else
        isSyncedCommand:= ((byte(c) >= 128) and (byte(c) <= 128 + cMaxSlotIndex))
    end
end;

procedure flushBuffer();
begin
    if IPCSock <> nil then
        begin
        SDLNet_TCP_Send(IPCSock, @sendBuffer.buf, sendBuffer.count);
        flushDelayTicks:= 0;
        sendBuffer.count:= 0
        end
end;

procedure SendIPC(s: shortstring);
begin
if IPCSock <> nil then
    begin
    if s[0] > #251 then
        s[0]:= #251;

    SDLNet_Write16(GameTicks, @s[Succ(byte(s[0]))]);

    AddFileLog('[IPC out] '+ sanitizeCharForLog(s[1]));
    inc(s[0], 2);

    if isSyncedCommand(s[1]) then
        begin
        if sendBuffer.count + byte(s[0]) >= cSendBufferSize then
            flushBuffer();

        Move(s, sendBuffer.buf[sendBuffer.count], byte(s[0]) + 1);
        inc(sendBuffer.count, byte(s[0]) + 1);

        if (s[1] = 'N') or (s[1] = '#') then
            flushBuffer();
        end else
        SDLNet_TCP_Send(IPCSock, @s, Succ(byte(s[0])))
    end
end;

procedure SendIPCRaw(p: pointer; len: Longword);
begin
if IPCSock <> nil then
    begin
    SDLNet_TCP_Send(IPCSock, p, len)
    end
end;

procedure SendIPCXY(cmd: char; X, Y: LongInt);
var s: shortstring;
begin
s[0]:= #9;
s[1]:= cmd;
SDLNet_Write32(X, @s[2]);
SDLNet_Write32(Y, @s[6]);
SendIPC(s)
end;

procedure IPCWaitPongEvent;
begin
isPonged:= false;
repeat
    IPCCheckSock;
    SDL_Delay(1)
until isPonged or (not allOK)
end;

procedure SendIPCAndWaitReply(s: shortstring);
begin
SendIPC(s);
SendIPC(_S'?');
IPCWaitPongEvent
end;

procedure FlushMessages(Lag: Longword);
begin
inc(flushDelayTicks, Lag);
if (flushDelayTicks >= cSendEmptyPacketTime) then
    begin
    if sendBuffer.count = 0 then
        SendIPC(_S'+');

     flushBuffer()
    end
end;

procedure NetGetNextCmd;
var tmpflag: boolean;
    s: shortstring;
    x32, y32: LongInt;
begin
tmpflag:= true;

while (headcmd <> nil)
    and (tmpflag or (headcmd^.cmd = '#')) // '#' is the only cmd which can be sent within same tick after 'N'
    and ((GameTicks = LongWord(hiTicks shl 16 + headcmd^.loTime))
        or (headcmd^.cmd = 's') // for these commands time is not specified
        or (headcmd^.cmd = 'h') // seems the hedgewars protocol does not allow remote synced commands
        or (headcmd^.cmd = '#') // must be synced for saves to work
        or (headcmd^.cmd = 'b')
        or (headcmd^.cmd = 'F')
        or (headcmd^.cmd = 'G')) do
    begin
    case headcmd^.cmd of
        '+': ; // do nothing - it is just an empty packet
        '#': begin
            AddFileLog('hiTicks increment by remote message');
            inc(hiTicks);
            end;
        'L': ParseCommand('+left', true);
        'l': ParseCommand('-left', true);
        'R': ParseCommand('+right', true);
        'r': ParseCommand('-right', true);
        'U': ParseCommand('+up', true);
        'u': ParseCommand('-up', true);
        'D': ParseCommand('+down', true);
        'd': ParseCommand('-down', true);
        'Z': ParseCommand('+precise', true);
        'z': ParseCommand('-precise', true);
        'A': ParseCommand('+attack', true);
        'a': ParseCommand('-attack', true);
        'S': ParseCommand('switch', true);
        'j': ParseCommand('ljump', true);
        'J': ParseCommand('hjump', true);
        ',': ParseCommand('skip', true);
        'c': begin
            s:= copy(headcmd^.str, 2, Pred(headcmd^.len));
            ParseCommand('gencmd ' + s, true);
             end;
        's': ParseChatCommand('chatmsg ', headcmd^.str, 2);
        'b': ParseChatCommand('chatmsg ' + #4, headcmd^.str, 2);
        'F': ParseCommand('teamgone u' + copy(headcmd^.str, 2, Pred(headcmd^.len)), true);
        'G': ParseCommand('teamback u' + copy(headcmd^.str, 2, Pred(headcmd^.len)), true);
        'f': ParseCommand('teamgone s' + copy(headcmd^.str, 2, Pred(headcmd^.len)), true);
        'g': ParseCommand('teamback s' + copy(headcmd^.str, 2, Pred(headcmd^.len)), true);
        'N': begin
            tmpflag:= false;
            lastTurnChecksum:= SDLNet_Read32(@headcmd^.str[2]);
            AddFileLog('got cmd "N": time '+IntToStr(hiTicks shl 16 + headcmd^.loTime))
             end;
        'p': begin
            x32:= SDLNet_Read32(@(headcmd^.str[2]));
            y32:= SDLNet_Read32(@(headcmd^.str[6]));
            doPut(x32, y32, false)
             end;
        'P': begin
            // these are equations solved for CursorPoint
            // SDLNet_Read16(@(headcmd^.X)) == CursorPoint.X - WorldDx;
            // SDLNet_Read16(@(headcmd^.Y)) == cScreenHeight - CursorPoint.Y - WorldDy;
            if CurrentTeam^.ExtDriven then
               begin
               TargetCursorPoint.X:= LongInt(SDLNet_Read32(@(headcmd^.str[2]))) + WorldDx;
               TargetCursorPoint.Y:= cScreenHeight - LongInt(SDLNet_Read32(@(headcmd^.str[6]))) - WorldDy;
               if not bShowAmmoMenu and autoCameraOn then
                    CursorPoint:= TargetCursorPoint
               end
             end;
        'w': ParseCommand('setweap ' + headcmd^.str[2], true);
        't': ParseCommand('taunt ' + headcmd^.str[2], true);
        'h': ParseCommand('hogsay ' + copy(headcmd^.str, 2, Pred(headcmd^.len)), true);
        '1'..'5': ParseCommand('timer ' + headcmd^.cmd, true);
        else
            if (byte(headcmd^.cmd) >= 128) and (byte(headcmd^.cmd) <= 128 + cMaxSlotIndex) then
                ParseCommand('slot ' + char(byte(headcmd^.cmd) - 79), true)
                else
                OutError('Unexpected protocol command: ' + headcmd^.cmd, True)
        end;
    RemoveCmd
    end;

if (headcmd <> nil) and tmpflag and (not CurrentTeam^.hasGone) then
    checkFails(GameTicks < LongWord(hiTicks shl 16) + headcmd^.loTime,
            'oops, queue error. in buffer: ' + headcmd^.cmd +
            ' (' + IntToStr(GameTicks) + ' > ' +
            IntToStr(hiTicks shl 16 + headcmd^.loTime) + ')',
            true);

isInLag:= (headcmd = nil) and tmpflag and (not CurrentTeam^.hasGone);

if isInLag and fastUntilLag then 
begin
    ParseCommand('spectate 0', true);
    fastUntilLag:= false
end;
end;

procedure chFatalError(var s: shortstring);
begin
    SendIPC('E' + s);
    // TODO: should we try to clean more stuff here?
    SDL_Quit;

    if IPCSock <> nil then
        halt(HaltFatalError)
    else
        halt(HaltFatalErrorNoIPC);
end;

procedure doPut(putX, putY: LongInt; fromAI: boolean);
begin
if CheckNoTeamOrHH or isPaused then
    exit;
bShowFinger:= false;
if (not CurrentTeam^.ExtDriven) and bShowAmmoMenu then
    begin
    bSelected:= true;
    exit
    end;

with CurrentHedgehog^.Gear^,
    CurrentHedgehog^ do
    if (State and gstChooseTarget) <> 0 then
        begin
        if (Ammoz[CurAmmoType].Ammo.Propz and ammoprop_NoTargetAfter) <> 0 then
            isCursorVisible:= false;
        if not CurrentTeam^.ExtDriven then
            begin
            if fromAI then
                begin
                TargetPoint.X:= putX;
                TargetPoint.Y:= putY
                end
            else
                begin
                TargetPoint.X:= CursorPoint.X - WorldDx;
                TargetPoint.Y:= cScreenHeight - CursorPoint.Y - WorldDy;
                end;
            if (WorldEdge <> weBounce) and ((Ammoz[CurAmmoType].Ammo.Propz and ammoprop_NoWrapTarget) = 0) then
                TargetPoint.X:= CalcWorldWrap(TargetPoint.X, 0);
            SendIPCXY('p', TargetPoint.X, TargetPoint.Y);
            end
        else
            begin
            if (Ammoz[CurAmmoType].Ammo.Propz and ammoprop_NoWrapTarget) = 0 then
                TargetPoint.X:= CalcWorldWrap(TargetPoint.X, 0);
            TargetPoint.X:= putX;
            TargetPoint.Y:= putY
            end;
        AddFileLog('put: ' + inttostr(TargetPoint.X) + ', ' + inttostr(TargetPoint.Y));
        State:= State and (not gstChooseTarget);
        if (Ammoz[CurAmmoType].Ammo.Propz and ammoprop_AttackingPut) <> 0 then
            Message:= Message or (gmAttack and InputMask);
        end
    else
        if CurrentTeam^.ExtDriven then
            OutError('Got /put while not being in choose target mode', false)
end;

procedure initModule;
begin
    RegisterVariable('fatal', @chFatalError, true );

    IPCSock:= nil;
    fds:= nil;

    headcmd:= nil;
    lastcmd:= nil;
    isPonged:= false;
    SocketString:= '';

    hiTicks:= 0;
    flushDelayTicks:= 0;
    sendBuffer.count:= 0;
end;

procedure freeModule;
begin
    while headcmd <> nil do RemoveCmd;
    SDLNet_FreeSocketSet(fds);
    SDLNet_TCP_Close(IPCSock);
    SDLNet_Quit();

end;

end.