hedgewars/uPhysFSLayer.pas
author Wuzzy <Wuzzy2@mail.ru>
Mon, 16 Sep 2019 17:33:49 +0200
changeset 15410 8504fee3b601
parent 14946 23fc5022bdea
permissions -rw-r--r--
Racer: Fix weird water splashes after waypoint placement Does not affect official racer, as only waypoint placement is touched. The reason was that the air attack gear sometimes was not deleted fast enough so it might occassionally drop some air bombs (these are deleted now). Also, the airplane position was set to water level, which caused another water splash.

{$INCLUDE "options.inc"}

unit uPhysFSLayer;

interface
uses SDLh, LuaPas;

const PhysfsLibName =
{$IFDEF PHYSFS_INTERNAL}
    'libhwphysfs'
{$ELSE}
    {$IFDEF WIN32_VCPKG}'physfs'{$ELSE}'libphysfs'{$ENDIF};
{$ENDIF}
const PhyslayerLibName =
    {$IFDEF WIN32_VCPKG}'physlayer'{$ELSE}'libphyslayer'{$ENDIF};

{$IFNDEF WINDOWS}
    {$linklib physfs}
    {$linklib physlayer}
{$ENDIF}

procedure initModule(localPrefix, userPrefix: PChar);
procedure freeModule;

type PFSFile = pointer;

function rwopsOpenRead(fname: shortstring): PSDL_RWops;
function rwopsOpenWrite(fname: shortstring): PSDL_RWops;

function pfsOpenRead(fname: shortstring): PFSFile;
function pfsOpenWrite(fname: shortstring): PFSFile;
function pfsFlush(f: PFSFile): boolean;
function pfsClose(f: PFSFile): boolean;

procedure pfsReadLn(f: PFSFile; var s: shortstring);
procedure pfsReadLnA(f: PFSFile; var s: ansistring);
procedure pfsWriteLn(f: PFSFile; s: shortstring);
procedure pfsWriteRaw(f: PFSFile; s: PChar; len: QWord);
function pfsBlockRead(f: PFSFile; buf: pointer; size: Int64): Int64;
function pfsEOF(f: PFSFile): boolean;

function pfsExists(fname: shortstring): boolean;
function pfsMakeDir(path: shortstring): boolean;

function  physfsReader(L: Plua_State; f: PFSFile; sz: Psize_t) : PChar; cdecl; external PhyslayerLibName;
procedure physfsReaderSetBuffer(buf: pointer); cdecl; external PhyslayerLibName;
procedure hedgewarsMountPackage(filename: PChar); cdecl; external PhyslayerLibName;

implementation
uses uConsts, uUtils, uVariables{$IFNDEF PAS2C}{$IFDEF HWLIBRARY}, SysUtils{$ENDIF}{$ELSE}, physfs{$ENDIF};

function PHYSFSRWOPS_openRead(fname: PChar): PSDL_RWops; cdecl; external PhyslayerLibName;
function PHYSFSRWOPS_openWrite(fname: PChar): PSDL_RWops; cdecl; external PhyslayerLibName;
procedure hedgewarsMountPackages(); cdecl; external PhyslayerLibName;
{$IFNDEF PAS2C}
function PHYSFS_init(argv0: PChar): LongInt; cdecl; external PhysfsLibName;
function PHYSFS_deinit(): LongInt; cdecl; external PhysfsLibName;
function PHYSFS_mount(newDir, mountPoint: PChar; appendToPath: LongBool) : LongBool; cdecl; external PhysfsLibName;
function PHYSFS_openRead(fname: PChar): PFSFile; cdecl; external PhysfsLibName;
function PHYSFS_openWrite(fname: PChar): PFSFile; cdecl; external PhysfsLibName;
function PHYSFS_setWriteDir(path: PChar): LongBool; cdecl; external PhysfsLibName;
function PHYSFS_eof(f: PFSFile): LongBool; cdecl; external PhysfsLibName;
function PHYSFS_readBytes(f: PFSFile; buffer: pointer; len: Int64): Int64; cdecl; external PhysfsLibName;
function PHYSFS_writeBytes(f: PFSFile; buffer: pointer; len: Int64): Int64; cdecl; external PhysfsLibName;
function PHYSFS_seek(f: PFSFile; pos: QWord): LongBool; cdecl; external PhysfsLibName;
function PHYSFS_flush(f: PFSFile): LongBool; cdecl; external PhysfsLibName;
function PHYSFS_close(f: PFSFile): LongBool; cdecl; external PhysfsLibName;
function PHYSFS_setBuffer(f: PFSFile; pos: QWord): LongBool; cdecl; external PhysfsLibName;
function PHYSFS_exists(fname: PChar): LongBool; cdecl; external PhysfsLibName;
function PHYSFS_mkdir(path: PChar): LongBool; cdecl; external PhysfsLibName;
function PHYSFS_getLastError(): PChar; cdecl; external PhysfsLibName;
function PHYSFS_enumerateFiles(dir: PChar): PPChar; cdecl; external PhysfsLibName;
procedure PHYSFS_freeList(list: PPChar); cdecl; external PhysfsLibName;
{$ELSE}
function PHYSFS_readBytes(f: PFSFile; buffer: pointer; len: Int64): Int64;
begin
    PHYSFS_readBytes:= PHYSFS_read(f, buffer, 1, len);
