src/sfs/wadcvt.dpr

   1 {$IFDEF WIN32}
   2   {$APPTYPE CONSOLE}
   3 {$ENDIF}
   4 {$MODE DELPHI}
   5 program __wadcvt__;
   6
   7 uses
   8   SysUtils,
   9   Classes,
  10   utils in '../shared/utils.pas',
  11   xstreams in '../shared/xstreams.pas',
  12   sfs,
  13   sfsPlainFS,
  14   sfsZipFS,
  15   zipper;
  16
  17
  18 type
  19   TProg = class(TObject)
  20     lastname: string;
  21     lastlen: Integer;
  22
  23     procedure putStr (const s: string; newline: Boolean=false);
  24
  25     procedure onProgress (sender: TObject; const percent: double);
  26     procedure onFileStart (sender: TObject; const fileName: string);
  27     procedure onFileEnd (sender: TObject; const ratio: double);
  28   end;
  29
  30
  31 procedure TProg.putStr (const s: string; newline: Boolean=false);
  32 begin
  33   write(#13, s);
  34   while lastlen > length(s) do
  35   begin
  36     write(' ');
  37     Dec(lastlen);
  38   end;
  39   if newline then
  40   begin
  41     writeln;
  42     lastlen := 0;
  43   end
  44   else
  45   begin
  46     lastlen := length(s);
  47   end;
  48 end;
  49
  50 procedure TProg.onProgress (sender: TObject; const percent: double);
  51 var
  52   prc: Integer;
  53 begin
  54   prc := trunc(percent*100.0);
  55   putStr(Format('compressing %-33s  %3d%%', [lastname, prc]));
  56 end;
  57
  58 procedure TProg.onFileStart (sender: TObject; const fileName: string);
  59 begin
  60   lastname := fileName;
  61   putStr(Format('compressing %-33s  %3d%%', [lastname, 0]));
  62 end;
  63
  64 procedure TProg.onFileEnd (sender: TObject; const ratio: double);
  65 begin
  66   putStr(Format('compressed  %-33s  %f', [lastname, ratio]), true);
  67 end;
  68
  69
  70 // returns new file name
  71 function detectExt (fpath, fname: string; fs: TStream): string;
  72 var
  73   buf: PChar;
  74   buflen: Integer;
  75   f: Integer;
  76   st: string[24];
  77 begin
  78   result := fname;
  79   if length(ExtractFileExt(fname)) <> 0 then exit;
  80   if fs.size < 16 then exit;
  81   buflen := Integer(fs.size);
  82   GetMem(buf, buflen);
  83   try
  84     fs.ReadBuffer(buf^, buflen);
  85     // xm
  86     Move(buf^, (PChar(@st[1]))^, 16);
  87     st[0] := #16;
  88     if (st = 'Extended Module:') then
  89     begin
  90       result := result+'.xm';
  91       exit;
  92     end;
  93     if (buf[0] = 'D') and (buf[1] = 'F') and (buf[2] = 'W') and
  94        (buf[3] = 'A') and (buf[4] = 'D') and (buf[5] = #$1) then
  95     begin
  96       result := result+'.wad';
  97       exit;
  98     end;
  99     if (buf[0] = 'M') and (buf[1] = 'A') and (buf[2] = 'P') and (buf[3] = #$1) then
 100     begin
 101       result := result+'.dfmap';
 102       exit;
 103     end;
 104     if (buf[0] = 'M') and (buf[1] = 'T') and (buf[2] = 'h') and (buf[3] = 'd') then
 105     begin
 106       result := result+'.mid';
 107       exit;
 108     end;
 109     if (buf[0] = 'R') and (buf[1] = 'I') and (buf[2] = 'F') and (buf[3] = 'F') and
 110        (buf[8] = 'W') and (buf[9] = 'A') and (buf[10] = 'V') and (buf[11] = 'E') then
 111     begin
 112       result := result+'.wav';
 113       exit;
 114     end;
 115     // mp3 (stupid hack)
 116     for f := 0 to 128-6 do
 117     begin
 118       if (buf[f+0] = #$4) and (buf[f+1] = 'L') and
 119          (buf[f+2] = 'A') and (buf[f+3] = 'M') and
 120          (buf[f+4] = 'E') and (buf[f+5] = '3') then
 121       begin
 122         result := result+'.mp3';
 123         exit;
 124       end;
 125     end;
 126     // more mp3 hacks
 127     if (buf[0] = 'I') and (buf[1] = 'D') and (buf[2] = '3') and (buf[3] <= #4) then
 128     begin
 129       result := result+'.mp3';
 130       exit;
 131     end;
 132     if buflen > 128 then
 133     begin
 134       if (buf[buflen-128] = 'T') and (buf[buflen-127] = 'A') and (buf[buflen-126] = 'G') then
 135       begin
 136         result := result+'.mp3';
 137         exit;
 138       end;
 139     end;
 140     // targa (stupid hack; this "signature" is not required by specs)
 141     if buflen >= 18 then
 142     begin
 143       Move((buf+buflen-18)^, (PChar(@st[1]))^, 16);
 144       st[0] := #16;
 145       if st = 'TRUEVISION-XFILE' then
 146       begin
 147         result := result+'.tga';
 148         exit;
 149       end;
 150     end;
 151   finally
 152     FreeMem(buf);
 153   end;
 154 end;
 155
 156
 157 var
 158   fs: TStream;
 159   fl: TSFSFileList;
 160   f: Integer;
 161   infname: string;
 162   outfname: string;
 163   zip: TZipper;
 164   dvfn: string;
 165   ZEntries: TZipFileEntries;
 166   newname: string;
 167   prg: TProg;
 168 begin
 169   if ParamCount() < 1 then
 170   begin
 171     WriteLn('usage: wadcvt file.wad');
 172     Halt(1);
 173   end;
 174
 175   infname := ParamStr(1);
 176   if not StrEquCI1251(ExtractFileExt(infname), '.wad') and not StrEquCI1251(ExtractFileExt(infname), '.dfwad') then
 177   begin
 178     writeln('wtf?!');
 179     Halt(1);
 180   end;
 181
 182   if ParamCount() > 1 then
 183   begin
 184     outfname := ParamStr(2);
 185   end
 186   else
 187   begin
 188     outfname := ChangeFileExt(infname, '.pk3');
 189   end;
 190
 191   if not SFSAddDataFile(infname) then begin WriteLn('shit!'); Halt(1); end;
 192   dvfn := SFSGetLastVirtualName(infname);
 193
 194   {
 195   tot := 0;
 196   fl := SFSFileList(ParamStr(1));
 197   if fl <> nil then
 198   begin
 199     for f := 0 to fl.Count-1 do
 200     begin
 201       WriteLn(f:4, ': ', fl[f].fSize:10, ' "', fl[f].fPath, fl[f].fName, '"');
 202       Inc(tot, fl[f].fSize);
 203     end;
 204     WriteLn('===================================================');
 205     WriteLn(fl.Count, ' files; ', Int64ToStrComma(tot), ' bytes.');
 206     fl.Free();
 207   end;
 208   }
 209
 210   zip := TZipper.Create;
 211   zip.Filename := outfname;
 212
 213   fl := SFSFileList(dvfn);
 214   if fl <> nil then
 215   begin
 216     ZEntries := TZipFileEntries.Create(TZipFileEntry);
 217     for f := 0 to fl.Count-1 do
 218     begin
 219       if length(fl[f].fName) = 0 then continue;
 220       fs := SFSFileOpen(dvfn+'::'+fl[f].fPath+fl[f].fName);
 221       newname := detectExt(fl[f].fPath, fl[f].fName, fs);
 222       fs.Free;
 223       fs := SFSFileOpen(dvfn+'::'+fl[f].fPath+fl[f].fName);
 224       writeln('[', f+1, '/', fl.Count, ']: ', fl[f].fPath+newname, '  ', fs.size);
 225       ZEntries.AddFileEntry(fs, fl[f].fPath+newname);
 226     end;
 227     try
 228       if ZEntries.Count > 0 then
 229       begin
 230         writeln('creating ''', outfname, '''');
 231         prg := TProg.Create();
 232         zip.OnProgress := prg.onProgress;
 233         zip.OnStartFile := prg.onFileStart;
 234         zip.OnEndFile := prg.onFileEnd;
 235         zip.ZipFiles(ZEntries);
 236         prg.Free;
 237       end;
 238     except
 239       on E: EZipError do E.CreateFmt('Zipfile could not be created%sReason: %s', [LineEnding, E.Message])
 240     end;
 241   end
 242   else
 243   begin
 244     writeln('SFSFileList(): faled!');
 245   end;
 246 end.