DEADSOFTWARE

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