end;
{$ENDIF}

function rwopsOpenRead(fname: shortstring): PSDL_RWops;
begin
    exit(PHYSFSRWOPS_openRead(Str2PChar(fname)));
end;

function rwopsOpenWrite(fname: shortstring): PSDL_RWops;
begin
    exit(PHYSFSRWOPS_openWrite(Str2PChar(fname)));
end;

function pfsOpenRead(fname: shortstring): PFSFile;
var f: PFSFile;
begin
    f:= PHYSFS_openRead(Str2PChar(fname));
    if f <> nil then
        PHYSFS_setBuffer(f, 4096);
    exit(f);
end;

function pfsOpenWrite(fname: shortstring): PFSFile;
begin
    exit(PHYSFS_openWrite(Str2PChar(fname)));
end;

function pfsEOF(f: PFSFile): boolean;
begin
    exit(PHYSFS_eof(f))
end;

function pfsFlush(f: PFSFile): boolean;
begin
    exit(PHYSFS_flush(f))
end;

function pfsClose(f: PFSFile): boolean;
begin
    exit(PHYSFS_close(f))
end;

function pfsExists(fname: shortstring): boolean;
begin
    exit(PHYSFS_exists(Str2PChar(fname)))
end;

function pfsMakeDir(path: shortstring): boolean;
begin
    exit(PHYSFS_mkdir(Str2PChar(path)))
end;

function pfsEnumerateFiles(dir: shortstring): PPChar;
begin
    exit(PHYSFS_enumerateFiles(Str2PChar(dir)))
end;

procedure pfsFreeList(list: PPChar);
begin
    PHYSFS_freeList(list)
end;

procedure pfsReadLn(f: PFSFile; var s: shortstring);
var c: char;
begin
s[0]:= #0;

while (PHYSFS_readBytes(f, @c, 1) = 1) and (c <> #10) do
    if (c <> #13) and (s[0] < #255) then
        begin
        inc(s[0]);
        s[byte(s[0])]:= c
        end
end;

procedure pfsReadLnA(f: PFSFile; var s: ansistring);
var c: char;
    b: shortstring;
begin
s:= '';
b[0]:= #0;

while (PHYSFS_readBytes(f, @c, 1) = 1) and (c <> #10) do
    if (c <> #13) then
        begin
        inc(b[0]);
        b[byte(b[0])]:= c;
        if b[0] = #255 then
            begin
            s:= s + ansistring(b);
            b[0]:= #0
            end
        end;

s:= s + ansistring(b)
end;

procedure pfsWriteLn(f: PFSFile; s: shortstring);
var c: char;
begin
    c:= #10;
    PHYSFS_writeBytes(f, @s[1], byte(s[0]));
    PHYSFS_writeBytes(f, @c, 1);
end;

procedure pfsWriteRaw(f: PFSFile; s: PChar; len: QWord);
begin
    PHYSFS_writeBytes(f, s, len);
end;

function pfsBlockRead(f: PFSFile; buf: pointer; size: Int64): Int64;
var r: Int64;
begin
    r:= PHYSFS_readBytes(f, buf, size);

    if r <= 0 then
        pfsBlockRead:= 0
    else
        pfsBlockRead:= r
end;

procedure pfsMount(path: PChar; mountpoint: PChar);
begin
    PHYSFS_mount(path, mountpoint, false)
end;

procedure pfsMountAtRoot(path: PChar);
begin
    pfsMount(path, PChar(_S'/'));
end;

procedure initModule(localPrefix, userPrefix: PChar);
var i: LongInt;
    cPhysfsId: shortstring;
{$IFNDEF MOBILE}
    fp: PChar;
{$ENDIF}
begin
{$IFDEF HWLIBRARY}
    //TODO: https://icculus.org/pipermail/physfs/2011-August/001006.html
    cPhysfsId:= shortstring(GetCurrentDir()) + {$IFDEF DARWIN}{$IFNDEF IPHONEOS}'/Hedgewars.app/Contents/MacOS/' + {$ENDIF}{$ENDIF} ' hedgewars';
{$ELSE}
    cPhysfsId:= ParamStr(0);
{$ENDIF}

    i:= PHYSFS_init(Str2PChar(cPhysfsId));
    //AddFileLog('[PhysFS] init: ' + inttostr(i));

{$IFNDEF MOBILE}
    // mount system fonts paths first
    for i:= low(cFontsPaths) to high(cFontsPaths) do
        begin
            fp := cFontsPaths[i];
            if fp <> nil then
                pfsMount(fp, _P'/Fonts');
        end;
{$ENDIF}

    pfsMountAtRoot(localPrefix);
    pfsMount(userPrefix, PChar('/Config'));
    pfsMakeDir('/Config/Data');
    pfsMakeDir('/Config/Logs');
    pfsMountAtRoot(Str2PChar(shortstring(userPrefix) + '/Data'));
    PHYSFS_setWriteDir(userPrefix);

    hedgewarsMountPackages;

    // need access to teams and frontend configs (for bindings)
    pfsMountAtRoot(userPrefix);

    if cTestLua then
        begin
            pfsMountAtRoot(Str2PChar(ExtractFileDir(cScriptName)));
            cScriptName := ExtractFileName(cScriptName);
        end;
end;

procedure freeModule;
begin
    PHYSFS_deinit;
end;

end.