DEADSOFTWARE

cosmetix in dynrecs; fixed mapcvt
authorKetmar Dark <ketmar@ketmar.no-ip.org>
Thu, 7 Sep 2017 00:37:19 +0000 (03:37 +0300)
committerKetmar Dark <ketmar@ketmar.no-ip.org>
Thu, 7 Sep 2017 00:37:38 +0000 (03:37 +0300)
src/shared/xdynrec.pas
src/shared/xparser.pas
src/tools/mapcvt.dpr

index 223dc51518c92d89b11e8ad9cb957c89c57ba1aa..cdabf24010918c630a1ac82e8e2f6a4c1daeb6ec 100644 (file)
@@ -167,7 +167,7 @@ type
 
     // binary parser and writer (DO NOT USE!)
     procedure parseBinValue (st: TStream);
-    procedure writeBinTo (st: TStream);
+    procedure writeBinTo (var hasLostData: Boolean; st: TStream);
 
   public
     // the following functions are here only for 'mapgen'! DO NOT USE!
@@ -208,6 +208,7 @@ type
     property hasTPrefix: Boolean read mAsT;
     property separatePasFields: Boolean read mSepPosSize;
     property binOfs: Integer read mBinOfs;
+    property equToDefault: Boolean read isDefaultValue;
   end;
 
 
@@ -313,7 +314,7 @@ type
 
     // binary parser and writer (DO NOT USE!)
     procedure parseBinValue (st: TStream; forceData: Boolean=false);
-    procedure writeBinTo (st: TStream; trigbufsz: Integer=-1; onlyFields: Boolean=false);
+    procedure writeBinTo (var hasLostData: Boolean; st: TStream; trigbufsz: Integer=-1; onlyFields: Boolean=false);
 
   public
     property mapdef: TDynMapDef read mOwner;
@@ -421,7 +422,7 @@ type
   public
     // parse text or binary map, return new header record
     // WARNING! stream must be seekable
-    function parseMap (st: TStream): TDynRecord;
+    function parseMap (st: TStream; wasBinary: PBoolean=nil): TDynRecord;
 
     // returns `true` if the given stream can be a map file
     // stream position is 0 on return
@@ -1292,7 +1293,7 @@ begin
 end;
 
 
-procedure TDynField.writeBinTo (st: TStream);
+procedure TDynField.writeBinTo (var hasLostData: Boolean; st: TStream);
 var
   s: AnsiString;
   f: Integer;
@@ -1319,7 +1320,7 @@ begin
             if (mRecRef <> nil) then
             begin
               ws := TSFSMemoryChunkStream.Create(buf, mMaxDim);
-              mRecRef.writeBinTo(ws, mMaxDim); // as trigdata
+              mRecRef.writeBinTo(hasLostData, ws, mMaxDim); // as trigdata
             end;
             st.WriteBuffer(buf^, mMaxDim);
           finally
@@ -1434,15 +1435,9 @@ begin
         exit;
       end;
     TType.TList:
-      begin
-        assert(false);
-        exit;
-      end;
+      raise TDynRecException.Create('cannot write lists to binary format');
     TType.TTrigData:
-      begin
-        assert(false);
-        exit;
-      end;
+      raise TDynRecException.Create('cannot write triggers to binary format (internal error)');
     else raise TDynRecException.Create('ketmar forgot to handle some field type');
   end;
 end;
@@ -1526,7 +1521,7 @@ begin
             begin
               if (es.mVals[f] = mask) then
               begin
-                if not first then wr.put('+') else first := false;
+                if not first then wr.put(' | ') else first := false;
                 wr.put(es.mIds[f]);
                 found := true;
                 break;
@@ -2676,14 +2671,13 @@ begin
 end;
 
 
