DEADSOFTWARE

utils: better `isWadPath()`
[d2df-sdl.git] / src / shared / wadreader.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 {$INCLUDE a_modes.inc}
16 unit wadreader;
18 {$DEFINE SFS_DFWAD_DEBUG}
19 {$DEFINE SFS_MAPDETECT_FX}
21 interface
23 uses
24 Classes,
25 {$IFDEF USE_MEMPOOL}mempool,{$ENDIF}
26 sfs, xstreams, utils;
29 type
30 TWADFile = class{$IFDEF USE_MEMPOOL}(TPoolObject){$ENDIF}
31 private
32 fFileName: AnsiString; // empty: not opened
33 fIter: TSFSFileList;
35 function getIsOpen (): Boolean;
36 function isMapResource (idx: Integer): Boolean;
38 function GetResourceEx (name: AnsiString; wantMap: Boolean; var pData: Pointer; var Len: Integer; logError: Boolean=true): Boolean;
40 public
41 constructor Create ();
42 destructor Destroy (); override;
44 procedure FreeWAD ();
46 function ReadFile (FileName: AnsiString): Boolean;
47 function ReadMemory (Data: Pointer; Len: LongWord): Boolean;
49 function GetResource (name: AnsiString; var pData: Pointer; var Len: Integer; logError: Boolean=true): Boolean;
50 function GetMapResource (name: AnsiString; var pData: Pointer; var Len: Integer; logError: Boolean=true): Boolean;
51 function GetMapResources (): SSArray;
53 // returns `nil` if file wasn't found
54 function openFileStream (name: AnsiString): TStream;
56 property isOpen: Boolean read getIsOpen;
57 end;
60 function g_ExtractWadName (resourceStr: AnsiString): AnsiString;
61 function g_ExtractWadNameNoPath (resourceStr: AnsiString): AnsiString;
62 function g_ExtractFilePath (resourceStr: AnsiString): AnsiString;
63 function g_ExtractFileName (resourceStr: AnsiString): AnsiString; // without path
64 function g_ExtractFilePathName (resourceStr: AnsiString): AnsiString;
67 var
68 wadoptDebug: Boolean = false;
69 wadoptFast: Boolean = false;
72 implementation
74 uses
75 SysUtils, e_log, MAPDEF, xdynrec;
78 function normSlashes (s: AnsiString): AnsiString;
79 var
80 f: Integer;
81 begin
82 for f := 1 to length(s) do if s[f] = '\' then s[f] := '/';
83 result := s;
84 end;
86 function g_ExtractWadNameNoPath (resourceStr: AnsiString): AnsiString;
87 var
88 f, c: Integer;
89 begin
90 for f := length(resourceStr) downto 1 do
91 begin
92 if resourceStr[f] = ':' then
93 begin
94 result := normSlashes(Copy(resourceStr, 1, f-1));
95 c := length(result);
96 while (c > 0) and (result[c] <> '/') do Dec(c);
97 if c > 0 then result := Copy(result, c+1, length(result));
98 exit;
99 end;
100 end;
101 result := '';
102 end;
104 function g_ExtractWadName (resourceStr: AnsiString): AnsiString;
105 var
106 f: Integer;
107 begin
108 for f := length(resourceStr) downto 1 do
109 begin
110 if resourceStr[f] = ':' then
111 begin
112 result := normSlashes(Copy(resourceStr, 1, f-1));
113 exit;
114 end;
115 end;
116 result := '';
117 end;
119 function g_ExtractFilePath (resourceStr: AnsiString): AnsiString;
120 var
121 f, lastSlash: Integer;
122 begin
123 result := '';
124 lastSlash := -1;
125 for f := length(resourceStr) downto 1 do
126 begin
127 if (lastSlash < 0) and (resourceStr[f] = '\') or (resourceStr[f] = '/') then lastSlash := f;
128 if resourceStr[f] = ':' then
129 begin
130 if lastSlash > 0 then
131 begin
132 result := normSlashes(Copy(resourceStr, f, lastSlash-f));
133 while (length(result) > 0) and (result[1] = '/') do Delete(result, 1, 1);
134 end;
135 exit;
136 end;
137 end;
138 if lastSlash > 0 then result := normSlashes(Copy(resourceStr, 1, lastSlash-1));
139 end;
141 function g_ExtractFileName (resourceStr: AnsiString): AnsiString; // without path
142 var
143 f, lastSlash: Integer;
144 begin
145 result := '';
146 lastSlash := -1;
147 for f := length(resourceStr) downto 1 do
148 begin
149 if (lastSlash < 0) and (resourceStr[f] = '\') or (resourceStr[f] = '/') then lastSlash := f;
150 if resourceStr[f] = ':' then
151 begin
152 if lastSlash > 0 then result := Copy(resourceStr, lastSlash+1, length(resourceStr));
153 exit;
154 end;
155 end;
156 if lastSlash > 0 then result := Copy(resourceStr, lastSlash+1, length(resourceStr));
157 end;
159 function g_ExtractFilePathName (resourceStr: AnsiString): AnsiString;
160 var
161 f: Integer;
162 begin
163 result := '';
164 for f := length(resourceStr) downto 1 do
165 begin
166 if resourceStr[f] = ':' then
167 begin
168 result := normSlashes(Copy(resourceStr, f+1, length(resourceStr)));
169 while (length(result) > 0) and (result[1] = '/') do Delete(result, 1, 1);
170 exit;
171 end;
172 end;
173 result := normSlashes(resourceStr);
174 while (length(result) > 0) and (result[1] = '/') do Delete(result, 1, 1);
175 end;
179 { TWADFile }
180 constructor TWADFile.Create();
181 begin
182 fFileName := '';
183 end;
186 destructor TWADFile.Destroy();
187 begin
188 FreeWAD();
189 inherited;
190 end;
193 function TWADFile.getIsOpen (): Boolean;
194 begin
195 result := (fFileName <> '');
196 end;
199 procedure TWADFile.FreeWAD();
200 begin
201 if fIter <> nil then FreeAndNil(fIter);
202 //if fFileName <> '' then e_WriteLog(Format('TWADFile.ReadFile: [%s] closed', [fFileName]), MSG_NOTIFY);
203 fFileName := '';
204 end;
207 //FIXME: detect text maps properly here
208 function TWADFile.isMapResource (idx: Integer): Boolean;
209 var
210 //sign: packed array [0..2] of Char;
211 fs: TStream = nil;
212 begin
213 result := false;
214 if not isOpen or (fIter = nil) then exit;
215 if (idx < 0) or (idx >= fIter.Count) then exit;
216 try
217 fs := fIter.volume.OpenFileByIndex(idx);
218 result := TDynMapDef.canBeMap(fs);
219 (*
220 fs.readBuffer(sign, 3);
221 result := (sign = MAP_SIGNATURE);
222 if not result then result := (sign[0] = 'm') and (sign[1] = 'a') and (sign[2] = 'p');
223 *)
224 except
225 fs.Free();
226 result := false; // just in case
227 exit;
228 end;
229 fs.Free();
230 end;
233 // returns `nil` if file wasn't found
234 function TWADFile.openFileStream (name: AnsiString): TStream;
235 var
236 f: Integer;
237 fi: TSFSFileInfo;
238 begin
239 result := nil;
240 // backwards, due to possible similar names and such
241 for f := fIter.Count-1 downto 0 do
242 begin
243 fi := fIter.Files[f];
244 if fi = nil then continue;
245 if StrEquCI1251(fi.name, name) then
246 begin
247 try
248 result := fIter.volume.OpenFileByIndex(f);
249 except
250 result := nil;
251 end;
252 if (result <> nil) then exit;
253 end;
254 end;
255 end;
258 function removeExt (s: AnsiString): AnsiString;
259 var
260 i: Integer;
261 begin
262 i := length(s)+1;
263 while (i > 1) and (s[i-1] <> '.') and (s[i-1] <> '/') do Dec(i);
264 if (i > 1) and (s[i-1] = '.') then
265 begin
266 //writeln('[', s, '] -> [', Copy(s, 1, i-2), ']');
267 s := Copy(s, 1, i-2);
268 end;
269 result := s;
270 end;
273 function TWADFile.GetResourceEx (name: AnsiString; wantMap: Boolean; var pData: Pointer; var Len: Integer; logError: Boolean=true): Boolean;
274 var
275 f, lastSlash: Integer;
276 fi: TSFSFileInfo;
277 fs: TStream;
278 fpp: Pointer;
279 rpath, rname: AnsiString;
280 //sign: packed array [0..2] of Char;
281 goodMap: Boolean;
282 {$IFNDEF SFS_MAPDETECT_FX}
283 wst: TSFSMemoryChunkStream;
284 {$ENDIF}
285 begin
286 Result := False;
287 if not isOpen or (fIter = nil) then Exit;
288 rname := removeExt(name);
289 if length(rname) = 0 then Exit; // just in case
290 lastSlash := -1;
291 for f := 1 to length(rname) do
292 begin
293 if rname[f] = '\' then rname[f] := '/';
294 if rname[f] = '/' then lastSlash := f;
295 end;
296 if lastSlash > 0 then
297 begin
298 rpath := Copy(rname, 1, lastSlash);
299 Delete(rname, 1, lastSlash);
300 end
301 else
302 begin
303 rpath := '';
304 end;
305 // backwards, due to possible similar names and such
306 for f := fIter.Count-1 downto 0 do
307 begin
308 fi := fIter.Files[f];
309 if fi = nil then continue;
310 if StrEquCI1251(removeExt(fi.name), rname) then
311 begin
312 // i found her (maybe)
313 if not wantMap then
314 begin
315 if length(fi.path) < length(rpath) then continue; // alas
316 if length(fi.path) = length(rpath) then
317 begin
318 if not StrEquCI1251(fi.path, rpath) then continue; // alas
319 end
320 else
321 begin
322 if fi.path[length(fi.path)-length(rpath)] <> '/' then continue; // alas
323 if not StrEquCI1251(Copy(fi.path, length(fi.path)+1-length(rpath), length(fi.path)), rpath) then continue; // alas
324 end;
325 end;
326 try
327 fs := fIter.volume.OpenFileByIndex(f);
328 except
329 fs := nil;
330 end;
331 if fs = nil then
332 begin
333 if wantMap then continue;
334 if logError then e_WriteLog(Format('DFWAD: can''t open file [%s] in [%s]', [name, fFileName]), TMsgType.Warning);
335 break;
336 end;
337 // if we want only maps, check if this is map
338 {$IFDEF SFS_MAPDETECT_FX}
339 if wantMap then
340 begin
341 goodMap := false;
342 {$IF DEFINED(D2D_NEW_MAP_READER_DBG)}
343 e_LogWritefln('DFWAD: checking for good map in wad [%s], file [%s] (#%d)', [fFileName, fi.fname, f]);
344 {$ENDIF}
345 try
346 //fs.readBuffer(sign, 3);
347 //goodMap := (sign = MAP_SIGNATURE);
348 //if not goodMap then goodMap := (sign[0] = 'm') and (sign[1] = 'a') and (sign[2] = 'p');
349 goodMap := TDynMapDef.canBeMap(fs);
350 {$IF DEFINED(D2D_NEW_MAP_READER_DBG)}
351 if goodMap then
352 e_LogWritefln(' GOOD map in wad [%s], file [%s] (#%d)', [fFileName, fi.fname, f])
353 else
354 e_LogWritefln(' BAD map in wad [%s], file [%s] (#%d)', [fFileName, fi.fname, f]);
355 {$ENDIF}
356 except
357 end;
358 if not goodMap then
359 begin
360 {$IF DEFINED(D2D_NEW_MAP_READER_DBG)}
361 e_LogWritefln(' not a map in wad [%s], file [%s] (#%d)', [fFileName, fi.fname, f]);
362 {$ENDIF}
363 fs.Free();
364 continue;
365 end;
366 fs.position := 0;
367 end;
368 {$ENDIF}
369 Len := Integer(fs.size);
370 GetMem(pData, Len);
371 fpp := pData;
372 try
373 fs.ReadBuffer(pData^, Len);
374 fpp := nil;
375 finally
376 if fpp <> nil then
377 begin
378 FreeMem(fpp);
379 pData := nil;
380 Len := 0;
381 end;
382 fs.Free;
383 end;
384 {$IFNDEF SFS_MAPDETECT_FX}
385 if wantMap then
386 begin
387 goodMap := false;
388 if Len >= 3 then
389 begin
390 //Move(pData^, sign, 3);
391 //goodMap := (sign = MAP_SIGNATURE);
392 wst := TSFSMemoryChunkStream.Create(pData, Len);
393 try
394 goodMap := TDynMapDef.canBeMap(wst);
395 except
396 goodMap := false;
397 end;
398 wst.Free();
399 end;
400 if not goodMap then
401 begin
402 //e_WriteLog(Format(' not a map in wad [%s], file [%s] (#%d)', [fFileName, fi.fname, f]), MSG_NOTIFY);
403 FreeMem(pData);
404 pData := nil;
405 Len := 0;
406 continue;
407 end;
408 end;
409 {$ENDIF}
410 result := true;
411 {$IFDEF SFS_DFWAD_DEBUG}
412 if wadoptDebug then
413 e_WriteLog(Format('DFWAD: file [%s] FOUND in [%s]; size is %d bytes', [name, fFileName, Len]), TMsgType.Notify);
414 {$ENDIF}
415 exit;
416 end;
417 end;
418 if logError then e_WriteLog(Format('DFWAD: file [%s] not found in [%s]', [name, fFileName]), TMsgType.Warning);
419 end;
421 function TWADFile.GetResource (name: AnsiString; var pData: Pointer; var Len: Integer; logError: Boolean=true): Boolean;
422 begin
423 result := GetResourceEx(name, false, pData, Len, logError);
424 end;
426 function TWADFile.GetMapResource (name: AnsiString; var pData: Pointer; var Len: Integer; logError: Boolean=true): Boolean;
427 begin
428 result := GetResourceEx(name, true, pData, Len, logError);
429 end;
431 function TWADFile.GetMapResources (): SSArray;
432 var
433 f, c: Integer;
434 fi: TSFSFileInfo;
435 s: AnsiString;
436 begin
437 Result := nil;
438 if not isOpen or (fIter = nil) then Exit;
439 for f := fIter.Count-1 downto 0 do
440 begin
441 fi := fIter.Files[f];
442 if fi = nil then continue;
443 if length(fi.name) = 0 then continue;
444 {$IF DEFINED(D2D_NEW_MAP_READER)}
445 //e_LogWritefln('DFWAD: checking for map in wad [%s], file [%s] (#%d)', [fFileName, fi.fname, f]);
446 {$ENDIF}
447 if isMapResource(f) then
448 begin
449 s := removeExt(fi.name);
450 c := High(result);
451 while c >= 0 do
452 begin
453 if StrEquCI1251(result[c], s) then break;
454 Dec(c);
455 end;
456 if c < 0 then
457 begin
458 SetLength(result, Length(result)+1);
459 result[high(result)] := removeExt(fi.name);
460 end;
461 end;
462 end;
463 end;
466 function TWADFile.ReadFile (FileName: AnsiString): Boolean;
467 var
468 rfn: AnsiString;
469 //f: Integer;
470 //fi: TSFSFileInfo;
471 begin
472 Result := False;
473 //e_WriteLog(Format('TWADFile.ReadFile: [%s]', [FileName]), MSG_NOTIFY);
474 FreeWAD();
475 rfn := findDiskWad(FileName);
476 if length(rfn) = 0 then
477 begin
478 e_WriteLog(Format('TWADFile.ReadFile: error looking for [%s]', [FileName]), TMsgType.Notify);
479 exit;
480 end;
481 {$IFDEF SFS_DFWAD_DEBUG}
482 if wadoptDebug then e_WriteLog(Format('TWADFile.ReadFile: FOUND [%s]', [rfn]), TMsgType.Notify);
483 {$ENDIF}
484 // cache this wad
485 try
486 if wadoptFast then
487 begin
488 if not SFSAddDataFile(rfn, true) then exit;
489 end
490 else
491 begin
492 if not SFSAddDataFileTemp(rfn, true) then exit;
493 end;
494 except
495 exit;
496 end;
497 fIter := SFSFileList(rfn);
498 if fIter = nil then Exit;
499 fFileName := rfn;
500 {$IFDEF SFS_DFWAD_DEBUG}
501 if wadoptDebug then e_WriteLog(Format('TWADFile.ReadFile: [%s] opened', [fFileName]), TMsgType.Notify);
502 {$ENDIF}
503 Result := True;
504 end;
507 var
508 uniqueCounter: Integer = 0;
510 function TWADFile.ReadMemory (Data: Pointer; Len: LongWord): Boolean;
511 var
512 fn: AnsiString;
513 st: TStream = nil;
514 //f: Integer;
515 //fi: TSFSFileInfo;
516 begin
517 Result := False;
518 FreeWAD();
519 if (Data = nil) or (Len = 0) then
520 begin
521 e_WriteLog('TWADFile.ReadMemory: EMPTY SUBWAD!', TMsgType.Warning);
522 Exit;
523 end;
525 fn := Format(' -- memwad %d -- ', [uniqueCounter]);
526 Inc(uniqueCounter);
527 {$IFDEF SFS_DFWAD_DEBUG}
528 if wadoptDebug then e_WriteLog(Format('TWADFile.ReadMemory: [%s]', [fn]), TMsgType.Notify);
529 {$ENDIF}
531 try
532 st := TSFSMemoryStreamRO.Create(Data, Len);
533 if not SFSAddSubDataFile(fn, st, true) then
534 begin
535 st.Free;
536 Exit;
537 end;
538 except
539 st.Free;
540 Exit;
541 end;
543 fIter := SFSFileList(fn);
544 if fIter = nil then Exit;
546 fFileName := fn;
547 {$IFDEF SFS_DFWAD_DEBUG}
548 if wadoptDebug then e_WriteLog(Format('TWADFile.ReadMemory: [%s] opened', [fFileName]), TMsgType.Notify);
549 {$ENDIF}
552 for f := 0 to fIter.Count-1 do
553 begin
554 fi := fIter.Files[f];
555 if fi = nil then continue;
556 st := fIter.volume.OpenFileByIndex(f);
557 if st = nil then
558 begin
559 e_WriteLog(Format('[%s]: [%s : %s] CAN''T OPEN', [fFileName, fi.path, fi.name]), MSG_NOTIFY);
560 end
561 else
562 begin
563 e_WriteLog(Format('[%s]: [%s : %s] %u', [fFileName, fi.path, fi.name, st.size]), MSG_NOTIFY);
564 st.Free;
565 end;
566 end;
567 //fIter.volume.OpenFileByIndex(0);
570 Result := True;
571 end;
574 begin
575 sfsDiskDirs := '<exedir>/data'; //FIXME
576 end.