src/sfs/wadcvt.dpr

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