From: Ketmar Dark Date: Thu, 7 Sep 2017 00:37:19 +0000 (+0300) Subject: cosmetix in dynrecs; fixed mapcvt X-Git-Url: http://deadsoftware.ru/gitweb?a=commitdiff_plain;h=48fa53d341e432475432901a339f1ae81fda7809;p=d2df-sdl.git cosmetix in dynrecs; fixed mapcvt --- diff --git a/src/shared/xdynrec.pas b/src/shared/xdynrec.pas index 223dc51..cdabf24 100644 --- a/src/shared/xdynrec.pas +++ b/src/shared/xdynrec.pas @@ -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; diff --git a/src/shared/xparser.pas b/src/shared/xparser.pas index 01c49b4..f539536 100644 --- a/src/shared/xparser.pas +++ b/src/shared/xparser.pas @@ -158,6 +158,9 @@ type procedure putIndent (); procedure indent (); procedure unindent (); + + public + property curIndent: Integer read mIndent; end; diff --git a/src/tools/mapcvt.dpr b/src/tools/mapcvt.dpr index de1c0a3..476179c 100644 --- a/src/tools/mapcvt.dpr +++ b/src/tools/mapcvt.dpr @@ -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.