author | sheepluva |
Tue, 22 Jun 2021 22:13:55 +0200 | |
changeset 15824 | d5c37e78ab83 |
parent 14967 | 23fc5022bdea |
permissions | -rw-r--r-- |
{$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.