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