X-Git-Url: http://deadsoftware.ru/gitweb?a=blobdiff_plain;f=src%2Fengine%2Fe_res.pas;h=e48cc32ed5746264150eb419cbf14ee36db99135;hb=cf154570c3e691c4b95c021376c810020d689167;hp=db328791be0a74d3cf40e5915a16a5165b0058db;hpb=414f2873efa0cce84499f64774db7000e6268971;p=d2df-sdl.git diff --git a/src/engine/e_res.pas b/src/engine/e_res.pas index db32879..e48cc32 100644 --- a/src/engine/e_res.pas +++ b/src/engine/e_res.pas @@ -48,22 +48,34 @@ interface function e_FindResource (dirs: SSArray; var name: AnsiString; nameIsDir: Boolean = false): Boolean; function e_FindWad (dirs: SSArray; name: AnsiString): AnsiString; - {--- append dirs to 'path.wad:\file'. if disk is void, append defWad ---} + {--- returns relative wad name; never empty string ---} + function e_FindWadRel (dirs: SSArray; name: AnsiString): AnsiString; + + {--- prepend dirs to 'disk.wad:\file'. if empty disk string then prepend defWad ---} + {--- return empty string if error occured or 'path/to/disk.wad:\file' on success ---} function e_GetResourcePath (dirs: SSArray; path: AnsiString; defWad: AnsiString): AnsiString; {--- same as SysUtils.FinFirst ---} - function e_FindFirst (dirs: SSArray; name: AnsiString; attr: LongInt; out Rslt: TRawbyteSearchRec): LongInt; + function e_FindFirst (dirs: SSArray; name: AnsiString; attr: LongInt; out Rslt: TSearchRec): LongInt; + + {--- try to get a writeable directory from list, throws if no one directory created ---} + {--- (unless `required` is `false`: in this case, returns empty string) ---} + {--- creates all necessary subdirs, if it can ---} + function e_GetWriteableDir (dirs: SSArray; required: Boolean=true): AnsiString; - {--- try to create directory from list, throws if no one directory created ---} - function e_GetDir (dirs: SSArray): AnsiString; + function e_CanCreateFilesAt (dir: AnsiString): Boolean; implementation - uses WadReader, e_log; + uses WadReader, e_log, hashtable; type SpawnProc = function (pathname: AnsiString): Tstream; + var + writeableDirs: THashStrCIStr = nil; + + function e_UpperDir (path: AnsiString): AnsiString; var i: Integer; begin @@ -209,24 +221,49 @@ implementation end end; + function e_FindWadRel (dirs: SSArray; name: AnsiString): AnsiString; + var + s: AnsiString; + maxpfx: AnsiString = ''; + pfx: AnsiString; + begin + result := name; + if not findFileCI(name) then exit; + for s in dirs do + begin + if (length(s) = 0) then continue; + if (length(name) <= length(s)) then continue; + if (length(s) < length(maxpfx)) then continue; + pfx := s; + if not findFileCI(pfx, true) then continue; + if (pfx[length(pfx)] <> '/') and (pfx[length(pfx)] <> '\') then pfx := pfx+'/'; + if (length(pfx)+1 > length(name)) then continue; + if (strEquCI1251(copy(name, 1, length(pfx)), pfx)) then maxpfx := pfx; + end; + if (length(maxpfx) > 0) then + begin + result := name; + Delete(result, 1, length(maxpfx)); + end; + end; + function e_GetResourcePath (dirs: SSArray; path: AnsiString; defWad: AnsiString): AnsiString; var diskName, fileName: AnsiString; begin if debug_e_res then - e_LogWritefln('e_GetResourcePath0 %s (%s)', [path, defWad]); - assert(dirs <> nil); + e_LogWritefln('e_GetResourcePath %s (%s)', [path, defWad]); + assert(length(dirs) > 0); assert(path <> ''); assert(defWad <> ''); diskName := g_ExtractWadName(path); fileName := g_ExtractFilePathName(path); if diskName = '' then diskName := defWad else diskName := e_FindWad(dirs, diskName); - assert(diskName <> '', 'oh fuck, wad "' + diskName + '" not founded'); - result := diskName + ':\' + fileName; + if diskName = '' then result := '' else result := diskName + ':\' + fileName; if debug_e_res then e_LogWritefln(' this>>> %s', [result]); end; - function e_FindFirst (dirs: SSArray; name: AnsiString; attr: LongInt; out Rslt: TRawbyteSearchRec): LongInt; + function e_FindFirst (dirs: SSArray; name: AnsiString; attr: LongInt; out Rslt: TSearchRec): LongInt; var i: Integer; dir: AnsiString; begin if debug_e_res then @@ -240,20 +277,82 @@ implementation result := FindFirst(dir, attr, Rslt); if debug_e_res then e_LogWritefln(' %s: %s -- %s', [i, dir, result]); - Dec(i); + Dec(i); end end; - function e_GetDir (dirs: SSArray): AnsiString; - var i: Integer; + // k8: sorry. i know that this sux, but checking directory access rights is unreliable (unportable). + function e_CanCreateFilesAt (dir: AnsiString): Boolean; + var + f: Integer; + st: TStream = nil; + sr: TSearchRec; + fn: AnsiString; + begin + result := false; + for f := 0 to $7fffffff do + begin + fn := Format('%s/$$$temptest$$$_%d.$$$%d$$$', [dir, f, f]); + if (FindFirst(fn, faAnyFile, sr) = 0) then + begin + FindClose(sr); + continue; + end; + FindClose(sr); + try + st := TFileStream.Create(fn, fmCreate); + except // sorry + st := nil; // just in case + end; + if assigned(st) then + begin + st.Free(); + try DeleteFile(fn); except end; + result := true; + end; + exit; + end; + end; + + function e_GetWriteableDir (dirs: SSArray; required: Boolean=true): AnsiString; + var + f: Integer; begin + assert(length(dirs) > 0); + result := ''; + if assigned(writeableDirs) then + begin + for f := High(dirs) downto Low(dirs) do + begin + if (writeableDirs.get(dirs[f], result)) then + begin + //writeln('*** KNOWN WRITEABLE DIR: "', result, '"'); + exit; + end; + end; + end; + for f := High(dirs) downto Low(dirs) do + begin + try + if ForceDirectories(dirs[f]) then + begin + result := dirs[f]; + if (findFileCI(result, true)) then + begin + if e_CanCreateFilesAt(result) then + begin + if not assigned(writeableDirs) then writeableDirs := THashStrCIStr.Create(); + writeableDirs.put(dirs[f], result); + //writeln('*** NEW WRITEABLE DIR: "', result, '" ("', dirs[f], '"); rq=', required); + exit; + end; + end; + end; + except // sorry + end; + end; + if required then raise Exception.Create(Format('unable to create directory "%s"', [dirs[High(dirs)]])); result := ''; - i := High(dirs); - while (i >= 0) and (ForceDirectories(dirs[i]) = false) do Dec(i); - if i >= 0 then - result := dirs[i] - else - raise Exception.Create('unable to create directory') end; end.