1 {$MODE OBJFPC}
2 {$IFDEF WINDOWS}
3 {$APPTYPE CONSOLE}
4 {$ENDIF}
5 {$DEFINE UTFEXTRA}
6 {.$DEFINE ONELINELOG}
8 {$IFDEF WINDOWS}
9 {$UNDEF ONELINELOG}
10 {$ENDIF}
11 program __wadcvt__;
13 uses
14 SysUtils,
15 Classes,
16 utils in '../shared/utils.pas',
17 xstreams in '../shared/xstreams.pas',
18 crc,
19 sfs,
20 sfsPlainFS,
21 sfsZipFS,
22 paszlib,
23 wadreader in '../shared/wadreader.pas',
24 conbuf in '../shared/conbuf.pas',
25 BinEditor in '../shared/BinEditor.pas',
26 MAPSTRUCT in '../shared/MAPSTRUCT.pas',
27 MAPDEF in '../shared/MAPDEF.pas',
28 CONFIG in '../shared/CONFIG.pas',
29 e_log in '../engine/e_log.pas',
30 ImagingTypes, Imaging, ImagingUtility;
33 {.$WARNINGS ON}
34 {.$NOTES ON}
35 {.$HINTS ON}
37 var
38 optConvertATX: Boolean = false;
39 optConvertTGA: Boolean = false;
40 optLoCaseNames: Boolean = false;
43 function convertAnimTexture (wadSt: TStream; wadName: AnsiString): TMemoryStream;
44 var
45 WAD: TWADFile = nil;
46 TextureWAD: PChar = nil;
47 TextData: Pointer = nil;
48 TextureData: Pointer = nil;
49 cfg: TConfig = nil;
50 ResLength: Integer;
51 TextureResource: String;
52 _width, _height, _framecount, _speed: Integer;
53 _backanimation: Boolean;
54 ia: TDynImageDataArray = nil;
55 f: Integer;
56 img: TImageData;
57 x, y, ofsx, ofsy, nx, ny: Integer;
58 clr: TColor32Rec;
59 sto: TMemoryStream = nil;
60 buf: PChar;
61 buflen: Integer;
62 begin
63 result := nil;
65 wadSt.position := 0;
66 buflen := Integer(wadSt.size);
67 GetMem(buf, buflen);
68 try
69 wadSt.ReadBuffer(buf^, buflen);
71 WAD := TWADFile.Create();
72 //WAD.ReadFile(wadName);
73 WAD.ReadMemory(buf, buflen);
75 // ×èòàåì INI-ðåñóðñ àíèì. òåêñòóðû è çàïîìèíàåì åãî óñòàíîâêè:
76 if not WAD.GetResource('TEXT/ANIM', TextData, ResLength) then
77 begin
78 writeln(Format('Animated texture file "%s" has invalid INI', [wadName]));
79 exit;
80 end;
82 try
83 cfg := TConfig.CreateMem(TextData, ResLength);
85 TextureResource := cfg.ReadStr('', 'resource', '');
86 if TextureResource = '' then
87 begin
88 writeln(Format('Animated texture WAD file "%s" has no "resource"', [wadName]));
89 exit;
90 end;
92 _width := cfg.ReadInt('', 'framewidth', 0);
93 _height := cfg.ReadInt('', 'frameheight', 0);
94 _framecount := cfg.ReadInt('', 'framecount', 0);
95 _speed := cfg.ReadInt('', 'waitcount', 0);
96 _backanimation := cfg.ReadBool('', 'backanimation', False);
97 if _speed < 0 then _speed := 0;
99 if (_width < 1) or (_width > 16383) or (_height < 1) or (_height > 16383) then
100 begin
101 writeln('invalid animation dimensions: ', _width, 'x', _height);
102 exit;
103 end;
105 if (_framecount < 1) or (_framecount > 1024) then
106 begin
107 writeln('invalid frame count: ', _framecount);
108 exit;
109 end;
111 cfg.Free();
112 cfg := nil;
114 // ×èòàåì ðåñóðñ òåêñòóð (êàäðîâ) àíèì. òåêñòóðû â ïàìÿòü:
115 if not WAD.GetResource('TEXTURES/'+TextureResource, TextureData, ResLength) then
116 begin
117 writeln(Format('Animated texture WAD file "%s" has no texture "%s"', [wadName, 'TEXTURES/'+TextureResource]));
118 exit;
119 end;
121 if not LoadImageFromMemory(TextureData, ResLength, img) then
122 begin
123 writeln(Format('Animated texture file "%s" has invalid texture image', [wadName]));
124 exit;
125 end;
126 //writeln('texture image: ', img.width, 'x', img.height, ' (', img.width div _width, ' frames)');
128 WAD.Free();
129 WAD := nil;
131 // now create animation frames
132 GlobalMetadata.ClearMetaItems();
133 GlobalMetadata.ClearMetaItemsForSaving();
135 GlobalMetadata.SetMetaItem(SMetaFrameDelay, _speed*28);
136 if _backanimation then
137 GlobalMetadata.SetMetaItem(SMetaAnimationLoops, 1)
138 else
139 GlobalMetadata.SetMetaItem(SMetaAnimationLoops, 0);
141 SetLength(ia, _framecount);
142 //writeln('creating ', length(ia), ' animation frames...');
143 for f := 0 to high(ia) do
144 begin
145 GlobalMetadata.SetMetaItem(SMetaFrameDelay, _speed*28, f);
146 if _backanimation then
147 GlobalMetadata.SetMetaItem(SMetaAnimationLoops, 1, f)
148 else
149 GlobalMetadata.SetMetaItem(SMetaAnimationLoops, 0, f);
151 InitImage(ia[f]);
152 NewImage(_width, _height, TImageFormat.ifA8R8G8B8, ia[f]);
153 ofsx := f*_width;
154 ofsy := 0;
155 for y := 0 to _height-1 do
156 begin
157 for x := 0 to _width-1 do
158 begin
159 nx := ofsx+x;
160 ny := ofsy+y;
161 if (nx >= 0) and (ny >= 0) and (nx < img.width) and (ny < img.height) then
162 begin
163 clr := GetPixel32(img, nx, ny);
164 end
165 else
166 begin
167 clr.r := 0;
168 clr.g := 0;
169 clr.b := 0;
170 clr.a := 0;
171 end;
172 SetPixel32(ia[f], x, y, clr);
173 end;
174 end;
175 //writeln('resizing image...');
176 //ResizeImage(ia[f], 320, 200, TResizeFilter.rfNearest);
177 end;
178 GlobalMetadata.CopyLoadedMetaItemsForSaving;
180 sto := TMemoryStream.Create();
181 //writeln(' ... [', ChangeFileExt(wadName, '.png'), '] (', length(ia), ') ');
182 if SaveMultiImageToStream('png', sto, ia) then
183 begin
184 sto.position := 0;
185 result := sto;
186 sto := nil;
187 end
188 else
189 begin
190 //writeln(' ...WTF?!');
191 end;
192 finally
193 FreeImage(img);
194 end;
195 finally
196 for f := 0 to High(ia) do FreeImage(ia[f]);
197 WAD.Free();
198 cfg.Free();
199 if TextureWAD <> nil then FreeMem(TextureWAD);
200 if TextData <> nil then FreeMem(TextData);
201 if TextureData <> nil then FreeMem(TextureData);
202 sto.Free();
203 FreeMem(buf);
204 end;
205 end;
208 function recompressImageToPng (ist: TStream): TStream;
209 var
210 ia: TDynImageDataArray = nil;
211 sto: TMemoryStream = nil;
212 f: Integer;
213 begin
214 result := nil;
215 ist.position := 0;
216 GlobalMetadata.ClearMetaItems();
217 GlobalMetadata.ClearMetaItemsForSaving();
218 if not LoadMultiImageFromStream(ist, ia) then exit;
219 try
220 GlobalMetadata.CopyLoadedMetaItemsForSaving;
221 sto := TMemoryStream.Create();
222 if SaveMultiImageToStream('png', sto, ia) then
223 begin
224 sto.position := 0;
225 result := sto;
226 sto := nil;
227 end;
228 finally
229 sto.Free();
230 for f := 0 to High(ia) do FreeImage(ia[f]);
231 end;
232 end;
235 // returs crc
236 function zpack (ds: TStream; ss: TStream; var aborted: Boolean): LongWord;
237 const
238 IBSize = 65536;
239 OBSize = 65536;
240 var
241 zst: TZStream;
242 ib, ob: PByte;
243 err: Integer;
244 rd: Integer;
245 eof: Boolean;
246 crc: LongWord;
247 dstp, srcsize: Int64;
248 begin
249 result := 0;
250 //aborted := true; exit;
251 aborted := false;
252 crc := crc32(0, nil, 0);
253 GetMem(ib, IBSize);
254 GetMem(ob, OBSize);
255 ss.position := 0;
256 dstp := ds.position;
257 srcsize := ss.size;
258 try
259 zst.next_out := ob;
260 zst.avail_out := OBSize;
261 zst.next_in := ib;
262 zst.avail_in := 0;
263 err := deflateInit2(zst, Z_BEST_COMPRESSION, Z_DEFLATED, -15, 9, 0);
264 if err <> Z_OK then raise Exception.Create(zerror(err));
265 try
266 eof := false;
267 repeat
268 if zst.avail_in = 0 then
269 begin
270 // read input buffer part
271 rd := ss.read(ib^, IBSize);
272 if rd < 0 then raise Exception.Create('reading error');
273 //writeln(' read ', rd, ' bytes');
274 eof := (rd = 0);
275 if rd <> 0 then begin crc := crc32(crc, Pointer(ib), rd); result := crc; end;
276 zst.next_in := ib;
277 zst.avail_in := rd;
278 end;
279 // now process the whole input
280 while zst.avail_in > 0 do
281 begin
282 err := deflate(zst, Z_NO_FLUSH);
283 if err <> Z_OK then raise Exception.Create(zerror(err));
284 if zst.avail_out < OBSize then
285 begin
286 //writeln(' written ', OBSize-zst.avail_out, ' bytes');
287 if ds.position+(OBSize-zst.avail_out)-dstp >= srcsize then
288 begin
289 // this will be overwritten anyway
290 aborted := true;
291 exit;
292 end;
293 ds.writeBuffer(ob^, OBSize-zst.avail_out);
294 zst.next_out := ob;
295 zst.avail_out := OBSize;
296 end;
297 end;
298 until eof;
299 // do leftovers
300 while true do
301 begin
302 zst.avail_in := 0;
303 err := deflate(zst, Z_FINISH);
304 if (err <> Z_OK) and (err <> Z_STREAM_END) then raise Exception.Create(zerror(err));
305 if zst.avail_out < OBSize then
306 begin
307 //writeln(' .written ', OBSize-zst.avail_out, ' bytes');
308 if ds.position+(OBSize-zst.avail_out)-dstp >= srcsize then
309 begin
310 // this will be overwritten anyway
311 aborted := true;
312 exit;
313 end;
314 ds.writeBuffer(ob^, OBSize-zst.avail_out);
315 zst.next_out := ob;
316 zst.avail_out := OBSize;
317 end;
318 if err <> Z_OK then break;
319 end;
320 // succesfully flushed?
321 if (err <> Z_STREAM_END) then raise Exception.Create(zerror(err));
322 finally
323 deflateEnd(zst);
324 end;
325 finally
326 FreeMem(ob);
327 FreeMem(ib);
328 end;
329 end;
332 {
333 procedure TProg.putStr (const s: AnsiString; newline: Boolean=false);
334 begin
335 write(#13, s);
336 while lastlen > length(s) do
337 begin
338 write(' ');
339 Dec(lastlen);
340 end;
341 if newline then
342 begin
343 writeln;
344 lastlen := 0;
345 end
346 else
347 begin
348 lastlen := length(s);
349 end;
350 end;
352 procedure TProg.onProgress (sender: TObject; const percent: double);
353 var
354 prc: Integer;
355 begin
356 prc := trunc(percent*100.0);
357 putStr(Format('compressing %-33s %3d%%', [lastname, prc]));
358 end;
360 procedure TProg.onFileStart (sender: TObject; const fileName: AnsiString);
361 begin
362 lastname := fileName;
363 putStr(Format('compressing %-33s %3d%%', [lastname, 0]));
364 end;
366 procedure TProg.onFileEnd (sender: TObject; const ratio: double);
367 begin
368 putStr(Format('compressed %-33s %f', [lastname, ratio]), true);
369 end;
370 }
373 // returns new file name
374 function detectExt (fpath, fname: AnsiString; fs: TStream): AnsiString;
375 var
376 buf: PChar;
377 buflen: Integer;
378 f: Integer;
379 st: string[24];
380 img: string;
381 begin
382 result := fname;
383 if length(ExtractFileExt(fname)) <> 0 then exit;
384 if fs.size < 16 then exit;
385 buflen := Integer(fs.size);
386 GetMem(buf, buflen);
387 try
388 fs.ReadBuffer(buf^, buflen);
389 // xm
390 Move(buf^, (PChar(@st[1]))^, 16);
391 st[0] := #16;
392 if (st = 'Extended Module:') then
393 begin
394 result := result+'.xm';
395 exit;
396 end;
397 if (buf[0] = 'D') and (buf[1] = 'F') and (buf[2] = 'W') and
398 (buf[3] = 'A') and (buf[4] = 'D') and (buf[5] = #$1) then
399 begin
400 result := result+'.wad';
401 exit;
402 end;
403 if (buf[0] = 'M') and (buf[1] = 'A') and (buf[2] = 'P') and (buf[3] = #$1) then
404 begin
405 result := result+'.dfmap';
406 exit;
407 end;
408 if (buf[0] = 'M') and (buf[1] = 'T') and (buf[2] = 'h') and (buf[3] = 'd') then
409 begin
410 result := result+'.mid';
411 exit;
412 end;
413 if (buf[0] = 'R') and (buf[1] = 'I') and (buf[2] = 'F') and (buf[3] = 'F') and
414 (buf[8] = 'W') and (buf[9] = 'A') and (buf[10] = 'V') and (buf[11] = 'E') then
415 begin
416 result := result+'.wav';
417 exit;
418 end;
419 // mp3 (stupid hack)
420 for f := 0 to 128-6 do
421 begin
422 if (buf[f+0] = #$4) and (buf[f+1] = 'L') and
423 (buf[f+2] = 'A') and (buf[f+3] = 'M') and
424 (buf[f+4] = 'E') and (buf[f+5] = '3') then
425 begin
426 result := result+'.mp3';
427 exit;
428 end;
429 end;
430 // more mp3 hacks
431 if (buf[0] = 'I') and (buf[1] = 'D') and (buf[2] = '3') and (buf[3] <= #4) then
432 begin
433 result := result+'.mp3';
434 exit;
435 end;
436 if buflen > 128 then
437 begin
438 if (buf[buflen-128] = 'T') and (buf[buflen-127] = 'A') and (buf[buflen-126] = 'G') then
439 begin
440 result := result+'.mp3';
441 exit;
442 end;
443 end;
444 // targa (stupid hack; this "signature" is not required by specs)
445 {
446 if buflen >= 18 then
447 begin
448 Move((buf+buflen-18)^, (PChar(@st[1]))^, 16);
449 st[0] := #16;
450 if st = 'TRUEVISION-XFILE' then
451 begin
452 result := result+'.tga';
453 exit;
454 end;
455 end;
456 }
457 // detect image format
458 img := DetermineMemoryFormat(buf, buflen);
459 if length(img) > 0 then
460 begin
461 result := result+'.'+img;
462 exit;
463 end;
464 // check if this is text file
465 if buflen > 16 then
466 begin
467 for f := 0 to buflen-1 do
468 begin
469 if buf[f] = #127 then exit;
470 if buf[f] < #32 then
471 begin
472 if (buf[f] <> #9) and (buf[f] <> #10) and (buf[f] <> #13) then exit;
473 end;
474 end;
475 result := result+'.txt';
476 end;
477 finally
478 FreeMem(buf);
479 end;
480 end;
483 type
484 TFileInfo = class
485 public
486 name: AnsiString;
487 pkofs: Int64; // offset of file header
488 size: Int64;
489 pksize: Int64;
490 crc: LongWord;
491 method: Word;
493 constructor Create ();
494 end;
496 constructor TFileInfo.Create ();
497 begin
498 name := '';
499 pkofs := 0;
500 size := 0;
501 pksize := 0;
502 crc := crc32(0, nil, 0);
503 method := 0;
504 end;
507 const
508 uni2wint: array [128..255] of Word = (
509 $0402,$0403,$201A,$0453,$201E,$2026,$2020,$2021,$20AC,$2030,$0409,$2039,$040A,$040C,$040B,$040F,
510 $0452,$2018,$2019,$201C,$201D,$2022,$2013,$2014,$003F,$2122,$0459,$203A,$045A,$045C,$045B,$045F,
511 $00A0,$040E,$045E,$0408,$00A4,$0490,$00A6,$00A7,$0401,$00A9,$0404,$00AB,$00AC,$00AD,$00AE,$0407,
512 $00B0,$00B1,$0406,$0456,$0491,$00B5,$00B6,$00B7,$0451,$2116,$0454,$00BB,$0458,$0405,$0455,$0457,
513 $0410,$0411,$0412,$0413,$0414,$0415,$0416,$0417,$0418,$0419,$041A,$041B,$041C,$041D,$041E,$041F,
514 $0420,$0421,$0422,$0423,$0424,$0425,$0426,$0427,$0428,$0429,$042A,$042B,$042C,$042D,$042E,$042F,
515 $0430,$0431,$0432,$0433,$0434,$0435,$0436,$0437,$0438,$0439,$043A,$043B,$043C,$043D,$043E,$043F,
516 $0440,$0441,$0442,$0443,$0444,$0445,$0446,$0447,$0448,$0449,$044A,$044B,$044C,$044D,$044E,$044F
517 );
520 function toUtf8 (const s: AnsiString): AnsiString;
521 var
522 uc: PUnicodeChar;
523 xdc: PChar;
524 pos, f: Integer;
525 begin
526 GetMem(uc, length(s)*8);
527 GetMem(xdc, length(s)*8);
528 try
529 FillChar(uc^, length(s)*8, 0);
530 FillChar(xdc^, length(s)*8, 0);
531 pos := 0;
532 for f := 1 to length(s) do
533 begin
534 if ord(s[f]) < 128 then
535 uc[pos] := UnicodeChar(ord(s[f]))
536 else
537 uc[pos] := UnicodeChar(uni2wint[ord(s[f])]);
538 Inc(pos);
539 end;
540 FillChar(xdc^, length(s)*8, 0);
541 f := UnicodeToUtf8(xdc, length(s)*8, uc, pos);
542 while (f > 0) and (xdc[f-1] = #0) do Dec(f);
543 SetLength(result, f);
544 Move(xdc^, result[1], f);
545 finally
546 FreeMem(xdc);
547 FreeMem(uc);
548 end;
549 end;
551 // this will write "extra field length" and extra field itself
552 {$IFDEF UTFEXTRA}
553 const UtfFlags = 0;
555 type
556 TByteArray = array of Byte;
558 function buildUtfExtra (fname: AnsiString): TByteArray;
559 var
560 crc: LongWord;
561 fu: AnsiString;
562 sz: Word;
563 begin
564 fu := toUtf8(fname);
565 if fu = fname then begin result := nil; exit; end; // no need to write anything
566 crc := crc32(0, @fname[1], length(fname));
567 sz := 2+2+1+4+length(fu);
568 SetLength(result, sz);
569 result[0] := ord('u');
570 result[1] := ord('p');
571 Dec(sz, 4);
572 result[2] := sz and $ff;
573 result[3] := (sz shr 8) and $ff;
574 result[4] := 1;
575 result[5] := crc and $ff;
576 result[6] := (crc shr 8) and $ff;
577 result[7] := (crc shr 16) and $ff;
578 result[8] := (crc shr 24) and $ff;
579 Move(fu[1], result[9], length(fu));
580 end;
581 {$ELSE}
582 const UtfFlags = (1 shl 10); // bit 11
583 {$ENDIF}
585 function ZipOne (ds: TStream; fname: AnsiString; st: TStream; dopack: Boolean=true): TFileInfo;
586 var
587 oldofs, nfoofs, pkdpos, rd: Int64;
588 sign: packed array [0..3] of Char;
589 buf: PChar;
590 bufsz: Integer;
591 aborted: Boolean = false;
592 {$IFDEF UTFEXTRA}
593 ef: TByteArray;
594 {$ENDIF}
595 begin
596 result := TFileInfo.Create();
597 result.pkofs := ds.position;
598 result.size := st.size;
599 if result.size > 0 then result.method := 8 else result.method := 0;
600 if not dopack then
601 begin
602 result.method := 0;
603 result.pksize := result.size;
604 end;
605 {$IFDEF UTFEXTRA}
606 result.name := fname;
607 ef := buildUtfExtra(result.name);
608 {$ELSE}
609 result.name := toUtf8(fname);
610 {$ENDIF}
611 // write local header
612 sign := 'PK'#3#4;
613 ds.writeBuffer(sign, 4);
614 writeInt(ds, Word($0A10)); // version to extract
615 writeInt(ds, Word(UtfFlags)); // flags
616 writeInt(ds, Word(result.method)); // compression method
617 writeInt(ds, Word(0)); // file time
618 writeInt(ds, Word(0)); // file date
619 nfoofs := ds.position;
620 writeInt(ds, LongWord(result.crc)); // crc32
621 writeInt(ds, LongWord(result.pksize)); // packed size
622 writeInt(ds, LongWord(result.size)); // unpacked size
623 writeInt(ds, Word(length(fname))); // name length
624 {$IFDEF UTFEXTRA}
625 writeInt(ds, Word(length(ef))); // extra field length
626 {$ELSE}
627 writeInt(ds, Word(0)); // extra field length
628 {$ENDIF}
629 ds.writeBuffer(fname[1], length(fname));
630 {$IFDEF UTFEXTRA}
631 if length(ef) > 0 then ds.writeBuffer(ef[0], length(ef));
632 {$ENDIF}
633 if dopack then
634 begin
635 // now write packed data
636 if result.size > 0 then
637 begin
638 pkdpos := ds.position;
639 st.position := 0;
640 result.crc := zpack(ds, st, aborted);
641 result.pksize := ds.position-pkdpos;
642 if {result.pksize >= result.size} aborted then
643 begin
644 // there's no sence to pack this file, so just store it
645 st.position := 0;
646 ds.position := result.pkofs;
647 result.Free();
648 // store it
649 result := ZipOne(ds, fname, st, false);
650 exit;
651 end
652 else
653 begin
654 // fix header
655 oldofs := ds.position;
656 ds.position := nfoofs;
657 writeInt(ds, LongWord(result.crc)); // crc32
658 writeInt(ds, LongWord(result.pksize)); // crc32
659 ds.position := oldofs;
660 end;
661 end;
662 end
663 else
664 begin
665 bufsz := 1024*1024;
666 GetMem(buf, bufsz);
667 try
668 st.position := 0;
669 result.crc := crc32(0, nil, 0);
670 result.pksize := 0;
671 while result.pksize < result.size do
672 begin
673 rd := result.size-result.pksize;
674 if rd > bufsz then rd := bufsz;
675 st.readBuffer(buf^, rd);
676 ds.writeBuffer(buf^, rd);
677 Inc(result.pksize, rd);
678 result.crc := crc32(result.crc, buf, rd);
679 end;
680 finally
681 FreeMem(buf);
682 end;
683 // fix header
684 oldofs := ds.position;
685 ds.position := nfoofs;
686 writeInt(ds, LongWord(result.crc)); // crc32
687 ds.position := oldofs;
688 write('(S) ');
689 end;
690 end;
693 procedure writeCentralDir (ds: TStream; files: array of TFileInfo);
694 var
695 cdofs, cdend: Int64;
696 sign: packed array [0..3] of Char;
697 f: Integer;
698 {$IFDEF UTFEXTRA}
699 ef: TByteArray;
700 {$ENDIF}
701 begin
702 cdofs := ds.position;
703 for f := 0 to high(files) do
704 begin
705 {$IFDEF UTFEXTRA}
706 ef := buildUtfExtra(files[f].name);
707 {$ENDIF}
708 sign := 'PK'#1#2;
709 ds.writeBuffer(sign, 4);
710 writeInt(ds, Word($0A10)); // version made by
711 writeInt(ds, Word($0010)); // version to extract
712 writeInt(ds, Word(UtfFlags)); // flags
713 writeInt(ds, Word(files[f].method)); // compression method
714 writeInt(ds, Word(0)); // file time
715 writeInt(ds, Word(0)); // file date
716 writeInt(ds, LongWord(files[f].crc));
717 writeInt(ds, LongWord(files[f].pksize));
718 writeInt(ds, LongWord(files[f].size));
719 writeInt(ds, Word(length(files[f].name))); // name length
720 {$IFDEF UTFEXTRA}
721 writeInt(ds, Word(length(ef))); // extra field length
722 {$ELSE}
723 writeInt(ds, Word(0)); // extra field length
724 {$ENDIF}
725 writeInt(ds, Word(0)); // comment length
726 writeInt(ds, Word(0)); // disk start
727 writeInt(ds, Word(0)); // internal attributes
728 writeInt(ds, LongWord(0)); // external attributes
729 writeInt(ds, LongWord(files[f].pkofs)); // header offset
730 ds.writeBuffer(files[f].name[1], length(files[f].name));
731 {$IFDEF UTFEXTRA}
732 if length(ef) > 0 then ds.writeBuffer(ef[0], length(ef));
733 {$ENDIF}
734 end;
735 cdend := ds.position;
736 // write end of central dir
737 sign := 'PK'#5#6;
738 ds.writeBuffer(sign, 4);
739 writeInt(ds, Word(0)); // disk number
740 writeInt(ds, Word(0)); // disk with central dir
741 writeInt(ds, Word(length(files))); // number of files on this dist
742 writeInt(ds, Word(length(files))); // number of files total
743 writeInt(ds, LongWord(cdend-cdofs)); // size of central directory
744 writeInt(ds, LongWord(cdofs)); // central directory offset
745 writeInt(ds, Word(0)); // archive comment length
746 end;
749 var
750 fs, fo, ast: TStream;
751 fl: TSFSFileList;
752 f, c: Integer;
753 infname: AnsiString = '';
754 outfname: AnsiString = '';
755 dvfn: AnsiString;
756 newname: AnsiString;
757 files: array of TFileInfo;
758 nfo: TFileInfo;
759 nomoreopts: Boolean;
760 arg: AnsiString;
761 begin
762 if ParamCount() < 1 then
763 begin
764 WriteLn('usage: wadcvt file.wad');
765 Halt(1);
766 end;
768 for f := 1 to ParamCount() do
769 begin
770 arg := ParamStr(f);
771 if length(arg) = 0 then continue;
772 if not nomoreopts and (arg[1] = '-') then
773 begin
774 if arg = '--apng' then optConvertATX := true
775 else if arg = '--tga' then optConvertTGA := true
776 else if arg = '--locase' then optLoCaseNames := true
777 else if arg = '--nocase' then optLoCaseNames := false
778 else if (arg = '--help') or (arg = '-h') then
779 begin
780 writeln('usage: wadcvt [options] file.wad');
781 writeln('options:');
782 writeln(' --apng convert animated textures to APNG format');
783 writeln(' --tga convert Targa images to PNG format');
784 {$IFNDEF WINDOWS}
785 writeln(' --locase convert file names to lower case');
786 {$ENDIF}
787 Halt(1);
788 end
789 else if arg = '--' then nomoreopts := true
790 else
791 begin
792 writeln('unknown option: "', arg, '"');
793 Halt(1);
794 end;
795 end
796 else
797 begin
798 if length(infname) = 0 then infname := arg
799 else if length(outfname) = 0 then outfname := arg
800 else
801 begin
802 writeln('FATAL: too many arguments!');
803 Halt(1);
804 end;
805 end;
806 end;
808 if not StrEquCI1251(ExtractFileExt(infname), '.wad') and not StrEquCI1251(ExtractFileExt(infname), '.dfwad') then
809 begin
810 writeln('wtf?!');
811 Halt(1);
812 end;
814 if length(outfname) = 0 then outfname := ChangeFileExt(infname, '.pk3');
816 if not SFSAddDataFile(infname) then begin WriteLn('shit!'); Halt(1); end;
817 dvfn := SFSGetLastVirtualName(infname);
819 files := nil;
821 fl := SFSFileList(dvfn);
822 if fl = nil then
823 begin
824 writeln('wtf?!');
825 Halt(1);
826 end;
828 Imaging.SetOption(ImagingPNGCompressLevel, 9);
829 Imaging.SetOption(ImagingPNGLoadAnimated, 1);
830 Imaging.SetOption(ImagingGIFLoadAnimated, 1);
832 {$IFNDEF WINDOWS}
833 optLoCaseNames := true;
834 {$ENDIF}
836 fo := TFileStream.Create(outfname, fmCreate);
837 try
838 for f := 0 to fl.Count-1 do
839 begin
840 if length(fl[f].fName) = 0 then continue;
841 fs := SFSFileOpen(dvfn+'::'+fl[f].fPath+fl[f].fName);
842 newname := detectExt(fl[f].fPath, fl[f].fName, fs);
843 //fs.Free();
844 //fs := SFSFileOpen(dvfn+'::'+fl[f].fPath+fl[f].fName);
845 fs.position := 0;
846 {$IFNDEF ONELINELOG}
847 write(#13'[', f+1, '/', fl.Count, ']: ', fl[f].fPath, newname, ' ', fs.size, ' ... '#27'[K');
848 {$ELSE}
849 write('[', f+1, '/', fl.Count, ']: ', fl[f].fPath, newname, ' ', fs.size, ' ... ');
850 {$ENDIF}
851 //writeln(' : ', newname, ' : [', ExtractFileExt(newname), ']');
852 if optConvertATX and (StrEquCI1251(ExtractFileExt(newname), '.dfwad') or StrEquCI1251(ExtractFileExt(newname), '.wad')) then
853 begin
854 //writeln(' ANIMTEXT!');
855 ast := convertAnimTexture(fs, newname);
856 if ast <> nil then
857 begin
858 fs.Free();
859 fs := ast;
860 newname := ChangeFileExt(newname, '.png');
861 {$IFNDEF ONELINELOG}
862 write('APNG ');
863 {$ENDIF}
864 end;
865 end
866 else if optConvertTGA and (StrEquCI1251(ExtractFileExt(newname), '.tga') or StrEquCI1251(ExtractFileExt(newname), '.bmp')) then
867 begin
868 ast := recompressImageToPng(fs);
869 if ast <> nil then
870 begin
871 fs.Free();
872 fs := ast;
873 newname := ChangeFileExt(newname, '.png');
874 {$IFNDEF ONELINELOG}
875 write('PNG ');
876 {$ENDIF}
877 end;
878 fs.position := 0;
879 end;
880 newname := fl[f].fPath+newname;
881 if optLoCaseNames then for c := 1 to length(newname) do newname[c] := LoCase1251(newname[c]);
882 nfo := ZipOne(fo, newname, fs);
883 write('DONE');
884 {$IFNDEF ONELINELOG}
885 writeln;
886 {$ENDIF}
887 SetLength(files, length(files)+1);
888 files[high(files)] := nfo;
889 end;
890 {$IFNDEF ONELINELOG}
891 writeln(fl.Count, ' files processed.');
892 {$ELSE}
893 writeln(#13, fl.Count, ' files processed.'#27'[K');
894 {$ENDIF}
895 writeCentralDir(fo, files);
896 except
897 fo.Free();
898 fo := nil;
899 DeleteFile(outfname);
900 end;
901 if fo <> nil then fo.Free();
902 end.