From 52cb3c5b37a706c085c14e89b33361ac349bbe74 Mon Sep 17 00:00:00 2001 From: Ketmar Dark Date: Sat, 26 Aug 2017 21:32:28 +0300 Subject: [PATCH] textmap writer fixes (and other fixes); binary writer is still broken --- src/shared/xdynrec.pas | 492 +++++++++++++++++++++-------------------- 1 file changed, 253 insertions(+), 239 deletions(-) diff --git a/src/shared/xdynrec.pas b/src/shared/xdynrec.pas index a5f3623..f06df08 100644 --- a/src/shared/xdynrec.pas +++ b/src/shared/xdynrec.pas @@ -57,20 +57,22 @@ type mSVal: AnsiString; // string; for byte and char arrays mRVal: TDynRecordArray; // for list mRecRef: TDynRecord; // for record - mMaxDim: Integer; // for byte and char arrays; <0: not an array + mMaxDim: Integer; // for byte and char arrays; <0: not an array; 0: impossible value mBinOfs: Integer; // offset in binary; <0 - none mRecOfs: Integer; // offset in record; <0 - none mSepPosSize: Boolean; // for points and sizes, use separate fields mAsT: Boolean; // for points and sizes, use separate fields, names starts with `t` mDefined: Boolean; mHasDefault: Boolean; - mDefaultValueSet: Boolean; mOmitDef: Boolean; mInternal: Boolean; mNegBool: Boolean; mBitSetUnique: Boolean; // bitset can contain only one value // default value - mDefSVal: AnsiString; + mDefUnparsed: AnsiString; + mDefSVal: AnsiString; // default string value + mDefIVal, mDefIVal2: Integer; // default integer values + mDefRecRef: TDynRecord; mEBS: TEBS; // complex type type mEBSTypeName: AnsiString; // name of enum, bitset or record @@ -82,7 +84,8 @@ type procedure parseDef (pr: TTextParser); - procedure fixDefaultValue (); + procedure parseDefaultValue (); // parse `mDefUnparsed` to `mDefSVal`, `mDefIVal`, `mDefIVal2`, `mDefRecRef` + procedure fixDefaultValue (); // this will NOT clone `mDefRecRef` function isDefaultValue (): Boolean; public @@ -96,31 +99,33 @@ type function clone (): TDynField; - procedure parseValue (pr: TTextParser; curheader: TDynRecord); + procedure parseValue (pr: TTextParser); procedure parseBinValue (st: TStream); procedure writeTo (wr: TTextWriter); - procedure writeBinTo (st: TStream; curheader: TDynRecord); + procedure writeBinTo (st: TStream); // won't work for lists function isSimpleEqu (fld: TDynField): Boolean; + procedure setValue (const s: AnsiString); + public property pasname: AnsiString read mPasName; property name: AnsiString read mName; property baseType: TType read mType; property defined: Boolean read mDefined write mDefined; property internal: Boolean read mInternal write mInternal; - //property ival: Integer read mIVal write setIVal; - //property sval: AnsiString read mSVal write setSVal; - property list: TDynRecordArray read mRVal write mRVal; + property ival: Integer read mIVal; + property sval: AnsiString read mSVal; + //property list: TDynRecordArray read mRVal write mRVal; property maxdim: Integer read mMaxDim; // for fixed-size arrays property binOfs: Integer read mBinOfs; // offset in binary; <0 - none property recOfs: Integer read mRecOfs; // offset in record; <0 - none property hasDefault: Boolean read mHasDefault; - property defsval: AnsiString read mDefSVal write mDefSVal; - property ebstype: TEBS read mEBS write mEBS; - property ebstypename: AnsiString read mEBSTypeName write mEBSTypeName; // enum/bitset name + property defsval: AnsiString read mDefSVal; + property ebstype: TEBS read mEBS; + property ebstypename: AnsiString read mEBSTypeName; // enum/bitset name property x: Integer read mIVal; property w: Integer read mIVal; @@ -141,6 +146,7 @@ type mTrigTypes: array of AnsiString; // if this is triggerdata, we'll hold list of triggers here mHeader: Boolean; // true for header record mBinBlock: Integer; // -1: none + mHeaderRec: TDynRecord; // for "value" records this is header record with data, for "type" records this is header type record private procedure parseDef (pr: TTextParser); // parse definition @@ -152,6 +158,11 @@ type function getIsTrigData (): Boolean; inline; function getIsForTrig (const aname: AnsiString): Boolean; inline; + protected + function findRecordByTypeId (const atypename, aid: AnsiString): TDynRecord; + function findRecordNumByType (const atypename: AnsiString; rc: TDynRecord): Integer; + procedure addRecordByType (const atypename: AnsiString; rc: TDynRecord); + public constructor Create (); constructor Create (pr: TTextParser); // parse definition @@ -161,11 +172,11 @@ type function clone (): TDynRecord; - procedure parseValue (pr: TTextParser; curheader: TDynRecord); + procedure parseValue (pr: TTextParser); procedure parseBinValue (st: TStream); procedure writeTo (wr: TTextWriter; putHeader: Boolean=true); - procedure writeBinTo (st: TStream; curheader: TDynRecord; trigbufsz: Integer=-1); + procedure writeBinTo (st: TStream; trigbufsz: Integer=-1); public property id: AnsiString read mId; // for map parser @@ -214,11 +225,6 @@ type TDynMapDef = class - private - procedure addRecordByType (const atypename: AnsiString; rc: TDynRecord; curheader: TDynRecord); - function findRecordByTypeId (const atypename, aid: AnsiString; curheader: TDynRecord): TDynRecord; - function findRecordNumByType (const atypename: AnsiString; rc: TDynRecord; curheader: TDynRecord): Integer; - public recTypes: array of TDynRecord; // [0] is always header trigTypes: array of TDynRecord; // trigdata @@ -298,13 +304,16 @@ begin mDefined := false; mOmitDef := false; mInternal := true; + mDefUnparsed := ''; mDefSVal := ''; + mDefIVal := 0; + mDefIVal2 := 0; + mDefRecRef := nil; mEBS := TEBS.TNone; mEBSTypeName := ''; mBitSetUnique := false; mNegBool := false; mDefId := ''; - mDefaultValueSet := false; end; @@ -332,13 +341,16 @@ begin result.mHasDefault := mHasDefault; result.mOmitDef := mOmitDef; result.mInternal := mInternal; + result.mDefUnparsed := mDefUnparsed; result.mDefSVal := mDefSVal; + result.mDefIVal := mDefIVal; + result.mDefIVal2 := mDefIVal2; + result.mDefRecRef := mDefRecRef; result.mEBS := mEBS; result.mEBSTypeName := mEBSTypeName; result.mBitSetUnique := mBitSetUnique; result.mNegBool := mNegBool; result.mDefId := mDefId; - result.mDefaultValueSet := mDefaultValueSet; end; @@ -367,69 +379,104 @@ begin end; -procedure TDynField.fixDefaultValue (); +procedure TDynField.setValue (const s: AnsiString); var stp: TTextParser; - s: AnsiString; begin - if not mDefined then + stp := TStrTextParser.Create(s+';'); + try + parseValue(stp); + finally + stp.Free(); + end; +end; + + +procedure TDynField.parseDefaultValue (); +var + stp: TTextParser = nil; + oSVal: AnsiString; + oIVal, oIVal2: Integer; + oRRef: TDynRecord; + oDef: Boolean; +begin + if not mHasDefault then begin - if not mHasDefault then - begin - if mInternal then exit; - raise Exception.Create(Format('field ''%s'' in record ''%s'' of record type ''%s'' is not set', [mName, mOwner.mId, mOwner.mName])); - end; - if (mEBS = TEBS.TRec) then - begin - if (CompareText(mDefSVal, 'null') <> 0) then raise Exception.Create(Format('field ''%s'' in record ''%s'' of record type ''%s'' has non-null default value ''%s''', [mName, mOwner.mId, mOwner.mName, mDefSVal])); - mDefined := true; - assert(mRecRef = nil); - mDefaultValueSet := true; - exit; - end; - s := ''; - case mType of - TType.TChar, TType.TString: s := TTextParser.quote(mDefSVal)+';'; - TType.TPoint, TType.TSize: assert(false); // no default values for these types yet - else s := mDefSVal+';'; - end; - //mDefined := true; - //writeln('DEFAULT for <', mName, '>: <', s, '>'); - stp := TStrTextParser.Create(s); + mDefSVal := ''; + mDefIVal := 0; + mDefIVal2 := 0; + mDefRecRef := nil; + end + else + begin + oSVal := mSVal; + oIVal := mIVal; + oIVal2 := mIVal2; + oRRef := mRecRef; + oDef := mDefined; try - parseValue(stp, nil); + stp := TStrTextParser.Create(mDefUnparsed+';'); + parseValue(stp); + mDefSVal := mSVal; + mDefIVal := mIVal; + mDefIVal2 := mIVal2; + mDefRecRef := mRecRef; finally + mSVal := oSVal; + mIVal := oIVal; + mIVal2 := oIVal2; + mRecRef := oRRef; + mDefined := oDef; stp.Free(); end; - assert(mDefined); - mDefaultValueSet := true; end; end; +// default value should be parsed +procedure TDynField.fixDefaultValue (); +begin + if mDefined then exit; + if not mHasDefault then + begin + if mInternal then exit; + raise Exception.Create(Format('field ''%s'' in record ''%s'' of record type ''%s'' is not set', [mName, mOwner.mId, mOwner.mName])); + end; + if (mEBS = TEBS.TRec) then + begin + mRecRef := mDefRecRef; + { + if (mDefRecRef <> nil) then + begin + rec := mDefRecRef.clone(); + rec.mHeaderRec := mOwner.mHeaderRec; + try + mOwner.addRecordByType(mEBSTypeName, rec); + mRecRef := rec; + rec := nil; + finally + rec.Free(); + end; + end; + } + end; + mSVal := mDefSVal; + mIVal := mDefIVal; + mIVal2 := mDefIVal2; + mDefined := true; +end; + + +// default value should be parsed function TDynField.isDefaultValue (): Boolean; -var - fld: TDynField = nil; - stp: TTextParser = nil; - s: AnsiString; begin if not mHasDefault then begin result := false; exit; end; - //result := mDefaultValueSet; - if (mEBS = TEBS.TRec) then begin result := (mRecRef = nil); exit; end; - s := ''; + if (mEBS = TEBS.TRec) then begin result := (mRecRef = mDefRecRef); exit; end; case mType of - TType.TChar, TType.TString: s := TTextParser.quote(mDefSVal)+';'; - TType.TPoint, TType.TSize: begin result := false; exit; end; // no default values for these types yet - else s := mDefSVal+';'; - end; - stp := TStrTextParser.Create(s); - try - fld := clone(); - fld.parseValue(stp, nil); - result := isSimpleEqu(fld); - finally - fld.Free(); - stp.Free(); + TType.TChar, TType.TString: result := (mSVal = mDefSVal); + TType.TPoint, TType.TSize: result := (mIVal = mDefIVal2) and (mIVal2 = mDefIVal2); + TType.TList, TType.TTrigData: result := false; // no default values for those types + else result := (mIVal = mDefIVal); end; end; @@ -467,25 +514,7 @@ begin TEBS.TEnum: result += ' enum '+mEBSTypeName; TEBS.TBitSet: begin result += ' bitset '; if mBitSetUnique then result += 'unique '; result += mEBSTypeName; end; end; - if mHasDefault then - begin - if (mType = TType.TChar) or (mType = TType.TString) then result += ' default '+TTextParser.quote(mDefSVal) - else if (Length(mDefSVal) > 0) then result += ' default '+mDefSVal; - { - else - begin - if (mType = TType.TBool) then - begin - result += ' default '; - if (mDefIVal <> 0) then result += 'true' else result += 'false'; - end - else - begin - result += Format(' default %d', [mDefIVal]); - end; - end; - } - end; + if mHasDefault and (Length(mDefUnparsed) > 0) then result += ' default '+mDefUnparsed; if mSepPosSize then begin if (mType = TType.TPoint) then begin if (mAsT) then result += ' as txy' else result += ' as xy'; end @@ -650,18 +679,9 @@ begin else if (fldtype = 'trigdata') then mType := TType.TTrigData else raise Exception.Create(Format('field ''%s'' has invalid type ''%s''', [fldname, fldtype])); - {if hasdefId and (self.baseType = self.TType.TBool) then - begin - if (defstr = 'true') or (defstr = 'tan') or (defstr = 'yes') then self.mDefIVal := 1 - else if (defstr = 'false') or (defstr = 'ona') or (defstr = 'no') then self.mDefIVal := 0 - else raise Exception.Create(Format('field ''%s'' has invalid boolean default ''%s''', [fldname, defstr])); - end - else} - begin - if hasdefStr then self.mDefSVal := defstr - else if hasdefInt then self.mDefSVal := Format('%d', [defint]) - else if hasdefId then self.mDefSVal := defstr; - end; + if hasdefStr then self.mDefUnparsed := TTextParser.quote(defstr) + else if hasdefInt then self.mDefUnparsed := Format('%d', [defint]) + else if hasdefId then self.mDefUnparsed := defstr; self.mHasDefault := (hasdefStr or hasdefId or hasdefInt); self.mPasName := fldpasname; @@ -675,10 +695,12 @@ begin self.mAsT := ast; self.mOmitDef := omitdef; self.mInternal := ainternal; + + //if mHasDefault then parseDefaultValue(); end; -procedure TDynField.writeBinTo (st: TStream; curheader: TDynRecord); +procedure TDynField.writeBinTo (st: TStream); var s: AnsiString; f: Integer; @@ -690,7 +712,6 @@ begin TEBS.TNone: begin end; TEBS.TRec: begin - // this must be byte/word/int if (mMaxDim >= 0) then begin // this must be triggerdata @@ -711,7 +732,7 @@ begin if (mRecRef <> nil) then begin ws := TSFSMemoryChunkStream.Create(buf, mMaxDim); - mRecRef.writeBinTo(ws, curheader, mMaxDim); // as trigdata + mRecRef.writeBinTo(ws, mMaxDim); // as trigdata end; st.WriteBuffer(buf^, mMaxDim); finally @@ -741,7 +762,7 @@ begin else raise Exception.Create(Format('record reference type ''%s'' in field ''%s'' cannot be written', [mEBSTypeName, mName])); end; // find record number - f := mOwner.mOwner.findRecordNumByType(mEBSTypeName, mRecRef, curheader); + f := mOwner.findRecordNumByType(mEBSTypeName, mRecRef); if (f < 0) then raise Exception.Create(Format('record reference type ''%s'' in field ''%s'' not found in record list', [mEBSTypeName, mName])); if (f > maxv) then raise Exception.Create(Format('record reference type ''%s'' in field ''%s'' has too big index', [mEBSTypeName, mName])); case mType of @@ -774,9 +795,7 @@ begin else begin if (Length(mSVal) > mMaxDim) then raise Exception.Create(Format('invalid string size definition for field ''%s''', [mName])); - //FillChar(s[0], sizeof(s), 0); s := utfTo1251(mSVal); - //writeln('writing char[', mMaxDim, '] <', mName, '>: ', TTextParser.quote(s)); if (Length(s) > 0) then st.WriteBuffer(PChar(s)^, Length(s)); for f := Length(s) to mMaxDim do writeInt(st, Byte(0)); end; @@ -785,30 +804,22 @@ begin TType.TByte, TType.TUByte: begin - // either array, and this should be triggerdata, or byte - if (mMaxDim < 0) then - begin - // byte - writeInt(st, Byte(mIVal)); - end - else - begin - // array - raise Exception.Create(Format('byte array in field ''%s'' cannot be written', [mName])); - end; + // triggerdata array was processed earlier + if (mMaxDim >= 0) then Exception.Create(Format('byte array in field ''%s'' cannot be written', [mName])); + writeInt(st, Byte(mIVal)); exit; end; TType.TShort, TType.TUShort: begin - if (mMaxDim > 0) then raise Exception.Create(Format('short array in field ''%s'' cannot be written', [mName])); + if (mMaxDim >= 0) then raise Exception.Create(Format('short array in field ''%s'' cannot be written', [mName])); writeInt(st, Word(mIVal)); exit; end; TType.TInt, TType.TUInt: begin - if (mMaxDim > 0) then raise Exception.Create(Format('int array in field ''%s'' cannot be written', [mName])); + if (mMaxDim >= 0) then raise Exception.Create(Format('int array in field ''%s'' cannot be written', [mName])); writeInt(st, LongWord(mIVal)); exit; end; @@ -819,7 +830,7 @@ begin TType.TPoint, TType.TSize: begin - if (mMaxDim > 0) then raise Exception.Create(Format('pos/size array in field ''%s'' cannot be written', [mName])); + if (mMaxDim >= 0) then raise Exception.Create(Format('pos/size array in field ''%s'' cannot be written', [mName])); writeInt(st, Word(mIVal)); writeInt(st, Word(mIVal2)); exit; @@ -982,7 +993,7 @@ begin end; -procedure TDynField.parseValue (pr: TTextParser; curheader: TDynRecord); +procedure TDynField.parseValue (pr: TTextParser); procedure parseInt (min, max: Integer); begin @@ -993,7 +1004,6 @@ procedure TDynField.parseValue (pr: TTextParser; curheader: TDynRecord); var rec, rc: TDynRecord; - def: TDynMapDef; es: TDynEBS = nil; tfld: TDynField; tk: AnsiString; @@ -1003,7 +1013,6 @@ begin TEBS.TNone: begin end; TEBS.TRec: begin - def := mOwner.mOwner; // ugly hack. sorry. if (CompareText(mEBSTypeName, 'triggerdata') = 0) then begin @@ -1012,10 +1021,11 @@ begin tfld := rec.field['type']; if (tfld = nil) then raise Exception.Create(Format('triggerdata value for field ''%s'' in record ''%s'' without ''type'' field', [mName, rec.mName])); if (tfld.mEBS <> TEBS.TEnum) then raise Exception.Create(Format('triggerdata value for field ''%s'' in record ''%s'' with bad ''type'' field', [mName, rec.mName])); - rc := def.findTrigFor(tfld.mSVal); + rc := mOwner.mOwner.findTrigFor(tfld.mSVal); // find in mapdef if (rc = nil) then raise Exception.Create(Format('triggerdata definition for field ''%s'' in record ''%s'' with type ''%s'' not found', [mName, rec.mName, tfld.mSVal])); rc := rc.clone(); - rc.parseValue(pr, curheader); + rc.mHeaderRec := mOwner.mHeaderRec; + rc.parseValue(pr); mRecRef := rc; mDefined := true; exit; @@ -1023,23 +1033,31 @@ begin // other record types if (pr.tokType = pr.TTId) then begin - rec := def.findRecordByTypeId(mEBSTypeName, pr.tokStr, curheader); - if (rec = nil) then raise Exception.Create(Format('record ''%s'' (%s) value for field ''%s'' not found', [pr.tokStr, mEBSTypeName, mName])); - pr.expectId(); - mRecRef := rec; + if pr.eatId('null') then + begin + mRecRef := nil; + end + else + begin + rec := mOwner.findRecordByTypeId(mEBSTypeName, pr.tokStr); + if (rec = nil) then raise Exception.Create(Format('record ''%s'' (%s) value for field ''%s'' not found', [pr.tokStr, mEBSTypeName, mName])); + pr.expectId(); + mRecRef := rec; + end; mDefined := true; pr.expectTT(pr.TTSemi); exit; end else if (pr.tokType = pr.TTBegin) then begin - rec := def.findRecType(mEBSTypeName); + rec := mOwner.mOwner.findRecType(mEBSTypeName); // find in mapdef if (rec = nil) then raise Exception.Create(Format('record type ''%s'' for field ''%s'' not found', [mEBSTypeName, mName])); rc := rec.clone(); - rc.parseValue(pr, curheader); + rc.mHeaderRec := mOwner.mHeaderRec; + rc.parseValue(pr); mRecRef := rc; mDefined := true; - mOwner.mOwner.addRecordByType(mEBSTypeName, rc, curheader); + mOwner.addRecordByType(mEBSTypeName, rc); pr.eatTT(pr.TTSemi); // hack: allow (but don't require) semicolon after inline records exit; end; @@ -1047,8 +1065,7 @@ begin end; TEBS.TEnum: begin - def := mOwner.mOwner; - es := def.findEBSType(mEBSTypeName); + es := mOwner.mOwner.findEBSType(mEBSTypeName); // find in mapdef if (es = nil) then raise Exception.Create(Format('record enum type ''%s'' for field ''%s'' not found', [mEBSTypeName, mName])); tk := pr.expectId(); if not es.has[tk] then raise Exception.Create(Format('record enum value ''%s'' of type ''%s'' for field ''%s'' not found', [tk, mEBSTypeName, mName])); @@ -1061,8 +1078,7 @@ begin end; TEBS.TBitSet: begin - def := mOwner.mOwner; - es := def.findEBSType(mEBSTypeName); + es := mOwner.mOwner.findEBSType(mEBSTypeName); // find in mapdef if (es = nil) then raise Exception.Create(Format('record bitset type ''%s'' for field ''%s'' not found', [mEBSTypeName, mName])); mIVal := 0; while true do @@ -1214,6 +1230,7 @@ begin mFields := nil; mTrigTypes := nil; mHeader := false; + mHeaderRec := nil; mBinBlock := -1; parseDef(pr); end; @@ -1226,6 +1243,7 @@ begin mFields := nil; mTrigTypes := nil; mHeader := false; + mHeaderRec := nil; end; @@ -1234,6 +1252,7 @@ begin mName := ''; mFields := nil; mTrigTypes := nil; + mHeaderRec := nil; inherited; end; @@ -1292,6 +1311,7 @@ begin result.mName := mName; result.mSize := mSize; result.mHeader := mHeader; + result.mHeaderRec := mHeaderRec; result.mBinBlock := mBinBlock; SetLength(result.mFields, Length(mFields)); for f := 0 to High(mFields) do @@ -1304,6 +1324,66 @@ begin end; +function TDynRecord.findRecordByTypeId (const atypename, aid: AnsiString): TDynRecord; +var + fld: TDynField; + f: Integer; +begin + result := nil; + if (Length(aid) = 0) then exit; + // find record data + fld := mHeaderRec.field[atypename]; + if (fld = nil) then exit; + if (fld.mType <> fld.TType.TList) then raise Exception.Create(Format('cannot get record of type ''%s'' due to name conflict with ordinary field', [atypename])); + // find by id + for f := 0 to High(fld.mRVal) do + begin + if (CompareText(fld.mRVal[f].mId, aid) = 0) then begin result := fld.mRVal[f]; exit; end; + end; + // alas +end; + + +function TDynRecord.findRecordNumByType (const atypename: AnsiString; rc: TDynRecord): Integer; +var + fld: TDynField; + f: Integer; +begin + result := -1; + // find record data + fld := mHeaderRec.field[atypename]; + if (fld = nil) then exit; + if (fld.mType <> fld.TType.TList) then raise Exception.Create(Format('cannot get record of type ''%s'' due to name conflict with ordinary field', [atypename])); + // find by ref + for f := 0 to High(fld.mRVal) do + begin + if (fld.mRVal[f] = rc) then begin result := f; exit; end; + end; + // alas +end; + + +procedure TDynRecord.addRecordByType (const atypename: AnsiString; rc: TDynRecord); +var + fld: TDynField; +begin + // find record data + fld := mHeaderRec.field[atypename]; + if (fld = nil) then + begin + // first record + fld := TDynField.Create(atypename, TDynField.TType.TList); + fld.mOwner := mHeaderRec; + SetLength(mHeaderRec.mFields, Length(mHeaderRec.mFields)+1); + mHeaderRec.mFields[High(mHeaderRec.mFields)] := fld; + end; + if (fld.mType <> fld.TType.TList) then raise Exception.Create(Format('cannot append record of type ''%s'' due to name conflict with ordinary field', [atypename])); + // append + SetLength(fld.mRVal, Length(fld.mRVal)+1); + fld.mRVal[High(fld.mRVal)] := rc; +end; + + procedure TDynRecord.parseDef (pr: TTextParser); var fld: TDynField; @@ -1415,7 +1495,7 @@ begin end; -procedure TDynRecord.writeBinTo (st: TStream; curheader: TDynRecord; trigbufsz: Integer=-1); +procedure TDynRecord.writeBinTo (st: TStream; trigbufsz: Integer=-1); var fld: TDynField; rec: TDynRecord; @@ -1424,8 +1504,8 @@ var blk, blkmax: Integer; f, c: Integer; bufsz: Integer = 0; + blksz: Integer; begin - if (curheader = nil) and mHeader then curheader := self; if (trigbufsz < 0) then begin if (mBinBlock < 1) then raise Exception.Create('cannot write binary record without block number'); @@ -1451,8 +1531,8 @@ begin if (fld.mBinOfs < 0) then continue; if (fld.mBinOfs >= bufsz) then raise Exception.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, curheader); + //writeln('writing field <', fld.mName, '>'); + fld.writeBinTo(ws); end; // write block with normal fields @@ -1505,17 +1585,18 @@ begin if (rec.mBinBlock <> blk) then continue; if (ws = nil) then ws := TMemoryStream.Create(); //rec.writeBinTo(ws); - for c := 0 to High(fld.mRVal) do fld.mRVal[c].writeBinTo(ws, curheader); + for c := 0 to High(fld.mRVal) do fld.mRVal[c].writeBinTo(ws); end; end; // flush block if (ws <> nil) then begin + blksz := Integer(ws.position); ws.position := 0; writeInt(st, Byte(blk)); // type writeInt(st, LongWord(0)); // reserved - writeInt(st, LongWord(ws.size)); // size - st.CopyFrom(ws, ws.size); + writeInt(st, LongWord(blksz)); // size + st.CopyFrom(ws, blksz); ws.Free(); ws := nil; end; @@ -1551,6 +1632,7 @@ begin if not mHeader then raise Exception.Create('record list in non-header record'); for c := 0 to High(fld.mRVal) do begin + if (Length(fld.mRVal[c].mId) = 0) then continue; wr.putIndent(); fld.mRVal[c].writeTo(wr, true); end; @@ -1569,7 +1651,7 @@ begin end; -procedure TDynRecord.parseValue (pr: TTextParser; curheader: TDynRecord); +procedure TDynRecord.parseValue (pr: TTextParser); var f, c: Integer; fld: TDynField; @@ -1579,13 +1661,17 @@ begin if (mOwner = nil) then raise Exception.Create(Format('can''t parse record ''%s'' value without owner', [mName])); // not a header? - if (curheader <> self) then + if not mHeader then begin // id? if (pr.tokType = pr.TTId) then mId := pr.expectId(); + end + else + begin + assert(mHeaderRec = self); end; - writeln('parsing record <', mName, '>'); + //writeln('parsing record <', mName, '>'); pr.expectTT(pr.TTBegin); while (pr.tokType <> pr.TTEnd) do begin @@ -1593,16 +1679,17 @@ begin //writeln('<', pr.tokStr, ':', asheader, '>'); // records - if (curheader = self) then + if mHeader then begin // add records with this type (if any) trc := mOwner.findRecType(pr.tokStr); if (trc <> nil) then begin rec := trc.clone(); + rec.mHeaderRec := mHeaderRec; try pr.skipToken(); - rec.parseValue(pr, curheader); + rec.parseValue(pr); if (Length(rec.mId) > 0) then begin fld := field[pr.tokStr]; @@ -1614,7 +1701,7 @@ begin end; end; end; - mOwner.addRecordByType(rec.mName, rec, curheader); + addRecordByType(rec.mName, rec); rec := nil; finally rec.Free(); @@ -1630,7 +1717,7 @@ begin if fld.defined then raise Exception.Create(Format('duplicate field ''%s'' in record ''%s''', [fld.mName, mName])); if fld.internal then raise Exception.Create(Format('internal field ''%s'' in record ''%s''', [fld.mName, mName])); pr.skipToken(); - fld.parseValue(pr, curheader); + fld.parseValue(pr); continue; end; @@ -1640,7 +1727,7 @@ begin pr.expectTT(pr.TTEnd); // fix field defaults for f := 0 to High(mFields) do mFields[f].fixDefaultValue(); - writeln('done parsing record <', mName, '>'); + //writeln('done parsing record <', mName, '>'); end; @@ -1876,98 +1963,11 @@ begin end; -function TDynMapDef.findRecordByTypeId (const atypename, aid: AnsiString; curheader: TDynRecord): TDynRecord; -var - rec: TDynRecord; - fld: TDynField; - f: Integer; -begin - result := nil; - // find record type - if (curheader = nil) then exit; - //writeln('searching for type <', atypename, '>'); - rec := findRecType(atypename); - if (rec = nil) then exit; - // find record data - //writeln('searching for data of type <', atypename, '>'); - fld := curheader.field[atypename]; - if (fld = nil) then exit; - if (fld.mType <> fld.TType.TList) then exit; - // find by id - //writeln('searching for data of type <', atypename, '> with id <', aid, '> (', Length(fld.mRVal), ')'); - for f := 0 to High(fld.mRVal) do - begin - if (CompareText(fld.mRVal[f].mId, aid) = 0) then - begin - //writeln(' FOUND!'); - result := fld.mRVal[f]; - exit; - end; - end; - // alas -end; - - -procedure TDynMapDef.addRecordByType (const atypename: AnsiString; rc: TDynRecord; curheader: TDynRecord); -var - rec: TDynRecord; - fld: TDynField; -begin - assert(curheader <> nil); - // find record type - rec := findRecType(atypename); - assert(rec <> nil); - // find record data - //writeln('searching for data of type <', atypename, '>'); - fld := curheader.field[atypename]; - if (fld = nil) then - begin - // first record - fld := TDynField.Create(atypename, TDynField.TType.TList); - fld.mOwner := curheader; - SetLength(curheader.mFields, Length(curheader.mFields)+1); - curheader.mFields[High(curheader.mFields)] := fld; - end; - if (fld.mType <> fld.TType.TList) then exit; - // add - SetLength(fld.mRVal, Length(fld.mRVal)+1); - fld.mRVal[High(fld.mRVal)] := rc; -end; - - -function TDynMapDef.findRecordNumByType (const atypename: AnsiString; rc: TDynRecord; curheader: TDynRecord): Integer; -var - rec: TDynRecord; - fld: TDynField; - f: Integer; -begin - result := -1; - if (curheader = nil) then exit; - // find record type - rec := findRecType(atypename); - if (rec = nil) then exit; - // find record data - fld := curheader.field[atypename]; - if (fld = nil) then exit; - if (fld.mType <> fld.TType.TList) then exit; - // find by ref - for f := 0 to High(fld.mRVal) do - begin - if (fld.mRVal[f] = rc) then - begin - result := f; - exit; - end; - end; - // alas -end; - - procedure TDynMapDef.parseDef (pr: TTextParser); var dr, hdr: TDynRecord; eb: TDynEBS; - f: Integer; + f, c: Integer; begin hdr := nil; while true do @@ -2025,10 +2025,23 @@ begin end; end; + // put header record to top if (hdr = nil) then raise Exception.Create('header definition not found in mapdef'); SetLength(recTypes, Length(recTypes)+1); for f := High(recTypes) downto 1 do recTypes[f] := recTypes[f-1]; recTypes[0] := hdr; + + // setup header links + for f := 0 to High(recTypes) do recTypes[f].mHeaderRec := recTypes[0]; + + // setup default values + for f := 0 to High(recTypes) do + begin + for c := 0 to High(recTypes[f].mFields) do + begin + if recTypes[f].mFields[c].mHasDefault then recTypes[f].mFields[c].parseDefaultValue(); + end; + end; end; @@ -2041,7 +2054,8 @@ begin try pr.expectId(headerType.name); res := headerType.clone(); - res.parseValue(pr, res); + res.mHeaderRec := res; + res.parseValue(pr); result := res; res := nil; except on E: Exception do -- 2.29.2