unit uFLIPC;

interface

uses SDLh, uFLTypes;

procedure initIPC;

procedure freeIPC;

procedure ipcToEngine(s: shortstring);

procedure ipcToEngineRaw(p: pointer; len: Longword); cdecl;

procedure ipcSetEngineBarrier(); cdecl;

procedure ipcRemoveBarrierFromEngineQueue(); cdecl;

//function  ipcReadFromEngine: shortstring;

//function  ipcCheckFromEngine: boolean;

procedure ipcToFrontend(s: shortstring);

procedure ipcToFrontendRaw(p: pointer; len: Longword);

function ipcReadFromFrontend: TIPCMessage;

function ipcCheckFromFrontend: boolean;

procedure registerIPCCallback(p: pointer; f: TIPCCallback);

implementation

var callbackPointerF: pointer;

    callbackFunctionF: TIPCCallback;

    callbackListenerThreadF: PSDL_Thread;

    queueFrontend, queueEngine: PIPCQueue;

procedure ipcSend(var s: TIPCMessage; queue: PIPCQueue);

var pmsg: PIPCMessage;

begin

    SDL_LockMutex(queue^.mut);

    s.next:= nil;

    s.barrier:= 0;

    if (queue^.msg.next = nil) and (queue^.msg.str[0] = #0) and (queue^.msg.buf = nil) and (queue^.msg.barrier = 0) then

    begin

        queue^.msg:= s;

    end else

    begin

        new(pmsg);

        pmsg^:= s;

        queue^.last^.next:= pmsg;

        queue^.last:= pmsg;

    end;

    SDL_CondSignal(queue^.cond);

    SDL_UnlockMutex(queue^.mut);

end;

function ipcRead(queue: PIPCQueue): TIPCMessage;

var pmsg: PIPCMessage;

begin

    SDL_LockMutex(queue^.mut);

    while ((queue^.msg.str[0] = #0) and (queue^.msg.buf = nil))

            and ((queue^.msg.barrier > 0) or (queue^.msg.next = nil) or ((queue^.msg.next^.barrier > 0) and (queue^.msg.next^.str[0] = #0) and (queue^.msg.next^.buf = nil))) do

        SDL_CondWait(queue^.cond, queue^.mut);

    if (queue^.msg.str[0] <> #0) or (queue^.msg.buf <> nil) then

        begin

            ipcRead:= queue^.msg;

            queue^.msg.str[0]:= #0;

            queue^.msg.buf:= nil;

        end else

        begin

            pmsg:= queue^.msg.next;

            ipcRead:= pmsg^;

            if pmsg^.barrier > 0 then

            begin

                pmsg^.str[0]:= #0;

                pmsg^.buf:= nil

            end else

            begin

                queue^.msg.next:= pmsg^.next;

                if queue^.msg.next = nil then queue^.last:= @queue^.msg;

                dispose(pmsg)

            end

        end;

    SDL_UnlockMutex(queue^.mut)

end;

function ipcCheck(queue: PIPCQueue): boolean;

begin

    SDL_LockMutex(queue^.mut);

    ipcCheck:= (queue^.msg.str[0] > #0) or (queue^.msg.buf <> nil) or

               ((queue^.msg.barrier = 0) and (queue^.msg.next <> nil) and ((queue^.msg.next^.barrier = 0) or (queue^.msg.next^.str[0] <> #0) or (queue^.msg.next^.buf <> nil)));

    SDL_UnlockMutex(queue^.mut)

end;

procedure ipcToEngine(s: shortstring);

var msg: TIPCMessage;

begin

    msg.str:= s;

    msg.buf:= nil;

    ipcSend(msg, queueEngine)

end;

procedure ipcToFrontend(s: shortstring);

var msg: TIPCMessage;

begin

    msg.str:= s;

    msg.buf:= nil;

    ipcSend(msg, queueFrontend)

end;

procedure ipcSetEngineBarrier(); cdecl;

begin

    SDL_LockMutex(queueEngine^.mut);

    inc(queueEngine^.last^.barrier);

    SDL_UnlockMutex(queueEngine^.mut);

end;

procedure ipcRemoveBarrierFromEngineQueue(); cdecl;

var pmsg, t: PIPCMessage;

    q: PIPCQueue;

begin

    q:= queueEngine;

    SDL_LockMutex(q^.mut);

    pmsg:= @q^.msg;

    while pmsg <> nil do

    begin

        t:= pmsg^.next;

        q^.msg.next:= t;

        pmsg^.str[0]:= #0;

        if pmsg^.buf <> nil then

        begin

            FreeMem(pmsg^.buf, pmsg^.len);

            pmsg^.buf:= nil

        end;

        if pmsg <> @q^.msg then

            if pmsg^.barrier = 0 then

                dispose(pmsg)

            else

            if pmsg^.barrier = 1 then

            begin

                dispose(pmsg);

                t:= nil

            end else

            begin

                dec(pmsg^.barrier);

                q^.msg.next:= pmsg;

                t:= nil

            end

        else

            if pmsg^.barrier > 0 then 

            begin

                dec(pmsg^.barrier);

                t:= nil

            end;

        pmsg:= t

    end;

    if q^.msg.next = nil then q^.last:= @q^.msg;

    q^.msg.str[0]:= #0;

    q^.msg.buf:= nil;

    SDL_UnlockMutex(q^.mut);

end;

procedure ipcToEngineRaw(p: pointer; len: Longword); cdecl;

var msg: TIPCMessage;

begin

    msg.str[0]:= #0;

    msg.len:= len;

    msg.buf:= GetMem(len);

    Move(p^, msg.buf^, len);

    ipcSend(msg, queueEngine)

end;

procedure ipcToFrontendRaw(p: pointer; len: Longword);

var msg: TIPCMessage;

begin

    msg.str[0]:= #0;

    msg.len:= len;

    msg.buf:= GetMem(len);

    Move(p^, msg.buf^, len);

    ipcSend(msg, queueFrontend)

end;

function ipcReadFromEngine: TIPCMessage;

begin

    ipcReadFromEngine:= ipcRead(queueFrontend)

end;

function ipcReadFromFrontend: TIPCMessage;

begin

    ipcReadFromFrontend:= ipcRead(queueEngine)

end;

function ipcCheckFromEngine: boolean;

begin

    ipcCheckFromEngine:= ipcCheck(queueFrontend)

end;

function ipcCheckFromFrontend: boolean;

begin

    ipcCheckFromFrontend:= ipcCheck(queueEngine)

end;

function  engineListener(p: pointer): Longint; cdecl; export;

var msg: TIPCMessage;

begin

    engineListener:= 0;

    repeat

        msg:= ipcReadFromEngine();

        if msg.buf = nil then

            callbackFunctionF(callbackPointerF, @msg.str[1], byte(msg.str[0]))

        else

        begin

            callbackFunctionF(callbackPointerF, msg.buf, msg.len);

            FreeMem(msg.buf, msg.len)

        end

    until false

end;

procedure registerIPCCallback(p: pointer; f: TIPCCallback);

begin

    callbackPointerF:= p;

    callbackFunctionF:= f;

    callbackListenerThreadF:= SDL_CreateThread(@engineListener, 'engineListener', nil);

end;

function createQueue: PIPCQueue;

var q: PIPCQueue;

begin

    new(q);

    q^.msg.str:= '';

    q^.msg.buf:= nil;

    q^.msg.barrier:= 0;

    q^.mut:= SDL_CreateMutex;

    q^.cond:= SDL_CreateCond;

    q^.msg.next:= nil;

    q^.last:= @q^.msg;

    createQueue:= q

end;

procedure destroyQueue(queue: PIPCQueue);

begin

    SDL_DestroyCond(queue^.cond);

    SDL_DestroyMutex(queue^.mut);

    dispose(queue);

end;

procedure initIPC;

begin

    queueFrontend:= createQueue;

    queueEngine:= createQueue;

    callbackPointerF:= nil;

    callbackListenerThreadF:= nil;

end;

procedure freeIPC;

begin

    //FIXME SDL_KillThread(callbackListenerThreadF);

    destroyQueue(queueFrontend);

    destroyQueue(queueEngine);

end;

end.