X-Git-Url: http://deadsoftware.ru/gitweb?a=blobdiff_plain;ds=sidebyside;f=src%2Fshared%2Fxdynrec.pas;h=968e8b6abc39c857159ea07d807a3048e58bb38e;hb=981037c01006b8a8bea65b69a75ba9f7353b295d;hp=f3400d87730d0594b176a233c5d5913558c5be21;hpb=bfebb0f03424f28d5241607f5d927c5b4c460ebe;p=d2df-sdl.git diff --git a/src/shared/xdynrec.pas b/src/shared/xdynrec.pas index f3400d8..968e8b6 100644 --- a/src/shared/xdynrec.pas +++ b/src/shared/xdynrec.pas @@ -19,7 +19,8 @@ unit xdynrec; interface uses - xparser; + Classes, + xparser, xstreams; // ////////////////////////////////////////////////////////////////////////// // @@ -35,7 +36,7 @@ type // TPoint: pair of Shorts // TSize: pair of UShorts // TList: actually, array of records - // TTrigData: array of bytes + // TTrigData: array of mMaxDim bytes, but internally a record (mRecRef) // arrays of chars are pascal shortstrings (with counter in the first byte) type @@ -55,24 +56,26 @@ type mIVal2: Integer; // for point and size mSVal: AnsiString; // string; for byte and char arrays mRVal: TDynRecordArray; // for list - mRecRef: TDynRecord; // for record - mRecRefOwned: Boolean; // was mRecRef created from inline definition? - mMaxDim: Integer; // for byte and char arrays; <0: not an array + mRecRef: TDynRecord; // for TEBS.TRec + 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; - // default values - mDefSVal: AnsiString; - mEBS: TEBS; - mEBSName: AnsiString; // name of enum, bitset or record - mBitSetUnique: Boolean; // bitset can contain only one value mNegBool: Boolean; + mBitSetUnique: Boolean; // bitset can contain only one value + // default value + 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 + mEBSType: TObject; // either TDynRecord or TDynEBS; nil means "simple type"; nil for `TTrigData` too // temp mDefId: AnsiString; @@ -82,10 +85,8 @@ type procedure parseDef (pr: TTextParser); - procedure setIVal (v: Integer); inline; - procedure setSVal (const v: AnsiString); inline; - - procedure fixDefaultValue (); + procedure parseDefaultValue (); // parse `mDefUnparsed` to `mDefSVal`, `mDefIVal`, `mDefIVal2`, `mDefRecRef` + procedure fixDefaultValue (); // this will NOT clone `mDefRecRef` function isDefaultValue (): Boolean; public @@ -100,28 +101,33 @@ type function clone (): TDynField; procedure parseValue (pr: TTextParser); + procedure parseBinValue (st: TStream); procedure writeTo (wr: TTextWriter); + 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 ebs: TEBS read mEBS write mEBS; - property ebsname: AnsiString read mEBSName write mEBSName; // enum/bitset name + property defsval: AnsiString read mDefSVal; + property ebs: TEBS read mEBS; + property ebstype: TObject read mEBSType; + property ebstypename: AnsiString read mEBSTypeName; // enum/bitset name property x: Integer read mIVal; property w: Integer read mIVal; @@ -130,6 +136,7 @@ type end; + // "value" header record contains TList fields, with name equal to record type TDynRecord = class private mOwner: TDynMapDef; @@ -141,6 +148,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 +160,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,9 +174,13 @@ type function clone (): TDynRecord; - procedure parseValue (pr: TTextParser; asheader: Boolean=false); + function isSimpleEqu (rec: TDynRecord): Boolean; + + procedure parseValue (pr: TTextParser; beginEaten: Boolean=false); + procedure parseBinValue (st: TStream); procedure writeTo (wr: TTextWriter; putHeader: Boolean=true); + procedure writeBinTo (st: TStream; trigbufsz: Integer=-1); public property id: AnsiString read mId; // for map parser @@ -212,41 +229,40 @@ type TDynMapDef = class - private - curheader: TDynRecord; // for parser - - private - function findRecordById (const atypename, aid: AnsiString): TDynRecord; - public - records: array of TDynRecord; // [0] is always header - trigDatas: array of TDynRecord; - ebs: array of TDynEBS; + recTypes: array of TDynRecord; // [0] is always header + trigTypes: array of TDynRecord; // trigdata + ebsTypes: array of TDynEBS; // enums, bitsets private procedure parseDef (pr: TTextParser); - function getHeader (): TDynRecord; inline; + function getHeaderRecType (): TDynRecord; inline; public - constructor Create (pr: TTextParser); + constructor Create (pr: TTextParser); // parses data definition destructor Destroy (); override; - function findRec (const aname: AnsiString): TDynRecord; - function findTrigDataFor (const aname: AnsiString): TDynRecord; - function findEBS (const aname: AnsiString): TDynEBS; + function findRecType (const aname: AnsiString): TDynRecord; + function findTrigFor (const aname: AnsiString): TDynRecord; + function findEBSType (const aname: AnsiString): TDynEBS; + // creates new header record function parseMap (pr: TTextParser): TDynRecord; + // creates new header record + function parseBinMap (st: TStream): TDynRecord; + public - property header: TDynRecord read getHeader; + property headerType: TDynRecord read getHeaderRecType; end; implementation uses - SysUtils; + SysUtils, + utils; // ////////////////////////////////////////////////////////////////////////// // @@ -254,7 +270,6 @@ constructor TDynField.Create (const aname: AnsiString; atype: TType); begin mRVal := nil; mRecRef := nil; - mRecRefOwned := false; cleanup(); mName := aname; mType := atype; @@ -283,9 +298,7 @@ begin mIVal2 := 0; mSVal := ''; mRVal := nil; - if mRecRefOwned then mRecRef.Free(); mRecRef := nil; - mRecRefOwned := false; mMaxDim := -1; mBinOfs := -1; mRecOfs := -1; @@ -295,13 +308,17 @@ begin mDefined := false; mOmitDef := false; mInternal := true; + mDefUnparsed := ''; mDefSVal := ''; + mDefIVal := 0; + mDefIVal2 := 0; + mDefRecRef := nil; mEBS := TEBS.TNone; - mEBSName := ''; + mEBSTypeName := ''; + mEBSType := nil; mBitSetUnique := false; mNegBool := false; mDefId := ''; - mDefaultValueSet := false; end; @@ -319,15 +336,7 @@ begin result.mSVal := mSVal; SetLength(result.mRVal, Length(mRVal)); for f := 0 to High(mRVal) do result.mRVal[f] := mRVal[f].clone(); - result.mRecRefOwned := mRecRefOwned; - if mRecRefOwned then - begin - if (mRecRef <> nil) then result.mRecRef := mRecRef.clone(); - end - else - begin - result.mRecRef := mRecRef; - end; + result.mRecRef := mRecRef; result.mMaxDim := mMaxDim; result.mBinOfs := mBinOfs; result.mRecOfs := mRecOfs; @@ -337,20 +346,20 @@ begin result.mHasDefault := mHasDefault; result.mOmitDef := mOmitDef; result.mInternal := mInternal; + result.mNegBool := mNegBool; + result.mBitSetUnique := mBitSetUnique; + result.mDefUnparsed := mDefUnparsed; result.mDefSVal := mDefSVal; + result.mDefIVal := mDefIVal; + result.mDefIVal2 := mDefIVal2; + result.mDefRecRef := mDefRecRef; result.mEBS := mEBS; - result.mEBSName := mEBSName; - result.mBitSetUnique := mBitSetUnique; - result.mNegBool := mNegBool; + result.mEBSTypeName := mEBSTypeName; + result.mEBSType := mEBSType; result.mDefId := mDefId; - result.mDefaultValueSet := mDefaultValueSet; end; -procedure TDynField.setIVal (v: Integer); inline; begin mIVal := v; mDefined := true; end; -procedure TDynField.setSVal (const v: AnsiString); inline; begin mSVal := v; mDefined := true; end; - - // won't work for lists function TDynField.isSimpleEqu (fld: TDynField): Boolean; begin @@ -370,75 +379,114 @@ begin TType.TSize: result := ((mIVal = fld.mIVal) and (mIVal2 = fld.mIVal2)); TType.TList: result := false; - TType.TTrigData: result := false; + TType.TTrigData: + begin + if (mRecRef = nil) then begin result := (fld.mRecRef = nil); exit; end; + result := mRecRef.isSimpleEqu(fld.mRecRef); + end; else raise Exception.Create('ketmar forgot to handle some field type'); end; 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 + 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); - 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; @@ -466,35 +514,17 @@ end; function TDynField.definition (): AnsiString; begin - result := mPasName+' is '+TTextParser.quote(mName)+' type '; + result := mPasName+' is '+quoteStr(mName)+' type '; result += getTypeName(mType); if (mMaxDim >= 0) then result += Format('[%d]', [mMaxDim]); if (mRecOfs >= 0) then result += Format(' offset %d', [mRecOfs]); case mEBS of TEBS.TNone: begin end; - TEBS.TRec: result += ' '+mEBSName; - TEBS.TEnum: result += ' enum '+mEBSName; - TEBS.TBitSet: begin result += ' bitset '; if mBitSetUnique then result += 'unique '; result += mEBSName; 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; - } + TEBS.TRec: result += ' '+mEBSTypeName; + TEBS.TEnum: result += ' enum '+mEBSTypeName; + TEBS.TBitSet: begin result += ' bitset '; if mBitSetUnique then result += 'unique '; result += mEBSTypeName; 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 @@ -555,7 +585,7 @@ begin if pr.eatDelim('[') then begin lmaxdim := pr.expectInt(); - if (lmaxdim < 1) then raise Exception.Create(Format('invali field ''%s'' array size', [fldname])); + if (lmaxdim < 1) then raise Exception.Create(Format('invalid field ''%s'' array size', [fldname])); pr.expectDelim(']'); end; @@ -659,23 +689,22 @@ 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} + if (lmaxdim > 0) and (mType <> TType.TChar) and (mType <> TType.TTrigData) then raise Exception.Create(Format('field ''%s'' of type ''%s'' cannot be array', [fldname, fldtype])); + if (mType = TType.TTrigData) then begin - if hasdefStr then self.mDefSVal := defstr - else if hasdefInt then self.mDefSVal := Format('%d', [defint]) - else if hasdefId then self.mDefSVal := defstr; + if (lmaxdim < 1) then raise Exception.Create(Format('field ''%s'' of type ''%s'' cannot be array', [fldname, fldtype])); + if (Length(fldrecname) > 0) then raise Exception.Create(Format('field ''%s'' of type ''%s'' cannot have another type', [fldname, fldtype])); + lebs := TDynField.TEBS.TRec; end; + if hasdefStr then self.mDefUnparsed := quoteStr(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; self.mEBS := lebs; - self.mEBSName := fldrecname; + self.mEBSTypeName := fldrecname; self.mBitSetUnique := unique; self.mMaxDim := lmaxdim; self.mBinOfs := fldofs; @@ -687,25 +716,169 @@ begin end; +procedure TDynField.writeBinTo (st: TStream); +var + s: AnsiString; + f: Integer; + maxv: Integer; + buf: PByte; + ws: TStream = nil; +begin + case mEBS of + TEBS.TNone: begin end; + TEBS.TRec: + begin + if (mMaxDim >= 0) then + begin + // this must be triggerdata + if (mType <> TType.TTrigData) then + begin + raise Exception.Create(Format('record reference type ''%s'' in field ''%s'' cannot be written', [mEBSTypeName, mName])); + end; + // write triggerdata + GetMem(buf, mMaxDim); + if (buf = nil) then raise Exception.Create(Format('record reference type ''%s'' in field ''%s'' cannot be written', [mEBSTypeName, mName])); + try + FillChar(buf^, mMaxDim, 0); + if (mRecRef <> nil) then + begin + ws := TSFSMemoryChunkStream.Create(buf, mMaxDim); + mRecRef.writeBinTo(ws, mMaxDim); // as trigdata + end; + st.WriteBuffer(buf^, mMaxDim); + finally + ws.Free(); + if (buf <> nil) then FreeMem(buf); + end; + exit; + end; + // record reference + if (mRecRef = nil) then + begin + // no ref, write -1 + case mType of + TType.TByte, TType.TUByte: writeInt(st, Byte(-1)); + TType.TShort, TType.TUShort: writeInt(st, SmallInt(-1)); + TType.TInt, TType.TUInt: writeInt(st, Integer(-1)); + else raise Exception.Create(Format('record reference type ''%s'' in field ''%s'' cannot be written', [mEBSTypeName, mName])); + end; + exit; + end; + case mType of + TType.TByte: maxv := 127; + TType.TUByte: maxv := 254; + TType.TShort: maxv := 32767; + TType.TUShort: maxv := 65534; + TType.TInt: maxv := $7fffffff; + TType.TUInt: maxv := $7fffffff; + else raise Exception.Create(Format('record reference type ''%s'' in field ''%s'' cannot be written', [mEBSTypeName, mName])); + end; + // find record number + 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 + TType.TByte, TType.TUByte: writeInt(st, Byte(f)); + TType.TShort, TType.TUShort: writeInt(st, SmallInt(f)); + TType.TInt, TType.TUInt: writeInt(st, Integer(f)); + else raise Exception.Create(Format('record reference type ''%s'' in field ''%s'' cannot be written', [mEBSTypeName, mName])); + end; + exit; + end; + TEBS.TEnum: begin end; + TEBS.TBitSet: begin end; + else raise Exception.Create('ketmar forgot to handle some EBS type'); + end; + + case mType of + TType.TBool: + begin + if (mIVal <> 0) then writeInt(st, Byte(1)) else writeInt(st, Byte(0)); + exit; + end; + TType.TChar: + begin + if (mMaxDim = 0) then raise Exception.Create(Format('invalid string size definition for field ''%s''', [mName])); + if (mMaxDim < 0) then + begin + if (Length(mSVal) <> 1) then raise Exception.Create(Format('invalid string size definition for field ''%s''', [mName])); + writeInt(st, Byte(mSVal[1])); + end + else + begin + if (Length(mSVal) > mMaxDim) then raise Exception.Create(Format('invalid string size definition for field ''%s''', [mName])); + s := utf2win(mSVal); + if (Length(s) > 0) then st.WriteBuffer(PChar(s)^, Length(s)); + for f := Length(s) to mMaxDim do writeInt(st, Byte(0)); + end; + exit; + end; + TType.TByte, + TType.TUByte: + begin + // 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])); + 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])); + writeInt(st, LongWord(mIVal)); + exit; + end; + TType.TString: + begin + raise Exception.Create(Format('cannot write string field ''%s''', [mName])); + end; + TType.TPoint, + TType.TSize: + begin + 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; + end; + TType.TList: + begin + assert(false); + exit; + end; + TType.TTrigData: + begin + assert(false); + exit; + end; + else raise Exception.Create('ketmar forgot to handle some field type'); + end; +end; + + procedure TDynField.writeTo (wr: TTextWriter); var - def: TDynMapDef; es: TDynEBS = nil; f, mask: Integer; first, found: Boolean; begin wr.put(mName); wr.put(' '); - // if this field should contain struct, convert type and parse struct case mEBS of TEBS.TNone: begin end; TEBS.TRec: begin if (mRecRef = nil) then begin - wr.put('null;'#10); + if (mType = TType.TTrigData) then wr.put('{}'#10) else wr.put('null;'#10); end - else if mRecRefOwned then + else if (Length(mRecRef.mId) = 0) then begin mRecRef.writeTo(wr, false); // only data, no header end @@ -718,9 +891,11 @@ begin end; TEBS.TEnum: begin - def := mOwner.mOwner; - es := def.findEBS(mEBSName); - if (es = nil) then raise Exception.Create(Format('record enum type ''%s'' for field ''%s'' not found', [mEBSName, mName])); + //def := mOwner.mOwner; + //es := def.findEBSType(mEBSTypeName); + es := nil; + if (mEBSType <> nil) and (mEBSType is TDynEBS) then es := (mEBSType as TDynEBS); + if (es = nil) or (not es.mIsEnum) then raise Exception.Create(Format('record enum type ''%s'' for field ''%s'' not found', [mEBSTypeName, mName])); for f := 0 to High(es.mVals) do begin if (es.mVals[f] = mIVal) then @@ -730,13 +905,15 @@ begin exit; end; end; - raise Exception.Create(Format('value %d in record enum type ''%s'' for field ''%s'' not found', [mIVal, mEBSName, mName])); + raise Exception.Create(Format('value %d in record enum type ''%s'' for field ''%s'' not found', [mIVal, mEBSTypeName, mName])); end; TEBS.TBitSet: begin - def := mOwner.mOwner; - es := def.findEBS(mEBSName); - if (es = nil) then raise Exception.Create(Format('record bitset type ''%s'' for field ''%s'' not found', [mEBSName, mName])); + //def := mOwner.mOwner; + //es := def.findEBSType(mEBSTypeName); + es := nil; + if (mEBSType <> nil) and (mEBSType is TDynEBS) then es := (mEBSType as TDynEBS); + if (es = nil) or es.mIsEnum then raise Exception.Create(Format('record bitset type ''%s'' for field ''%s'' not found', [mEBSTypeName, mName])); // none? if (mIVal = 0) then begin @@ -749,7 +926,7 @@ begin exit; end; end; - raise Exception.Create(Format('value %d in record bitset type ''%s'' for field ''%s'' not found', [0, mEBSName, mName])); + raise Exception.Create(Format('value %d in record bitset type ''%s'' for field ''%s'' not found', [0, mEBSTypeName, mName])); end; // not none mask := 1; @@ -769,7 +946,7 @@ begin break; end; end; - if not found then raise Exception.Create(Format('value %d in record bitset type ''%s'' for field ''%s'' not found', [mask, mEBSName, mName])); + if not found then raise Exception.Create(Format('value %d in record bitset type ''%s'' for field ''%s'' not found', [mask, mEBSTypeName, mName])); end; mask := mask shl 1; end; @@ -788,7 +965,7 @@ begin TType.TChar: begin if (mMaxDim = 0) then raise Exception.Create(Format('invalid string size definition for field ''%s''', [mName])); - wr.put(TTextParser.quote(mSVal)); + wr.put(quoteStr(mSVal)); wr.put(';'#10); exit; end; @@ -804,7 +981,7 @@ begin end; TType.TString: begin - wr.put(TTextParser.quote(mSVal)); + wr.put(quoteStr(mSVal)); wr.put(';'#10); exit; end; @@ -841,7 +1018,6 @@ procedure TDynField.parseValue (pr: TTextParser); var rec, rc: TDynRecord; - def: TDynMapDef; es: TDynEBS = nil; tfld: TDynField; tk: AnsiString; @@ -851,59 +1027,78 @@ begin TEBS.TNone: begin end; TEBS.TRec: begin - def := mOwner.mOwner; // ugly hack. sorry. - if (CompareText(mEBSName, 'triggerdata') = 0) then + if (mType = TType.TTrigData) then begin - rec := mOwner; - // find trigger definition - 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.findTrigDataFor(tfld.mSVal); - 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); - if mRecRefOwned then mRecRef.Free(); - mRecRefOwned := true; - mRecRef := rc; + pr.expectTT(pr.TTBegin); + if (pr.tokType = pr.TTEnd) then + begin + // '{}' + mRecRef := nil; + pr.expectTT(pr.TTEnd); + end + else + begin + rec := mOwner; + // find trigger definition + 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 := 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.mHeaderRec := mOwner.mHeaderRec; + //writeln(rc.definition); + rc.parseValue(pr, true); + mRecRef := rc; + end; mDefined := true; + pr.eatTT(pr.TTSemi); // hack: allow (but don't require) semicolon after inline records exit; end; // other record types if (pr.tokType = pr.TTId) then begin - rec := def.findRecordById(mEBSName, pr.tokStr); - if (rec = nil) then raise Exception.Create(Format('record ''%s'' (%s) value for field ''%s'' not found', [pr.tokStr, mEBSName, mName])); - pr.expectId(); - if mRecRefOwned then mRecRef.Free(); - mRecRefOwned := false; - 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.findRec(mEBSName); - if (rec = nil) then raise Exception.Create(Format('record type ''%s'' for field ''%s'' not found', [mEBSName, mName])); + //rec := mOwner.mOwner.findRecType(mEBSTypeName); // find in mapdef + rec := nil; + if (mEBSType <> nil) and (mEBSType is TDynRecord) then rec := (mEBSType as TDynRecord); + if (rec = nil) then raise Exception.Create(Format('record type ''%s'' for field ''%s'' not found', [mEBSTypeName, mName])); rc := rec.clone(); + rc.mHeaderRec := mOwner.mHeaderRec; rc.parseValue(pr); - if mRecRefOwned then mRecRef.Free(); - mRecRefOwned := true; mRecRef := rc; mDefined := true; + mOwner.addRecordByType(mEBSTypeName, rc); + pr.eatTT(pr.TTSemi); // hack: allow (but don't require) semicolon after inline records exit; end; pr.expectTT(pr.TTBegin); end; TEBS.TEnum: begin - def := mOwner.mOwner; - es := def.findEBS(mEBSName); - if (es = nil) then raise Exception.Create(Format('record enum type ''%s'' for field ''%s'' not found', [mEBSName, mName])); + //es := mOwner.mOwner.findEBSType(mEBSTypeName); // find in mapdef + es := nil; + if (mEBSType <> nil) and (mEBSType is TDynEBS) then es := (mEBSType as TDynEBS); + if (es = nil) or (not es.mIsEnum) 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, mEBSName, mName])); + 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])); mIVal := es.field[tk]; mSVal := tk; //writeln('ENUM ', mEBSName, '; element <', mSVal, '> with value ', mIVal); @@ -913,18 +1108,19 @@ begin end; TEBS.TBitSet: begin - def := mOwner.mOwner; - es := def.findEBS(mEBSName); - if (es = nil) then raise Exception.Create(Format('record bitset type ''%s'' for field ''%s'' not found', [mEBSName, mName])); + //es := mOwner.mOwner.findEBSType(mEBSTypeName); // find in mapdef + es := nil; + if (mEBSType <> nil) and (mEBSType is TDynEBS) then es := (mEBSType as TDynEBS); + if (es = nil) or es.mIsEnum then raise Exception.Create(Format('record bitset type ''%s'' for field ''%s'' not found', [mEBSTypeName, mName])); mIVal := 0; while true do begin tk := pr.expectId(); - if not es.has[tk] then raise Exception.Create(Format('record bitset value ''%s'' of type ''%s'' for field ''%s'' not found', [tk, mEBSName, mName])); + if not es.has[tk] then raise Exception.Create(Format('record bitset value ''%s'' of type ''%s'' for field ''%s'' not found', [tk, mEBSTypeName, mName])); mIVal := mIVal or es.field[tk]; mSVal := tk; if (pr.tokType <> pr.TTDelim) or ((pr.tokChar <> '|') and (pr.tokChar <> '+')) then break; - if mBitSetUnique then raise Exception.Create(Format('record bitset of type ''%s'' for field ''%s'' expects only one value', [tk, mEBSName, mName])); + if mBitSetUnique then raise Exception.Create(Format('record bitset of type ''%s'' for field ''%s'' expects only one value', [tk, mEBSTypeName, mName])); //pr.expectDelim('|'); pr.skipToken(); // plus or pipe end; @@ -1051,6 +1247,11 @@ begin end; +procedure TDynField.parseBinValue (st: TStream); +begin +end; + + // ////////////////////////////////////////////////////////////////////////// // constructor TDynRecord.Create (pr: TTextParser); begin @@ -1061,6 +1262,7 @@ begin mFields := nil; mTrigTypes := nil; mHeader := false; + mHeaderRec := nil; mBinBlock := -1; parseDef(pr); end; @@ -1073,6 +1275,7 @@ begin mFields := nil; mTrigTypes := nil; mHeader := false; + mHeaderRec := nil; end; @@ -1081,6 +1284,7 @@ begin mName := ''; mFields := nil; mTrigTypes := nil; + mHeaderRec := nil; inherited; end; @@ -1138,7 +1342,6 @@ begin result.mPasName := mPasName; result.mName := mName; result.mSize := mSize; - result.mHeader := mHeader; SetLength(result.mFields, Length(mFields)); for f := 0 to High(mFields) do begin @@ -1147,6 +1350,85 @@ begin end; SetLength(result.mTrigTypes, Length(mTrigTypes)); for f := 0 to High(mTrigTypes) do result.mTrigTypes[f] := mTrigTypes[f]; + result.mHeader := mHeader; + result.mBinBlock := mBinBlock; + result.mHeaderRec := mHeaderRec; +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; + + +function TDynRecord.isSimpleEqu (rec: TDynRecord): Boolean; +var + f: Integer; +begin + if (rec = nil) then begin result := false; exit; end; // self.mRecRef can't be `nil` here + if (rec = self) then begin result := true; exit; end; + if (Length(mFields) <> Length(rec.mFields)) then begin result := false; exit; end; + result := false; + for f := 0 to High(mFields) do + begin + if not mFields[f].isSimpleEqu(rec.mFields[f]) then exit; + end; + result := true; end; @@ -1176,6 +1458,7 @@ begin SetLength(mTrigTypes, 1); mTrigTypes[0] := tdn; end; + mName := 'TriggerData'; end else begin @@ -1246,7 +1529,7 @@ begin else begin // record - result := mPasName+' is '+TTextParser.quote(mName); + result := mPasName+' is '+quoteStr(mName); if (mSize >= 0) then result += Format(' size %d bytes', [mSize]); if mHeader then result += ' header'; end; @@ -1261,6 +1544,120 @@ begin end; +procedure TDynRecord.writeBinTo (st: TStream; trigbufsz: Integer=-1); +var + fld: TDynField; + rec: TDynRecord; + buf: PByte = nil; + ws: TStream = nil; + blk, blkmax: Integer; + f, c: Integer; + bufsz: Integer = 0; + blksz: Integer; +begin + if (trigbufsz < 0) then + begin + if (mBinBlock < 1) then raise Exception.Create('cannot write binary record without block number'); + if (mSize < 1) then raise Exception.Create('cannot write binary record without size'); + bufsz := mSize; + end + else + begin + bufsz := trigbufsz; + end; + try + GetMem(buf, bufsz); + FillChar(buf^, bufsz, 0); + ws := TSFSMemoryChunkStream.Create(buf, bufsz); + + // write normal fields + for f := 0 to High(mFields) do + begin + fld := mFields[f]; + // 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 >= 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); + end; + + // write block with normal fields + if mHeader then + begin + writeln('writing header...'); + // signature and version + writeIntBE(st, LongWord($4D415001)); + writeInt(st, Byte(mBinBlock)); // type + writeInt(st, LongWord(0)); // reserved + writeInt(st, LongWord(bufsz)); // size + end; + st.WriteBuffer(buf^, bufsz); + + ws.Free(); ws := nil; + FreeMem(buf); buf := nil; + + // write other blocks, if any + if mHeader then + begin + // calculate blkmax + blkmax := 0; + for f := 0 to High(mFields) do + begin + fld := mFields[f]; + // record list? + if (fld.mType = fld.TType.TList) then + begin + if (Length(fld.mRVal) = 0) then continue; + rec := mOwner.findRecType(fld.mName); + if (rec = nil) then continue; + if (rec.mBinBlock <= 0) then continue; + if (blkmax < rec.mBinBlock) then blkmax := rec.mBinBlock; + end; + end; + // write blocks + for blk := 1 to blkmax do + begin + if (blk = mBinBlock) then continue; + ws := nil; + for f := 0 to High(mFields) do + begin + fld := mFields[f]; + // record list? + if (fld.mType = fld.TType.TList) then + begin + if (Length(fld.mRVal) = 0) then continue; + rec := mOwner.findRecType(fld.mName); + if (rec = nil) then continue; + 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); + 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(blksz)); // size + st.CopyFrom(ws, blksz); + ws.Free(); + ws := nil; + end; + end; + end; + finally + ws.Free(); + if (buf <> nil) then FreeMem(buf); + end; +end; + + procedure TDynRecord.writeTo (wr: TTextWriter; putHeader: Boolean=true); var f, c: Integer; @@ -1284,6 +1681,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; @@ -1302,73 +1700,62 @@ begin end; -procedure TDynRecord.parseValue (pr: TTextParser; asheader: Boolean=false); +procedure TDynRecord.parseValue (pr: TTextParser; beginEaten: Boolean=false); var f, c: Integer; fld: TDynField; - rec: TDynRecord; - success: Boolean; + rec, trc: TDynRecord; begin if (mOwner = nil) then raise Exception.Create(Format('can''t parse record ''%s'' value without owner', [mName])); - if not asheader then + // not a header? + if not mHeader then begin // id? - if (pr.tokType = pr.TTId) then mId := pr.expectId(); + if (not beginEaten) and (pr.tokType = pr.TTId) then mId := pr.expectId(); + end + else + begin + assert(mHeaderRec = self); end; - writeln('parsing record <', mName, '>'); - pr.expectTT(pr.TTBegin); + //writeln('parsing record <', mName, '>'); + if not beginEaten then pr.expectTT(pr.TTBegin); while (pr.tokType <> pr.TTEnd) do begin if (pr.tokType <> pr.TTId) then raise Exception.Create('identifier expected'); - - writeln('<', pr.tokStr, ':', asheader, '>'); + //writeln('<', mName, '.', pr.tokStr, '>'); // records - if (asheader) then + if mHeader then begin - assert(self = mOwner.curheader); - success := false; - for f := 0 to High(mOwner.records) do + // add records with this type (if any) + trc := mOwner.findRecType(pr.tokStr); + if (trc <> nil) then begin - if (CompareText(mOwner.records[f].mName, pr.tokStr) = 0) then - begin - // find (or create) list of records with this type - fld := field[pr.tokStr]; - if (fld = nil) then + rec := trc.clone(); + rec.mHeaderRec := mHeaderRec; + try + pr.skipToken(); + rec.parseValue(pr); + if (Length(rec.mId) > 0) then begin - // first record - fld := TDynField.Create(mOwner.records[f].mName, TDynField.TType.TList); - fld.mOwner := self; - SetLength(mFields, Length(mFields)+1); - mFields[High(mFields)] := fld; - end; - if (fld.mType <> TDynField.TType.TList) then raise Exception.Create(Format('thing ''%s'' in record ''%s'' must be record', [fld.mName, mName])); - rec := mOwner.records[f].clone(); - try - pr.skipToken(); - rec.parseValue(pr); - if (Length(rec.mId) > 0) then + fld := field[pr.tokStr]; + if (fld <> nil) then begin for c := 0 to High(fld.mRVal) do begin if (Length(fld.mRVal[c].mId) > 0) and (CompareText(fld.mRVal[c].mId, rec.mId) = 0) then raise Exception.Create(Format('duplicate thing ''%s'' in record ''%s''', [fld.mName, mName])); end; end; - SetLength(fld.mRVal, Length(fld.mRVal)+1); - fld.mRVal[High(fld.mRVal)] := rec; - writeln('added ''', mOwner.records[f].mName, ''' with id ''', rec.mId, ''' (total:', Length(fld.mRVal), ')'); - //assert(mOwner.findRecordById(mOwner.records[f].mName, rec.mId) <> nil); - rec := nil; - finally - rec.Free(); end; - success := true; - break; + addRecordByType(rec.mName, rec); + rec := nil; + finally + rec.Free(); end; + continue; end; - if success then continue; end; // fields @@ -1388,7 +1775,12 @@ 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; + + +procedure TDynRecord.parseBinValue (st: TStream); +begin end; @@ -1555,10 +1947,9 @@ end; // ////////////////////////////////////////////////////////////////////////// // constructor TDynMapDef.Create (pr: TTextParser); begin - records := nil; - trigDatas := nil; - ebs := nil; - curheader := nil; + recTypes := nil; + trigTypes := nil; + ebsTypes := nil; parseDef(pr); end; @@ -1567,96 +1958,106 @@ destructor TDynMapDef.Destroy (); var f: Integer; begin - for f := 0 to High(records) do records[f].Free(); - for f := 0 to High(trigDatas) do trigDatas[f].Free(); - for f := 0 to High(ebs) do ebs[f].Free(); - records := nil; - trigDatas := nil; - ebs := nil; + for f := 0 to High(recTypes) do recTypes[f].Free(); + for f := 0 to High(trigTypes) do trigTypes[f].Free(); + for f := 0 to High(ebsTypes) do ebsTypes[f].Free(); + recTypes := nil; + trigTypes := nil; + ebsTypes := nil; inherited; end; -function TDynMapDef.getHeader (): TDynRecord; inline; +function TDynMapDef.getHeaderRecType (): TDynRecord; inline; begin - if (Length(records) = 0) then raise Exception.Create('no header in empty mapdef'); - result := records[0]; + if (Length(recTypes) = 0) then raise Exception.Create('no header in empty mapdef'); + result := recTypes[0]; end; -function TDynMapDef.findRec (const aname: AnsiString): TDynRecord; +function TDynMapDef.findRecType (const aname: AnsiString): TDynRecord; var f: Integer; begin - for f := 0 to High(records) do + for f := 0 to High(recTypes) do begin - if (CompareText(records[f].name, aname) = 0) then begin result := records[f]; exit; end; + if (CompareText(recTypes[f].name, aname) = 0) then begin result := recTypes[f]; exit; end; end; result := nil; end; -function TDynMapDef.findTrigDataFor (const aname: AnsiString): TDynRecord; +function TDynMapDef.findTrigFor (const aname: AnsiString): TDynRecord; var f: Integer; begin - for f := 0 to High(trigDatas) do + for f := 0 to High(trigTypes) do begin - if (trigDatas[f].isForTrig[aname]) then begin result := trigDatas[f]; exit; end; + if (trigTypes[f].isForTrig[aname]) then begin result := trigTypes[f]; exit; end; end; result := nil; end; -function TDynMapDef.findEBS (const aname: AnsiString): TDynEBS; +function TDynMapDef.findEBSType (const aname: AnsiString): TDynEBS; var f: Integer; begin - for f := 0 to High(ebs) do + for f := 0 to High(ebsTypes) do begin - if (CompareText(ebs[f].name, aname) = 0) then begin result := ebs[f]; exit; end; + if (CompareText(ebsTypes[f].name, aname) = 0) then begin result := ebsTypes[f]; exit; end; end; result := nil; end; -function TDynMapDef.findRecordById (const atypename, aid: AnsiString): TDynRecord; +procedure TDynMapDef.parseDef (pr: TTextParser); var - rec: TDynRecord; + rec, hdr: TDynRecord; + eb: TDynEBS; fld: TDynField; f: Integer; -begin - result := nil; - if (curheader = nil) then exit; - // find record type - //writeln('searching for type <', atypename, '>'); - rec := findRec(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 + + // setup header links and type links + procedure linkRecord (rec: TDynRecord); + var + f: Integer; begin - if (CompareText(fld.mRVal[f].mId, aid) = 0) then + rec.mHeaderRec := recTypes[0]; + for f := 0 to High(rec.mFields) do begin - //writeln(' FOUND!'); - result := fld.mRVal[f]; - exit; + fld := rec.mFields[f]; + if (fld.mType = fld.TType.TTrigData) then continue; + case fld.mEBS of + TDynField.TEBS.TNone: begin end; + TDynField.TEBS.TRec: + begin + fld.mEBSType := findRecType(fld.mEBSTypeName); + if (fld.mEBSType = nil) then raise Exception.Create(Format('field ''%s'' of type ''%s'' has no correcponding record definition', [fld.mName, fld.mEBSTypeName])); + end; + TDynField.TEBS.TEnum, + TDynField.TEBS.TBitSet: + begin + fld.mEBSType := findEBSType(fld.mEBSTypeName); + if (fld.mEBSType = nil) then raise Exception.Create(Format('field ''%s'' of type ''%s'' has no correcponding enum/bitset', [fld.mName, fld.mEBSTypeName])); + if ((fld.mEBS = TDynField.TEBS.TEnum) <> (fld.mEBSType as TDynEBS).mIsEnum) then raise Exception.Create(Format('field ''%s'' of type ''%s'' enum/bitset type conflict', [fld.mName, fld.mEBSTypeName])); + end; + end; end; end; - // alas -end; + // setup default values + procedure fixRecordDefaults (rec: TDynRecord); + var + f: Integer; + begin + for f := 0 to High(rec.mFields) do + begin + fld := rec.mFields[f]; + if fld.mHasDefault then fld.parseDefaultValue(); + end; + end; -procedure TDynMapDef.parseDef (pr: TTextParser); -var - dr, hdr: TDynRecord; - eb: TDynEBS; - f: Integer; begin hdr := nil; while true do @@ -1667,57 +2068,66 @@ begin if (pr.tokStr = 'enum') or (pr.tokStr = 'bitset') then begin eb := TDynEBS.Create(pr); - if (findEBS(eb.name) <> nil) then + if (findEBSType(eb.name) <> nil) then begin eb.Free(); raise Exception.Create(Format('duplicate enum/bitset ''%s''', [eb.name])); end; eb.mOwner := self; - SetLength(ebs, Length(ebs)+1); - ebs[High(ebs)] := eb; + SetLength(ebsTypes, Length(ebsTypes)+1); + ebsTypes[High(ebsTypes)] := eb; //writeln(eb.definition); writeln; continue; end; if (pr.tokStr = 'TriggerData') then begin - dr := TDynRecord.Create(pr); - for f := 0 to High(dr.mTrigTypes) do + rec := TDynRecord.Create(pr); + for f := 0 to High(rec.mTrigTypes) do begin - if (findTrigDataFor(dr.mTrigTypes[f]) <> nil) then + if (findTrigFor(rec.mTrigTypes[f]) <> nil) then begin - dr.Free(); - raise Exception.Create(Format('duplicate trigdata ''%s''', [dr.mTrigTypes[f]])); + rec.Free(); + raise Exception.Create(Format('duplicate trigdata ''%s''', [rec.mTrigTypes[f]])); end; end; - dr.mOwner := self; - SetLength(trigDatas, Length(trigDatas)+1); - trigDatas[High(trigDatas)] := dr; + rec.mOwner := self; + SetLength(trigTypes, Length(trigTypes)+1); + trigTypes[High(trigTypes)] := rec; //writeln(dr.definition); writeln; continue; end; - dr := TDynRecord.Create(pr); + rec := TDynRecord.Create(pr); //writeln(dr.definition); writeln; - if (findRec(dr.name) <> nil) then begin dr.Free(); raise Exception.Create(Format('duplicate record ''%s''', [dr.name])); end; - if (hdr <> nil) and (CompareText(dr.name, hdr.name) = 0) then begin dr.Free(); raise Exception.Create(Format('duplicate record ''%s''', [dr.name])); end; - dr.mOwner := self; - if dr.mHeader then + if (findRecType(rec.name) <> nil) then begin rec.Free(); raise Exception.Create(Format('duplicate record ''%s''', [rec.name])); end; + if (hdr <> nil) and (CompareText(rec.name, hdr.name) = 0) then begin rec.Free(); raise Exception.Create(Format('duplicate record ''%s''', [rec.name])); end; + rec.mOwner := self; + if rec.mHeader then begin - if (hdr <> nil) then begin dr.Free(); raise Exception.Create(Format('duplicate header record ''%s'' (previous is ''%s'')', [dr.name, hdr.name])); end; - hdr := dr; + if (hdr <> nil) then begin rec.Free(); raise Exception.Create(Format('duplicate header record ''%s'' (previous is ''%s'')', [rec.name, hdr.name])); end; + hdr := rec; end else begin - SetLength(records, Length(records)+1); - records[High(records)] := dr; + SetLength(recTypes, Length(recTypes)+1); + recTypes[High(recTypes)] := rec; end; end; + // put header record to top if (hdr = nil) then raise Exception.Create('header definition not found in mapdef'); - SetLength(records, Length(records)+1); - for f := High(records) downto 1 do records[f] := records[f-1]; - records[0] := hdr; + SetLength(recTypes, Length(recTypes)+1); + for f := High(recTypes) downto 1 do recTypes[f] := recTypes[f-1]; + recTypes[0] := hdr; + + // setup header links and type links + for f := 0 to High(recTypes) do linkRecord(recTypes[f]); + for f := 0 to High(trigTypes) do linkRecord(trigTypes[f]); + + // setup default values + for f := 0 to High(recTypes) do fixRecordDefaults(recTypes[f]); + for f := 0 to High(trigTypes) do fixRecordDefaults(trigTypes[f]); end; @@ -1726,20 +2136,27 @@ function TDynMapDef.parseMap (pr: TTextParser): TDynRecord; var res: TDynRecord = nil; begin - if (curheader <> nil) then raise Exception.Create('cannot call `parseMap()` recursively, sorry'); result := nil; try - pr.expectId(header.name); - res := header.clone(); - curheader := res; - res.parseValue(pr, true); // as header + pr.expectId(headerType.name); + res := headerType.clone(); + res.mHeaderRec := res; + res.parseValue(pr); result := res; res := nil; - finally - curheader := nil; - res.Free(); + except on E: Exception do + begin + res.Free(); + raise; + end; end; end; +function TDynMapDef.parseBinMap (st: TStream): TDynRecord; +begin + result := nil; +end; + + end.