hedgewars/uPhysFSLayer.pas
author Wuzzy <Wuzzy2@mail.ru>
Thu, 25 Apr 2019 23:01:05 +0200
changeset 14844 e239378a9400
parent 14204 3c36a4e66c82
child 14865 259840ca77e3
permissions -rw-r--r--
Prevent entering “/”, “\” and “:” in team and scheme names. The name of teams and schems is saved in the file name itself, so these characters would cause trouble as they are used in path names in Linux and Windows.

{$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);
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;

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.