src/tools/mapcvt.dpr

   1 {$INCLUDE ../shared/a_modes.inc}
   2 {$APPTYPE CONSOLE}
   3
   4 uses
   5   SysUtils, Classes,
   6   sfs in '../sfs/sfs.pas',
   7   sfsPlainFS in '../sfs/sfsPlainFS.pas',
   8   sfsZipFS in '../sfs/sfsZipFS.pas',
   9   xstreams in '../shared/xstreams.pas',
  10   xparser in '../shared/xparser.pas',
  11   xdynrec in '../shared/xdynrec.pas',
  12   xprofiler in '../shared/xprofiler.pas',
  13   utils in '../shared/utils.pas',
  14   conbuf in '../shared/conbuf.pas',
  15   e_log in '../engine/e_log.pas',
  16   wadreader in '../shared/wadreader.pas',
  17   MAPDEF in '../shared/MAPDEF.pas';
  18
  19
  20 // ////////////////////////////////////////////////////////////////////////// //
  21 var
  22   pr: TTextParser;
  23   dfmapdef: TDynMapDef;
  24   wr: TTextWriter;
  25   map: TDynRecord;
  26   st: TStream;
  27   stt: UInt64;
  28   inname: AnsiString = '';
  29   outname: AnsiString = '';
  30   totext: Integer = -1; // <0: guess; force outname extension
  31   sign: packed array[0..3] of AnsiChar;
  32   wad: TWADFile = nil;
  33   waddata: Pointer;
  34   waddlen: Integer;
  35 begin
  36   if (ParamCount = 0) then
  37   begin
  38     writeln('usage: mapcvt inname outname');
  39     Halt(1);
  40   end;
  41
  42   inname := ParamStr(1);
  43   //writeln('inname: [', inname, ']');
  44   if (ParamCount = 1) then
  45   begin
  46     outname := forceFilenameExt(ParamStr(1), '');
  47     if isWadPath(outname) then
  48     begin
  49       outname := SFSReplacePathDelims(g_ExtractFilePathName(outname), '/');
  50       if (Length(outname) = 0) then begin writeln('FATAL: can''t guess output name!'); Halt(1); end;
  51     end;
  52   end
  53   else
  54   begin
  55     outname := ParamStr(2);
  56          if StrEquCI1251(getFilenameExt(outname), '.txt') then totext := 1
  57     else if StrEquCI1251(getFilenameExt(outname), '.map') then totext := 0
  58     else if StrEquCI1251(getFilenameExt(outname), '.dfmap') then totext := 0
  59     else if (Length(getFilenameExt(outname)) = 0) then totext := -1
  60     else begin writeln('FATAL: can''t guess output format!'); Halt(1); end;
  61   end;
  62   //writeln('outname: [', outname, ']; totext=', totext);
  63
  64   e_InitWritelnDriver();
  65   conbufDumpToStdOut := true;
  66   conbufConPrefix := false;
  67
  68   writeln('parsing "mapdef.txt"...');
  69   //pr := TFileTextParser.Create('mapdef.txt');
  70   pr := TStrTextParser.Create(defaultMapDef);
  71   try
  72     dfmapdef := TDynMapDef.Create(pr);
  73   except on e: Exception do
  74     begin
  75       writeln('ERROR at (', pr.line, ',', pr.col, '): ', e.message);
  76       Halt(1);
  77     end;
  78   end;
  79
  80   writeln('parsing "', inname, '"...');
  81
  82   if isWadPath(inname) then
  83   begin
  84     wad := TWADFile.Create();
  85     wad.ReadFile(g_ExtractWadName(inname));
  86     wad.GetMapResource(g_ExtractFilePathName(inname), waddata, waddlen);
  87     st := TSFSMemoryChunkStream.Create(waddata, waddlen, true);
  88     wad.Free();
  89   end
  90   else
  91   begin
  92     st := openDiskFileRO(inname);
  93   end;
  94
  95   st.ReadBuffer(sign, 4);
  96   st.position := 0;
  97   if (sign[0] = 'M') and (sign[1] = 'A') and (sign[2] = 'P') and (sign[3] = #1) then
  98   begin
  99     // binary map
 100     if (totext < 0) then begin outname := forceFilenameExt(outname, '.txt'); totext := 1; end;
 101     stt := curTimeMicro();
 102     map := dfmapdef.parseBinMap(st);
 103     stt := curTimeMicro()-stt;
 104     writeln('binary map parsed in ', stt div 1000, '.', stt mod 1000, ' microseconds');
 105     st.Free();
 106   end
 107   else
 108   begin
 109     // text map
 110     if (totext < 0) then begin outname := forceFilenameExt(outname, '.map'); totext := 0; end;
 111     pr := TFileTextParser.Create(st);
 112     try
 113       stt := curTimeMicro();
 114       map := dfmapdef.parseMap(pr);
 115       stt := curTimeMicro()-stt;
 116       writeln('text map parsed in ', stt div 1000, '.', stt mod 1000, ' microseconds');
 117     except on e: Exception do
 118       begin
 119         writeln('ERROR at (', pr.line, ',', pr.col, '): ', e.message);
 120         Halt(1);
 121       end;
 122     end;
 123     pr.Free();
 124   end;
 125
 126   assert(totext >= 0);
 127
 128   writeln('writing "', outname, '"...');
 129   st := createDiskFile(outname);
 130   if (totext = 0) then
 131   begin
 132     // write binary map
 133     stt := curTimeMicro();
 134     map.writeBinTo(st);
 135     stt := curTimeMicro()-stt;
 136     writeln('binary map written in ', stt div 1000, '.', stt mod 1000, ' microseconds');
 137   end
 138   else
 139   begin
 140     // write text map
 141     wr := TFileTextWriter.Create(st);
 142     stt := curTimeMicro();
 143     map.writeTo(wr);
 144     stt := curTimeMicro()-stt;
 145     writeln('text map written in ', stt div 1000, '.', stt mod 1000, ' microseconds');
 146     wr.Free();
 147   end;
 148 end.