-procedure TDynRecord.writeBinTo (st: TStream; trigbufsz: Integer=-1; onlyFields: Boolean=false);
+procedure TDynRecord.writeBinTo (var hasLostData: Boolean; st: TStream; trigbufsz: Integer=-1; onlyFields: Boolean=false);
 var
   fld: TDynField;
   rec, rv: TDynRecord;
   buf: PByte = nil;
   ws: TStream = nil;
   blk, blkmax: Integer;
-  //f, c: Integer;
   bufsz: Integer = 0;
   blksz: Integer;
 begin
@@ -2708,11 +2702,15 @@ begin
       // record list?
       if (fld.mType = fld.TType.TList) then continue; // later
       if fld.mInternal then continue;
-      if (fld.mBinOfs < 0) then continue;
+      if (fld.mBinOfs < 0) then
+      begin
+        if not fld.equToDefault then hasLostData := true;
+        continue;
+      end;
       if (fld.mBinOfs >= bufsz) then raise TDynRecException.Create('binary value offset is outside of the buffer');
       TSFSMemoryChunkStream(ws).setup(buf+fld.mBinOfs, bufsz-fld.mBinOfs);
       //writeln('writing field <', fld.mName, '>');
-      fld.writeBinTo(ws);
+      fld.writeBinTo(hasLostData, ws);
     end;
 
     // write block with normal fields
@@ -2762,7 +2760,7 @@ begin
             if (rec = nil) then continue;
             if (rec.mBinBlock <> blk) then continue;
             if (ws = nil) then ws := TMemoryStream.Create();
-            for rv in fld.mRVal do rv.writeBinTo(ws);
+            for rv in fld.mRVal do rv.writeBinTo(hasLostData, ws);
           end;
         end;
         // flush block
@@ -2794,6 +2792,8 @@ procedure TDynRecord.writeTo (wr: TTextWriter; putHeader: Boolean=true);
 var
   fld: TDynField;
   rec: TDynRecord;
+  putTypeComment: Boolean;
+  f: Integer;
 begin
   if putHeader then
   begin
@@ -2810,11 +2810,31 @@ begin
       if (fld.mType = fld.TType.TList) then
       begin
         if not mHeader then raise TDynRecException.Create('record list in non-header record');
-        if (fld.mRVal <> nil) then
+        if (fld.mRVal <> nil) and (fld.mRVal.count > 0) then
         begin
+          putTypeComment := true;
           for rec in fld.mRVal do
           begin
