src/engine/e_res.pas

   1 (* Copyright (C)  Doom 2D: Forever Developers
   2  *
   3  * This program is free software: you can redistribute it and/or modify
   4  * it under the terms of the GNU General Public License as published by
   5  * the Free Software Foundation, version 3 of the License ONLY.
   6  *
   7  * This program is distributed in the hope that it will be useful,
   8  * but WITHOUT ANY WARRANTY; without even the implied warranty of
   9  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  10  * GNU General Public License for more details.
  11  *
  12  * You should have received a copy of the GNU General Public License
  13  * along with this program.  If not, see <http://www.gnu.org/licenses/>.
  14  *)
  15 {$I ../shared/a_modes.inc}
  16 unit e_res;
  17
  18 interface
  19
  20   uses SysUtils, Utils, Classes;
  21
  22   var
  23     debug_e_res: Boolean;
  24
  25   {-------------------------------------------}
  26   {--- insert separator beetwin a and b    ---}
  27   {--- result are correct if (a or b) = '' ---}
  28   {--- - - - - - - - - - - - - - - - - - - ---}
  29   function e_CatPath (a, b: AnsiString): AnsiString;
  30
  31   {--- remove last entry from path ---}
  32   function e_UpperDir (path: AnsiString): AnsiString;
  33
  34   {--- not absolute and have no relative dirs ---}
  35   function e_IsValidResourceName (name: AnsiString): Boolean;
  36
  37   {-----------------------------------------------------------------------}
  38   {--- try to open/create file in one dir from `dirs` in reverse order ---}
  39   {--- e_OpenResourceRW tries to create if not exists                  ---}
  40   {--- create dirs if not exists                                       ---}
  41   {--- result <> nil, throws exceptions on errors                      ---}
  42   {--- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ---}
  43   function e_CreateResource (dirs: SSArray; name: AnsiString): TStream;
  44   function e_OpenResourceRO (dirs: SSArray; name: AnsiString): TStream;
  45   function e_OpenResourceRW (dirs: SSArray; name: AnsiString): TStream;
  46
  47   {--- same as shared/utils ---}
  48   function e_FindResource (dirs: SSArray; var name: AnsiString; nameIsDir: Boolean = false): Boolean;
  49   function e_FindWad (dirs: SSArray; name: AnsiString): AnsiString;
  50
  51   {--- append dirs to 'path.wad:\file'. if disk is void, append defWad ---}
  52   function e_GetResourcePath (dirs: SSArray; path: AnsiString; defWad: AnsiString): AnsiString;
  53
  54   {--- same as SysUtils.FinFirst ---}
  55   function e_FindFirst (dirs: SSArray; name: AnsiString; attr: LongInt; out Rslt: TSearchRec): LongInt;
  56
  57   {--- try to create directory from list, throws if no one directory created ---}
  58   function e_GetDir (dirs: SSArray): AnsiString;
  59
  60 implementation
  61
  62   uses WadReader, e_log;
  63
  64   type
  65     SpawnProc = function (pathname: AnsiString): Tstream;
  66
  67   function e_UpperDir (path: AnsiString): AnsiString;
  68     var i: Integer;
  69   begin
  70     i := High(path);
  71     while (i >= 1) and (path[i] <> '/') and (path[i] <> '\') do Dec(i);
  72     result := Copy(path, 1, i)
  73   end;
  74
  75   function HasRelativeDirs (name: AnsiString): Boolean;
  76     var i: Integer; ch: Char;
  77   begin
  78     i := 1;
  79     result := false;
  80     while (result = false) and (name[i] <> #0) do
  81     begin
  82       ch := name[i];
  83       if (ch = '/') or (ch = '\') then
  84       begin
  85         Inc(i);
  86         if name[i] = '.' then
  87         begin
  88           Inc(i);
  89           if name[i] = '.' then
  90           begin
  91             Inc(i);
  92             ch := name[i];
  93             result := (ch = #0) or (ch = '/') or (ch = '\')
  94           end
  95         end
  96       end
  97       else
  98       begin
  99         Inc(i)
 100       end
 101     end
 102   end;
 103
 104   function HasAbsoluteDirs (name: AnsiString): Boolean;
 105   begin
 106     result := (name = '') or (name[1] = '/') or (name[1] = '\')
 107   end;
 108
 109   function e_IsValidResourceName (name: AnsiString): Boolean;
 110   begin
 111     result := (HasAbsoluteDirs(name) = false) and (HasRelativeDirs(name) = false)
 112   end;
 113
 114   function SpawnStream (dirs: SSArray; name: AnsiString; p: SpawnProc; createNewDir: Boolean): TStream;
 115     var i: Integer;
 116   begin
 117     result := nil;
 118     assert(dirs <> nil);
 119     assert(e_IsValidResourceName(name));
 120     i := High(dirs);
 121     while (i >= 0) and (result = nil) do
 122     begin
 123       try
 124         if debug_e_res then
 125           e_LogWritefln('  %s', [dirs[i]]);
 126         if (createNewDir = false) or (ForceDirectories(dirs[i]) = true) then
 127           result := p(e_CatPath(dirs[i], name))
 128       finally
 129         Dec(i)
 130       end
 131     end
 132   end;
 133
 134   function e_CreateResource (dirs: SSArray; name: AnsiString): TStream;
 135   begin
 136     if debug_e_res then
 137       e_LogWritefln('e_CreateResource %s', [name]);
 138     result := SpawnStream(dirs, name, @createDiskFile, true);
 139     if result = nil then
 140       raise Exception.Create('can''t create resource "' + name + '"');
 141   end;
 142
 143   function e_OpenResourceRO (dirs: SSArray; name: AnsiString): TStream;
 144   begin
 145     if debug_e_res then
 146       e_LogWritefln('e_OpenResourceRO %s', [name]);
 147     result := SpawnStream(dirs, name, @openDiskFileRO, false);
 148     if result = nil then
 149       raise EFileNotFoundException.Create('can''t open resource "' + name + '"')
 150   end;
 151
 152   function e_OpenResourceRW (dirs: SSArray; name: AnsiString): TStream;
 153   begin
 154     if debug_e_res then
 155       e_LogWritefln('e_OpenResourceRW %s', [name]);
 156     result := SpawnStream(dirs, name, @openDiskFileRW, true);
 157     if result = nil then
 158       raise Exception.Create('can''t create resource "' + name + '"')
 159   end;
 160
 161   function e_CatPath (a, b: AnsiString): AnsiString;
 162   begin
 163     if a = '' then
 164       result := b
 165     else if b = '' then
 166       result := a
 167     else
 168       result := a + '/' + b
 169   end;
 170
 171   function e_FindResource (dirs: SSArray; var name: AnsiString; nameIsDir: Boolean = false): Boolean;
 172     var i: Integer; dir: AnsiString;
 173   begin
 174     if debug_e_res then
 175       e_LogWritefln('e_FindResource %s (%s)', [name, nameIsDir]);
 176     result := false;
 177     assert(dirs <> nil);
 178     assert(e_IsValidResourceName(name));
 179     i := High(dirs); dir := name;
 180     while (i >= 0) and (result = false) do
 181     begin
 182       dir := e_CatPath(dirs[i], name);
 183       result := findFileCI(dir, nameIsDir);
 184       if debug_e_res then
 185         e_LogWritefln('  %s -> %s', [dir, result]);
 186       Dec(i)
 187     end;
 188     if result = true then
 189       name := dir;
 190     if debug_e_res then
 191       e_LogWritefln('  result = %s (%s)', [name, result]);
 192   end;
 193
 194   function e_FindWad (dirs: SSArray; name: AnsiString): AnsiString;
 195     var i: Integer;
 196   begin
 197     if debug_e_res then
 198       e_LogWritefln('e_FindWad "%s"', [name]);
 199     result := '';
 200     assert(dirs <> nil);
 201     assert(e_IsValidResourceName(name));
 202     i := High(dirs);
 203     while (i >= 0) and (result = '') do
 204     begin
 205       result := findDiskWad(dirs[i] + DirectorySeparator + name);
 206       if debug_e_res then
 207         e_LogWritefln('  %s -> %s', [dirs[i] + DirectorySeparator + name, result]);
 208       Dec(i)
 209     end
 210   end;
 211
 212   function e_GetResourcePath (dirs: SSArray; path: AnsiString; defWad: AnsiString): AnsiString;
 213     var diskName, fileName: AnsiString;
 214   begin
 215     if debug_e_res then
 216       e_LogWritefln('e_GetResourcePath0 %s (%s)', [path, defWad]);
 217     assert(dirs <> nil);
 218     assert(path <> '');
 219     assert(defWad <> '');
 220     diskName := g_ExtractWadName(path);
 221     fileName := g_ExtractFilePathName(path);
 222     if diskName = '' then diskName := defWad else diskName := e_FindWad(dirs, diskName);
 223     assert(diskName <> '', 'oh fuck, wad "' + diskName + '" not founded');
 224     result := diskName + ':\' + fileName;
 225     if debug_e_res then
 226       e_LogWritefln('  this>>> %s', [result]);
 227   end;
 228
 229   function e_FindFirst (dirs: SSArray; name: AnsiString; attr: LongInt; out Rslt: TSearchRec): LongInt;
 230     var i: Integer; dir: AnsiString;
 231   begin
 232     if debug_e_res then
 233       e_LogWritefln('e_FindFirst %s', [name]);
 234     assert(dirs <> nil);
 235     assert(e_IsValidResourceName(name));
 236     i := High(dirs); result := -1;
 237     while (i >= 0) and (result <> 0) do
 238     begin
 239       dir := dirs[i] + DirectorySeparator + name;
 240       result := FindFirst(dir, attr, Rslt);
 241       if debug_e_res then
 242         e_LogWritefln('  %s: %s -- %s', [i, dir, result]);
 243       Dec(i);
 244     end
 245   end;
 246
 247   function e_GetDir (dirs: SSArray): AnsiString;
 248     var i: Integer;
 249   begin
 250     result := '';
 251     i := High(dirs);
 252     while (i >= 0) and (ForceDirectories(dirs[i]) = false) do Dec(i);
 253     if i >= 0 then
 254       result := dirs[i]
 255     else
 256       raise Exception.Create('unable to create directory')
 257   end;
 258
 259 end.