-            if (Length(rec.mId) = 0) then continue;
+            if (rec = nil) or (Length(rec.mId) = 0) then continue;
+            if putTypeComment then
+            begin
+              wr.put(#10);
+              if (80-wr.curIndent*2 >= 2) then
+              begin
+                wr.putIndent();
+                for f := wr.curIndent to 80-wr.curIndent do wr.put('/');
+                wr.put(#10);
+              end;
+              putTypeComment := false;
+              wr.putIndent();
+              wr.put('// ');
+              wr.put(fld.name);
+              wr.put(#10);
+            end
+            else
+            begin
+              wr.put(#10);
+            end;
             wr.putIndent();
             rec.writeTo(wr, true);
           end;
@@ -3401,11 +3421,12 @@ end;
 
 
 // WARNING! stream must be seekable
-function TDynMapDef.parseMap (st: TStream): TDynRecord;
+function TDynMapDef.parseMap (st: TStream; wasBinary: PBoolean=nil): TDynRecord;
 var
   sign: packed array[0..3] of AnsiChar;
   pr: TTextParser;
 begin
+  if (wasBinary <> nil) then wasBinary^ := false;
   st.position := 0;
   st.ReadBuffer(sign[0], 4);
   st.position := 0;
@@ -3413,6 +3434,7 @@ begin
   begin
     if (sign[3] = #1) then
     begin
+      if (wasBinary <> nil) then wasBinary^ := true;
       result := parseBinMap(st);
       exit;
     end;
index 01c49b4bb1bb4e4360dd8e4c1057686e15b7c5ff..f539536ce0ffe98da543820f560365b6de8a8279 100644 (file)
@@ -158,6 +158,9 @@ type
     procedure putIndent ();
     procedure indent ();
     procedure unindent ();
+
+  public
+    property curIndent: Integer read mIndent;
   end;
 
 
index de1c0a36427acbfc0d0d6e84b07ea8c8230228f7..476179c3713545b0fa8418190d56e750d29cfe4b 100644 (file)
@@ -35,6 +35,8 @@ var
   wad: TWADFile = nil;
   waddata: Pointer;
   waddlen: Integer;
+  wasbin: Boolean = false;
+  lostdata: Boolean;
 begin
   if (ParamCount = 0) then
   begin
@@ -95,39 +97,33 @@ begin
     st := openDiskFileRO(inname);
   end;
 
-  st.ReadBuffer(sign, 4);
-  st.position := 0;
-  if (sign[0] = 'M') and (sign[1] = 'A') and (sign[2] = 'P') and (sign[3] = #1) then
-  begin
-    // binary map
-    if (totext < 0) then begin outname := forceFilenameExt(outname, '.txt'); totext := 1; end;
+  try
     stt := curTimeMicro();
-    map := dfmapdef.parseBinMap(st);
+    map := dfmapdef.parseMap(st, @wasbin);
     stt := curTimeMicro()-stt;
-    writeln('binary map parsed in ', stt div 1000, '.', stt mod 1000, ' milliseconds');
-    st.Free();
-  end
-  else
-  begin
-    // text map
-    if (totext < 0) then begin outname := forceFilenameExt(outname, '.map'); totext := 0; end;
-    pr := TFileTextParser.Create(st);
-    try
-      stt := curTimeMicro();
-      map := dfmapdef.parseMap(pr);
-      stt := curTimeMicro()-stt;
-      writeln('text map parsed in ', stt div 1000, '.', stt mod 1000, ' milliseconds');
-    except on e: Exception do
+    if wasbin then write('binary') else write('text');
+    writeln(' map parsed in ', stt div 1000, '.', stt mod 1000, ' milliseconds');
+  except
+    on e: TDynParseException do
       begin
-        writeln('ERROR at (', pr.line, ',', pr.col, '): ', e.message);
+        writeln('ERROR at (', e.tokLine, ',', e.tokCol, '): ', e.message);
+        Halt(1);
+      end;
+    on E: Exception do
+      begin
+        writeln('ERROR: ', e.message);
         Halt(1);
       end;
-    end;
-    pr.Free();
   end;
 
   {$IF DEFINED(D2D_DYNREC_PROFILER)}xdynDumpProfiles();{$ENDIF}
 
+  if (totext < 0) then
+  begin
+    if wasbin then begin outname := forceFilenameExt(outname, '.txt'); totext := 1; end
+    else begin outname := forceFilenameExt(outname, '.map'); totext := 0; end;
+  end;
+
   assert(totext >= 0);
 
   writeln('writing "', outname, '"...');
@@ -135,10 +131,12 @@ begin
   if (totext = 0) then
   begin
     // write binary map
+    lostdata := false;
     stt := curTimeMicro();
-    map.writeBinTo(st);
+    map.writeBinTo(lostdata, st);
     stt := curTimeMicro()-stt;
-    writeln('binary map written in ', stt div 1000, '.', stt mod 1000, ' milliseconds');
+    if lostdata then writeln('***WARNING! some data was lost due to binary format limitations!');
+    write('binary');
   end
   else
   begin
@@ -147,7 +145,8 @@ begin
     stt := curTimeMicro();
     map.writeTo(wr);
     stt := curTimeMicro()-stt;
-    writeln('text map written in ', stt div 1000, '.', stt mod 1000, ' milliseconds');
     wr.Free();
+    write('text');
   end;
+  writeln(' map written in ', stt div 1000, '.', stt mod 1000, ' milliseconds');
 end.