X-Git-Url: https://deadsoftware.ru/gitweb?a=blobdiff_plain;f=src%2Fshared%2Fxdynrec.pas;h=d82867e7d504dd34ad0d1a152a9ffe7a872069d6;hb=51bbf0eef2641d7766e22e188d6c349d9b836023;hp=0773ab01bcab7866a0d682481f2a5dc60f9ead8f;hpb=3255b0825dd8a2db15ea04c21e34da5279cbaa5e;p=d2df-sdl.git diff --git a/src/shared/xdynrec.pas b/src/shared/xdynrec.pas index 0773ab0..d82867e 100644 --- a/src/shared/xdynrec.pas +++ b/src/shared/xdynrec.pas @@ -14,35 +14,38 @@ * along with this program. If not, see . *) {$INCLUDE a_modes.inc} +{.$DEFINE XDYNREC_USE_FIELDHASH} // actually, it is SLOWER with this unit xdynrec; interface uses - Classes, - xparser, xstreams; + Variants, Classes, + xparser, xstreams, utils, hashtable; // ////////////////////////////////////////////////////////////////////////// // type TDynMapDef = class; TDynRecord = class; + TDynField = class; + TDynEBS = class; + + TDynFieldList = specialize TSimpleList; + TDynRecList = specialize TSimpleList; + TDynEBSList = specialize TSimpleList; // this is base type for all scalars (and arrays) TDynField = class public type TType = (TBool, TChar, TByte, TUByte, TShort, TUShort, TInt, TUInt, TString, TPoint, TSize, TList, TTrigData); - // TPoint: pair of Shorts + // TPoint: pair of Integers // 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 - TDynFieldArray = array of TDynField; - TDynRecordArray = array of TDynRecord; - private type TEBS = (TNone, TRec, TEnum, TBitSet); @@ -55,50 +58,72 @@ type mIVal: Integer; // for all integer types 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 + mRVal: TDynRecList; // for list + mRHash: THashStrInt; // id -> index in mRVal + 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; - mEBSTypeName: 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 + mAsMonsterId: Boolean; // special hack for triggers: monster record number+1 in binary (so 0 means "none") + // 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 + + // for binary parser + mRecRefId: AnsiString; - // temp - mDefId: AnsiString; + // for userdata + mTagInt: Integer; + mTagPtr: Pointer; private procedure cleanup (); procedure parseDef (pr: TTextParser); + procedure parseDefaultValue (); // parse `mDefUnparsed` to `mDefSVal`, `mDefIVal`, `mDefIVal2`, `mDefRecRef` + procedure fixDefaultValue (); // this will NOT clone `mDefRecRef` + function isDefaultValue (): Boolean; + + function getListCount (): Integer; inline; + function getListItem (idx: Integer): TDynRecord; inline; overload; + function getListItem (const aname: AnsiString): TDynRecord; inline; overload; + + function getRecRefIndex (): Integer; + procedure setIVal (v: Integer); inline; - procedure setSVal (const v: AnsiString); inline; - procedure fixDefaultValue (); - function isDefaultValue (): Boolean; + function getVar (): Variant; + procedure setVar (val: Variant); + + protected + // returns `true` for duplicate record id + function addListItem (rec: TDynRecord): Boolean; inline; public constructor Create (const aname: AnsiString; atype: TType); constructor Create (pr: TTextParser); + constructor Create (const aname: AnsiString; val: Variant); destructor Destroy (); override; class function getTypeName (t: TType): AnsiString; function definition (): AnsiString; + function pasdef (): AnsiString; - function clone (): TDynField; + function clone (newOwner: TDynRecord=nil; registerIn: TDynRecord=nil): TDynField; procedure parseValue (pr: TTextParser); procedure parseBinValue (st: TStream); @@ -109,30 +134,43 @@ type // won't work for lists function isSimpleEqu (fld: TDynField): Boolean; + procedure setValue (const s: AnsiString); + + function GetEnumerator (): TDynRecList.TEnumerator; inline; + public property pasname: AnsiString read mPasName; property name: AnsiString read mName; property baseType: TType read mType; - property defined: Boolean read mDefined write mDefined; + property negbool: Boolean read mNegBool; + property defined: Boolean read mDefined; property internal: Boolean read mInternal write mInternal; + property hasTPrefix: Boolean read mAsT; + property separatePasFields: Boolean read mSepPosSize; + property binOfs: Integer read mBinOfs; property ival: Integer read mIVal write setIVal; - property sval: AnsiString read mSVal write setSVal; - 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 ival2: Integer read mIVal2; + property sval: AnsiString read mSVal; property hasDefault: Boolean read mHasDefault; - property defsval: AnsiString read mDefSVal write mDefSVal; - property ebs: TEBS read mEBS write mEBS; - property ebstypename: AnsiString read mEBSTypeName write mEBSTypeName; // enum/bitset name - - property x: Integer read mIVal; - property w: Integer read mIVal; - property y: Integer read mIVal2; - property h: Integer read mIVal2; + property defsval: AnsiString read mDefSVal; + property ebs: TEBS read mEBS; + property ebstype: TObject read mEBSType; + property ebstypename: AnsiString read mEBSTypeName; // enum/bitset name + property recref: TDynRecord read mRecRef; + property recrefIndex: Integer read getRecRefIndex; // search for this record in header; -1: not found + // for lists + property count: Integer read getListCount; + property item[idx: Integer]: TDynRecord read getListItem; + property items[const aname: AnsiString]: TDynRecord read getListItem; default; // alas, FPC 3+ lost property overloading feature + // userdata + property tagInt: Integer read mTagInt write mTagInt; + property tagPtr: Pointer read mTagPtr write mTagPtr; + // + property varvalue: Variant read getVar write setVar; end; + // "value" header record contains TList fields, with name equal to record type TDynRecord = class private mOwner: TDynMapDef; @@ -140,10 +178,20 @@ type mPasName: AnsiString; mName: AnsiString; mSize: Integer; - mFields: TDynField.TDynFieldArray; + mFields: TDynFieldList; + {$IF DEFINED(XDYNREC_USE_FIELDHASH)} + mFieldsHash: THashStrInt; // id -> index in mRVal + {$ENDIF} 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 + + // for userdata + mTagInt: Integer; + mTagPtr: Pointer; + + mRec2Free: TDynRecList; private procedure parseDef (pr: TTextParser); // parse definition @@ -151,38 +199,79 @@ type function findByName (const aname: AnsiString): Integer; inline; function hasByName (const aname: AnsiString): Boolean; inline; function getFieldByName (const aname: AnsiString): TDynField; inline; + function getFieldAt (idx: Integer): TDynField; inline; + function getCount (): Integer; inline; function getIsTrigData (): Boolean; inline; function getIsForTrig (const aname: AnsiString): Boolean; inline; + function getForTrigCount (): Integer; inline; + function getForTrigAt (idx: Integer): AnsiString; inline; + + procedure regrec (rec: TDynRecord); + + protected + function findRecordByTypeId (const atypename, aid: AnsiString): TDynRecord; + function findRecordNumByType (const atypename: AnsiString; rc: TDynRecord): Integer; + function addRecordByType (const atypename: AnsiString; rc: TDynRecord): Boolean; // `true`: duplicate record id + + procedure addField (fld: TDynField); inline; + function addFieldChecked (fld: TDynField): Boolean; inline; // `true`: duplicate name + public constructor Create (); constructor Create (pr: TTextParser); // parse definition destructor Destroy (); override; function definition (): AnsiString; + function pasdef (): AnsiString; - function clone (): TDynRecord; + function clone (registerIn: TDynRecord): TDynRecord; - procedure parseValue (pr: TTextParser; asheader: Boolean=false); - procedure parseBinValue (st: TStream); + function isSimpleEqu (rec: TDynRecord): Boolean; + + procedure parseValue (pr: TTextParser; beginEaten: Boolean=false); + procedure parseBinValue (st: TStream; forceData: Boolean=false); procedure writeTo (wr: TTextWriter; putHeader: Boolean=true); - procedure writeBinTo (st: TStream; trigbufsz: Integer=-1); + procedure writeBinTo (st: TStream; trigbufsz: Integer=-1; onlyFields: Boolean=false); + + // find field with `TriggerType` type + function trigTypeField (): TDynField; + + // number of records of the given instance + function instanceCount (const typename: AnsiString): Integer; + + //procedure setUserField (const fldname: AnsiString; v: LongInt); + //procedure setUserField (const fldname: AnsiString; v: AnsiString); + //procedure setUserField (const fldname: AnsiString; v: Boolean); + + function getUserVar (const aname: AnsiString): Variant; + procedure setUserVar (const aname: AnsiString; val: Variant); public property id: AnsiString read mId; // for map parser property pasname: AnsiString read mPasName; property name: AnsiString read mName; // record name property size: Integer read mSize; // size in bytes - property fields: TDynField.TDynFieldArray read mFields write mFields; + //property fields: TDynFieldList read mFields; property has[const aname: AnsiString]: Boolean read hasByName; - property field[const aname: AnsiString]: TDynField read getFieldByName; + property count: Integer read getCount; + property field[const aname: AnsiString]: TDynField read getFieldByName; default; + property fieldAt[idx: Integer]: TDynField read getFieldAt; property isTrigData: Boolean read getIsTrigData; property isForTrig[const aname: AnsiString]: Boolean read getIsForTrig; + property forTrigCount: Integer read getForTrigCount; + property forTrigAt[idx: Integer]: AnsiString read getForTrigAt; + property headerRec: TDynRecord read mHeaderRec; + property isHeader: Boolean read mHeader; + // userdata + property tagInt: Integer read mTagInt write mTagInt; + property tagPtr: Pointer read mTagPtr write mTagPtr; + // userfields + property user[const aname: AnsiString]: Variant read getUserVar write setUserVar; end; - TDynEBS = class private mOwner: TDynMapDef; @@ -207,6 +296,10 @@ type destructor Destroy (); override; function definition (): AnsiString; + function pasdef (): AnsiString; + + // return empty string if not found + function nameByValue (v: Integer): AnsiString; public property name: AnsiString read mName; // record name @@ -217,46 +310,65 @@ type TDynMapDef = class - private - curheader: TDynRecord; // for parser - - private - procedure addRecordByType (const atypename: AnsiString; rc: TDynRecord); - function findRecordByTypeId (const atypename, aid: AnsiString): TDynRecord; - function findRecordNumByType (const atypename: AnsiString; rc: TDynRecord): Integer; - public - records: array of TDynRecord; // [0] is always header - trigDatas: array of TDynRecord; - ebs: array of TDynEBS; + recTypes: TDynRecList; // [0] is always header + trigTypes: TDynRecList; // trigdata + ebsTypes: TDynEBSList; // enums, bitsets private procedure parseDef (pr: TTextParser); - function getHeader (): TDynRecord; inline; + function getHeaderRecType (): TDynRecord; inline; + + function getTrigTypeCount (): Integer; inline; + function getTrigTypeAt (idx: Integer): TDynRecord; inline; public 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; + function pasdef (): AnsiString; + function pasdefconst (): AnsiString; + + // 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; + property trigTypeCount: Integer read getTrigTypeCount; + property trigType[idx: Integer]: TDynRecord read getTrigTypeAt; end; +{$IF DEFINED(D2D_DYNREC_PROFILER)} +procedure xdynDumpProfiles (); +{$ENDIF} + + implementation uses - SysUtils, - utils; + SysUtils, e_log + {$IF DEFINED(D2D_DYNREC_PROFILER)},xprofiler{$ENDIF}; + + +// ////////////////////////////////////////////////////////////////////////// // +function StrEqu (const a, b: AnsiString): Boolean; inline; begin result := (a = b); end; + + +// ////////////////////////////////////////////////////////////////////////// // +function TDynField.GetEnumerator (): TDynRecList.TEnumerator; inline; +begin + //result := TListEnumerator.Create(mRVal); + if (mRVal <> nil) then result := mRVal.GetEnumerator else result := TDynRecList.TEnumerator.Create(nil, 0); +end; // ////////////////////////////////////////////////////////////////////////// // @@ -264,10 +376,15 @@ constructor TDynField.Create (const aname: AnsiString; atype: TType); begin mRVal := nil; mRecRef := nil; - //mRecRefOwned := false; + mRHash := nil; cleanup(); mName := aname; mType := atype; + if (mType = TType.TList) then + begin + mRVal := TDynRecList.Create(); + mRHash := hashNewStrInt(); + end; end; @@ -278,6 +395,72 @@ begin end; +constructor TDynField.Create (const aname: AnsiString; val: Variant); + procedure setInt32 (v: LongInt); + begin + case mType of + TType.TBool: + if (v = 0) then mIVal := 0 + else if (v = 1) then mIVal := 1 + else raise Exception.Create('cannot convert shortint variant to field value'); + TType.TByte: + if (v >= -128) and (v <= 127) then mIVal := v + else raise Exception.Create('cannot convert shortint variant to field value'); + TType.TUByte: + if (v >= 0) and (v <= 255) then mIVal := v + else raise Exception.Create('cannot convert shortint variant to field value'); + TType.TShort: + if (v >= -32768) and (v <= 32767) then mIVal := v + else raise Exception.Create('cannot convert shortint variant to field value'); + TType.TUShort: + if (v >= 0) and (v <= 65535) then mIVal := v + else raise Exception.Create('cannot convert shortint variant to field value'); + TType.TInt: + mIVal := v; + TType.TUInt: + mIVal := v; + TType.TString: + mSVal := formatstrf('%s', [v]); + else + raise Exception.Create('cannot convert integral variant to field value'); + end; + end; +begin + mRVal := nil; + mRecRef := nil; + mRHash := nil; + cleanup(); + mName := aname; + case varType(val) of + varEmpty: raise Exception.Create('cannot convert empty variant to field value'); + varNull: raise Exception.Create('cannot convert null variant to field value'); + varSingle: raise Exception.Create('cannot convert single variant to field value'); + varDouble: raise Exception.Create('cannot convert double variant to field value'); + varDecimal: raise Exception.Create('cannot convert decimal variant to field value'); + varCurrency: raise Exception.Create('cannot convert currency variant to field value'); + varDate: raise Exception.Create('cannot convert date variant to field value'); + varOleStr: raise Exception.Create('cannot convert olestr variant to field value'); + varStrArg: raise Exception.Create('cannot convert stdarg variant to field value'); + varString: mType := TType.TString; + varDispatch: raise Exception.Create('cannot convert dispatch variant to field value'); + varBoolean: mType := TType.TBool; + varVariant: raise Exception.Create('cannot convert variant variant to field value'); + varUnknown: raise Exception.Create('cannot convert unknown variant to field value'); + varByte: mType := TType.TUByte; + varWord: mType := TType.TUShort; + varShortInt: mType := TType.TByte; + varSmallint: mType := TType.TShort; + varInteger: mType := TType.TInt; + varInt64: raise Exception.Create('cannot convert int64 variant to field value'); + varLongWord: raise Exception.Create('cannot convert longword variant to field value'); + varQWord: raise Exception.Create('cannot convert uint64 variant to field value'); + varError: raise Exception.Create('cannot convert error variant to field value'); + else raise Exception.Create('cannot convert undetermined variant to field value'); + end; + varvalue := val; +end; + + destructor TDynField.Destroy (); begin cleanup(); @@ -292,76 +475,199 @@ begin mIVal := 0; mIVal2 := 0; mSVal := ''; + mRVal.Free(); mRVal := nil; - //if mRecRefOwned then mRecRef.Free(); + mRHash.Free(); + mRHash := nil; mRecRef := nil; - //mRecRefOwned := false; mMaxDim := -1; mBinOfs := -1; - mRecOfs := -1; mSepPosSize := false; mAsT := false; mHasDefault := false; mDefined := false; mOmitDef := false; mInternal := true; + mDefUnparsed := ''; mDefSVal := ''; + mDefIVal := 0; + mDefIVal2 := 0; + mDefRecRef := nil; mEBS := TEBS.TNone; mEBSTypeName := ''; + mEBSType := nil; mBitSetUnique := false; + mAsMonsterId := false; mNegBool := false; - mDefId := ''; - mDefaultValueSet := false; + mRecRefId := ''; + mTagInt := 0; + mTagPtr := nil; end; -function TDynField.clone (): TDynField; +function TDynField.clone (newOwner: TDynRecord=nil; registerIn: TDynRecord=nil): TDynField; var - f: Integer; + rec: TDynRecord; begin result := TDynField.Create(mName, mType); result.mOwner := mOwner; + if (newOwner <> nil) then result.mOwner := newOwner else result.mOwner := mOwner; result.mPasName := mPasName; result.mName := mName; result.mType := mType; result.mIVal := mIVal; result.mIVal2 := mIVal2; result.mSVal := mSVal; - SetLength(result.mRVal, Length(mRVal)); - for f := 0 to High(mRVal) do result.mRVal[f] := mRVal[f].clone(); - result.mRecRef := mRecRef; - { - result.mRecRefOwned := mRecRefOwned; - if mRecRefOwned then - begin - if (mRecRef <> nil) then result.mRecRef := mRecRef.clone(); - end - else + if (mRVal <> nil) then begin - result.mRecRef := mRecRef; + if (result.mRVal = nil) then result.mRVal := TDynRecList.Create(mRVal.count); + if (result.mRHash = nil) then result.mRHash := hashNewStrInt(); + for rec in mRVal do result.addListItem(rec.clone(registerIn)); end; - } + result.mRecRef := mRecRef; result.mMaxDim := mMaxDim; result.mBinOfs := mBinOfs; - result.mRecOfs := mRecOfs; result.mSepPosSize := mSepPosSize; result.mAsT := mAsT; result.mDefined := mDefined; result.mHasDefault := mHasDefault; result.mOmitDef := mOmitDef; result.mInternal := mInternal; + result.mNegBool := mNegBool; + result.mBitSetUnique := mBitSetUnique; + result.mAsMonsterId := mAsMonsterId; + 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; + result.mEBSType := mEBSType; + result.mRecRefId := mRecRefId; + result.mTagInt := mTagInt; + result.mTagPtr := mTagPtr; +end; + + +procedure TDynField.setIVal (v: Integer); inline; +begin + //FIXME: check type + mIVal := v; + mDefined := true; +end; + + +function TDynField.getVar (): Variant; +begin + if (mEBS = TEBS.TRec) then begin result := LongInt(getRecRefIndex); exit; end; + case mType of + TType.TBool: result := (mIVal <> 0); + TType.TChar: result := mSVal; + TType.TByte: result := ShortInt(mIVal); + TType.TUByte: result := Byte(mIVal); + TType.TShort: result := SmallInt(mIVal); + TType.TUShort: result := Word(mIVal); + TType.TInt: result := LongInt(mIVal); + TType.TUInt: result := LongWord(mIVal); + TType.TString: result := mSVal; + TType.TPoint: raise Exception.Create('cannot convert point field to variant'); + TType.TSize: raise Exception.Create('cannot convert size field to variant'); + TType.TList: raise Exception.Create('cannot convert list field to variant'); + TType.TTrigData: raise Exception.Create('cannot convert trigdata field to variant'); + else result := Unassigned; raise Exception.Create('ketmar forgot to handle some field type'); + end; 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; +procedure TDynField.setVar (val: Variant); + procedure setInt32 (v: LongInt); + begin + case mType of + TType.TBool: + if (v = 0) then mIVal := 0 + else if (v = 1) then mIVal := 1 + else raise Exception.Create('cannot convert shortint variant to field value'); + TType.TByte: + if (v >= -128) and (v <= 127) then mIVal := v + else raise Exception.Create('cannot convert shortint variant to field value'); + TType.TUByte: + if (v >= 0) and (v <= 255) then mIVal := v + else raise Exception.Create('cannot convert shortint variant to field value'); + TType.TShort: + if (v >= -32768) and (v <= 32767) then mIVal := v + else raise Exception.Create('cannot convert shortint variant to field value'); + TType.TUShort: + if (v >= 0) and (v <= 65535) then mIVal := v + else raise Exception.Create('cannot convert shortint variant to field value'); + TType.TInt: + mIVal := v; + TType.TUInt: + mIVal := v; + TType.TString: + mSVal := formatstrf('%s', [v]); + else + raise Exception.Create('cannot convert integral variant to field value'); + end; + end; +begin + case varType(val) of + varEmpty: raise Exception.Create('cannot convert empty variant to field value'); + varNull: raise Exception.Create('cannot convert null variant to field value'); + varSingle: raise Exception.Create('cannot convert single variant to field value'); + varDouble: raise Exception.Create('cannot convert double variant to field value'); + varDecimal: raise Exception.Create('cannot convert decimal variant to field value'); + varCurrency: raise Exception.Create('cannot convert currency variant to field value'); + varDate: raise Exception.Create('cannot convert date variant to field value'); + varOleStr: raise Exception.Create('cannot convert olestr variant to field value'); + varStrArg: raise Exception.Create('cannot convert stdarg variant to field value'); + varString: + if (mType = TType.TChar) or (mType = TType.TString) then + begin + mSVal := val; + end + else + begin + raise Exception.Create('cannot convert string variant to field value'); + end; + varDispatch: raise Exception.Create('cannot convert dispatch variant to field value'); + varBoolean: + case mType of + TType.TBool, + TType.TByte, + TType.TUByte, + TType.TShort, + TType.TUShort, + TType.TInt, + TType.TUInt: + if val then mIVal := 1 else mIVal := 0; + TType.TString: + if val then mSVal := 'true' else mSVal := 'false'; + else + raise Exception.Create('cannot convert boolean variant to field value'); + end; + varVariant: raise Exception.Create('cannot convert variant variant to field value'); + varUnknown: raise Exception.Create('cannot convert unknown variant to field value'); + varByte, + varWord, + varShortInt, + varSmallint, + varInteger: + setInt32(val); + varInt64: + if (val < Int64(LongInt($80000000))) or (val > LongInt($7FFFFFFF)) then + raise Exception.Create('cannot convert boolean variant to field value') + else + mIVal := LongInt(val); + varLongWord: + if (val > LongWord($7FFFFFFF)) then raise Exception.Create('cannot convert longword variant to field value') + else setInt32(Integer(val)); + varQWord: raise Exception.Create('cannot convert uint64 variant to field value'); + varError: raise Exception.Create('cannot convert error variant to field value'); + else raise Exception.Create('cannot convert undetermined variant to field value'); + end; + mDefined := true; +end; // won't work for lists @@ -383,75 +689,128 @@ 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 mRecRef := mDefRecRef; + 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+';'; + 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; - stp := TStrTextParser.Create(s); - try - fld := clone(); - fld.parseValue(stp); - result := isSimpleEqu(fld); - finally - fld.Free(); - stp.Free(); +end; + + +function TDynField.getListCount (): Integer; inline; +begin + if (mRVal <> nil) then result := mRVal.count else result := 0; +end; + + +function TDynField.getListItem (idx: Integer): TDynRecord; inline; overload; +begin + if (mRVal <> nil) and (idx >= 0) and (idx < mRVal.count) then result := mRVal[idx] else result := nil; +end; + + +function TDynField.getListItem (const aname: AnsiString): TDynRecord; inline; overload; +var + idx: Integer; +begin + if (mRVal <> nil) and mRHash.get(aname, idx) then result := mRVal[idx] else result := nil; +end; + + +function TDynField.addListItem (rec: TDynRecord): Boolean; inline; +begin + result := false; + if (mRVal <> nil) then + begin + mRVal.append(rec); + if (Length(rec.mId) > 0) then result := mRHash.put(rec.mId, mRVal.count-1); end; end; @@ -479,35 +838,18 @@ 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]); + if (mBinOfs >= 0) then result += Format(' offset %d', [mBinOfs]); case mEBS of TEBS.TNone: begin 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 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 mAsMonsterId then result += ' as monsterid'; + 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 @@ -518,6 +860,34 @@ begin end; +function TDynField.pasdef (): AnsiString; +begin + result := mPasName+': '; + case mType of + TType.TBool: result += 'Boolean;'; + TType.TChar: if (mMaxDim > 0) then result += formatstrf('Char%d;', [mMaxDim]) else result += 'Char;'; + TType.TByte: result += 'ShortInt;'; + TType.TUByte: result += 'Byte;'; + TType.TShort: result += 'SmallInt;'; + TType.TUShort: result += 'Word;'; + TType.TInt: result += 'LongInt;'; + TType.TUInt: result += 'LongWord;'; + TType.TString: result += 'AnsiString;'; + TType.TPoint: + if mAsT then result := 'tX, tY: Integer;' + else if mSepPosSize then result := 'X, Y: Integer;' + else result += 'TDFPoint;'; + TType.TSize: + if mAsT then result := 'tWidth, tHeight: Word;' + else if mSepPosSize then result := 'Width, Height: Word;' + else result += 'TSize;'; + TType.TList: assert(false); + TType.TTrigData: result += formatstrf('Byte%d;', [mMaxDim]); + else raise Exception.Create('ketmar forgot to handle some field type'); + end; +end; + + procedure TDynField.parseDef (pr: TTextParser); var fldname: AnsiString; @@ -529,13 +899,15 @@ var ainternal: Boolean; omitdef: Boolean; defstr: AnsiString; - defint: Integer; + defint, defint2: Integer; hasdefStr: Boolean; hasdefInt: Boolean; hasdefId: Boolean; lmaxdim: Integer; lebs: TDynField.TEBS; unique: Boolean; + asmonid: Boolean; + defech: AnsiChar; begin fldpasname := ''; fldname := ''; @@ -549,10 +921,12 @@ begin omitdef := false; defstr := ''; defint := 0; + defint2 := 0; hasdefStr := false; hasdefInt := false; hasdefId := false; unique := false; + asmonid := false; lmaxdim := -1; lebs := TDynField.TEBS.TNone; @@ -568,7 +942,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; @@ -588,6 +962,7 @@ begin else if pr.eatId('wh') then aswh := true else if pr.eatId('txy') then begin asxy := true; ast := true; end else if pr.eatId('twh') then begin aswh := true; ast := true; end + else if pr.eatId('monsterid') then begin asmonid := true; end else raise Exception.Create(Format('invalid field ''%s'' as what?', [fldname])); continue; end; @@ -628,6 +1003,14 @@ begin hasdefInt := true; defint := pr.expectInt(); end; + pr.TTDelim: + begin + hasdefInt := true; + if pr.eatDelim('[') then defech := ']' else begin pr.expectDelim('('); defech := ')'; end; + defint := pr.expectInt(); + defint2 := pr.expectInt(); + pr.expectDelim(defech); + end; else raise Exception.Create(Format('field ''%s'' has invalid default', [fldname])); end; @@ -672,17 +1055,21 @@ 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 + 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 (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 < 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 hasdefId then self.mDefUnparsed := defstr + else if hasdefInt 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 (mType = TType.TPoint) then self.mDefUnparsed := Format('(%d %d)', [defint, defint2]) + else if (mType = TType.TSize) then self.mDefUnparsed := Format('[%d %d]', [defint, defint2]) + else self.mDefUnparsed := Format('%d', [defint]); end; self.mHasDefault := (hasdefStr or hasdefId or hasdefInt); @@ -690,9 +1077,9 @@ begin self.mEBS := lebs; self.mEBSTypeName := fldrecname; self.mBitSetUnique := unique; + self.mAsMonsterId := asmonid; self.mMaxDim := lmaxdim; self.mBinOfs := fldofs; - self.mRecOfs := fldofs; self.mSepPosSize := (asxy or aswh); self.mAsT := ast; self.mOmitDef := omitdef; @@ -700,6 +1087,13 @@ begin end; +function TDynField.getRecRefIndex (): Integer; +begin + if (mRecRef = nil) then begin result := -1; exit; end; + result := mOwner.findRecordNumByType(mEBSTypeName, mRecRef); +end; + + procedure TDynField.writeBinTo (st: TStream); var s: AnsiString; @@ -712,20 +1106,14 @@ begin TEBS.TNone: begin end; TEBS.TRec: begin - // this must be byte/word/int if (mMaxDim >= 0) then begin // this must be triggerdata - if (CompareText(mEBSTypeName, 'triggerdata') <> 0) then + 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 - case mType of - TType.TChar, TType.TByte, TType.TUByte: begin end; - else raise Exception.Create(Format('record reference type ''%s'' in field ''%s'' cannot be written', [mEBSTypeName, mName])); - end; - //writeln('trigdata size: ', mMaxDim); GetMem(buf, mMaxDim); if (buf = nil) then raise Exception.Create(Format('record reference type ''%s'' in field ''%s'' cannot be written', [mEBSTypeName, mName])); try @@ -742,17 +1130,7 @@ begin end; exit; end; - 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; + // record reference case mType of TType.TByte: maxv := 127; TType.TUByte: maxv := 254; @@ -763,13 +1141,21 @@ 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); - 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])); + if (mRecRef <> nil) then + begin + 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 mAsMonsterId then Inc(f); + if (f > maxv) then raise Exception.Create(Format('record reference type ''%s'' in field ''%s'' has too big index', [mEBSTypeName, mName])); + end + else + begin + if mAsMonsterId then f := 0 else f := -1; + end; 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)); + TType.TInt, TType.TUInt: writeInt(st, LongWord(f)); else raise Exception.Create(Format('record reference type ''%s'' in field ''%s'' cannot be written', [mEBSTypeName, mName])); end; exit; @@ -782,7 +1168,14 @@ begin case mType of TType.TBool: begin - if (mIVal <> 0) then writeInt(st, Byte(1)) else writeInt(st, Byte(0)); + if not mNegBool then + begin + if (mIVal <> 0) then writeInt(st, Byte(1)) else writeInt(st, Byte(0)); + end + else + begin + if (mIVal = 0) then writeInt(st, Byte(1)) else writeInt(st, Byte(0)); + end; exit; end; TType.TChar: @@ -796,9 +1189,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)); + 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; @@ -807,30 +1198,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; @@ -838,10 +1221,16 @@ begin begin raise Exception.Create(Format('cannot write string field ''%s''', [mName])); end; - TType.TPoint, + TType.TPoint: + begin + if (mMaxDim >= 0) then raise Exception.Create(Format('pos/size array in field ''%s'' cannot be written', [mName])); + writeInt(st, LongInt(mIVal)); + writeInt(st, LongInt(mIVal2)); + exit; + end; 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; @@ -863,21 +1252,19 @@ 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 (Length(mRecRef.mId) = 0) then begin @@ -892,9 +1279,11 @@ begin end; TEBS.TEnum: begin - def := mOwner.mOwner; - es := def.findEBS(mEBSTypeName); - if (es = nil) then raise Exception.Create(Format('record enum type ''%s'' for field ''%s'' not found', [mEBSTypeName, 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 @@ -908,9 +1297,11 @@ begin end; TEBS.TBitSet: begin - def := mOwner.mOwner; - es := def.findEBS(mEBSTypeName); - if (es = nil) then raise Exception.Create(Format('record bitset type ''%s'' for field ''%s'' not found', [mEBSTypeName, 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 @@ -962,7 +1353,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; @@ -978,7 +1369,7 @@ begin end; TType.TString: begin - wr.put(TTextParser.quote(mSVal)); + wr.put(quoteStr(mSVal)); wr.put(';'#10); exit; end; @@ -1004,79 +1395,293 @@ begin end; -procedure TDynField.parseValue (pr: TTextParser); - - procedure parseInt (min, max: Integer); - begin - mIVal := pr.expectInt(); - if (mIVal < min) or (mIVal > max) then raise Exception.Create(Format('invalid %s value for field ''%s''', [getTypeName(mType), mName])); - mDefined := true; - end; - +procedure TDynField.parseBinValue (st: TStream); var rec, rc: TDynRecord; - def: TDynMapDef; - es: TDynEBS = nil; tfld: TDynField; - tk: AnsiString; + es: TDynEBS = nil; + tdata: PByte = nil; + f, mask: Integer; + s: AnsiString; begin - // if this field should contain struct, convert type and parse struct case mEBS of TEBS.TNone: begin end; TEBS.TRec: begin - def := mOwner.mOwner; - // ugly hack. sorry. - if (CompareText(mEBSTypeName, 'triggerdata') = 0) then + // this must be triggerdata + if (mType = TType.TTrigData) then begin + assert(mMaxDim > 0); 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); + tfld := rec.trigTypeField(); + if (tfld = nil) then raise Exception.Create(Format('triggerdata value for field ''%s'' in record ''%s'' without TriggerType 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.parseValue(pr); - //if mRecRefOwned then mRecRef.Free(); - //mRecRefOwned := true; - mRecRef := rc; - mDefined := true; - exit; - end; - // other record types - if (pr.tokType = pr.TTId) then - begin - rec := def.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(); - //if mRecRefOwned then mRecRef.Free(); - //mRecRefOwned := false; - mRecRef := rec; + rc := rc.clone(mOwner.mHeaderRec); + rc.mHeaderRec := mOwner.mHeaderRec; + try + rc.parseBinValue(st, true); + mRecRef := rc; + rc := nil; + finally + rc.Free(); + end; mDefined := true; - pr.expectTT(pr.TTSemi); exit; end - else if (pr.tokType = pr.TTBegin) then + else begin - rec := def.findRec(mEBSTypeName); - if (rec = nil) then raise Exception.Create(Format('record type ''%s'' for field ''%s'' not found', [mEBSTypeName, mName])); - rc := rec.clone(); - rc.parseValue(pr); - //if mRecRefOwned then mRecRef.Free(); - //mRecRefOwned := true; - mRecRef := rc; - mDefined := true; - mOwner.mOwner.addRecordByType(mEBSTypeName, rc); - exit; + // not a trigger data + case mType of + TType.TByte: f := readShortInt(st); + TType.TUByte: f := readByte(st); + TType.TShort: f := readSmallInt(st); + TType.TUShort: f := readWord(st); + TType.TInt: f := readLongInt(st); + TType.TUInt: f := readLongWord(st); + else raise Exception.Create(Format('invalid non-numeric type ''%s'' for field ''%s'' of record ''%s''', [getTypeName(mType), mName, mEBSTypeName])); + end; + if mAsMonsterId then Dec(f); + if (f < 0) then mRecRefId := '' else mRecRefId := Format('%s%d', [mEBSTypeName, f]); + end; + mDefined := true; + exit; + end; + TEBS.TEnum, + TEBS.TBitSet: + begin + assert(mMaxDim < 0); + case mType of + TType.TByte: f := readShortInt(st); + TType.TUByte: f := readByte(st); + TType.TShort: f := readSmallInt(st); + TType.TUShort: f := readWord(st); + TType.TInt: f := readLongInt(st); + TType.TUInt: f := readLongWord(st); + else raise Exception.Create(Format('invalid non-numeric type ''%s'' for field ''%s'' of record ''%s''', [getTypeName(mType), mName, mEBSTypeName])); + end; + es := nil; + if (mEBSType <> nil) and (mEBSType is TDynEBS) then es := (mEBSType as TDynEBS); + if (es = nil) or (es.mIsEnum <> (mEBS = TEBS.TEnum)) then raise Exception.Create(Format('record enum type ''%s'' for field ''%s'' not found', [mEBSTypeName, mName])); + mIVal := f; + // build enum/bitfield values + if (mEBS = TEBS.TEnum) then + begin + mSVal := es.nameByValue(mIVal); + if (Length(mSVal) = 0) then raise Exception.Create(Format('record enum type ''%s'' for field ''%s'' has invalid value %d', [mEBSTypeName, mName, mIVal])); + end + else + begin + // special for 'none' + if (mIVal = 0) then + begin + mSVal := es.nameByValue(mIVal); + if (Length(mSVal) = 0) then raise Exception.Create(Format('record bitset type ''%s'' for field ''%s'' has invalid value %d', [mEBSTypeName, mName, mIVal])); + end + else + begin + mSVal := ''; + mask := 1; + while (mask <> 0) do + begin + if ((mIVal and mask) <> 0) then + begin + s := es.nameByValue(mask); + if (Length(s) = 0) then raise Exception.Create(Format('record bitset type ''%s'' for field ''%s'' has invalid value %d', [mEBSTypeName, mName, mask])); + if (Length(mSVal) <> 0) then mSVal += '+'; + mSVal += s; + end; + mask := mask shl 1; + end; + end; + end; + //writeln('ebs <', es.mName, '>: ', mSVal); + mDefined := true; + exit; + end; + else raise Exception.Create('ketmar forgot to handle some EBS type'); + end; + + case mType of + TType.TBool: + begin + f := readByte(st); + if (f <> 0) then f := 1; + if mNegBool then f := 1-f; + mIVal := f; + mDefined := true; + exit; + end; + TType.TChar: + begin + if (mMaxDim < 0) then + begin + mIVal := readByte(st); + end + else + begin + mSVal := ''; + GetMem(tdata, mMaxDim); + try + st.ReadBuffer(tdata^, mMaxDim); + f := 0; + while (f < mMaxDim) and (tdata[f] <> 0) do Inc(f); + if (f > 0) then + begin + SetLength(mSVal, f); + Move(tdata^, PChar(mSVal)^, f); + mSVal := win2utf(mSVal); + end; + finally + FreeMem(tdata); + end; + end; + mDefined := true; + exit; + end; + TType.TByte: begin mIVal := readShortInt(st); mDefined := true; exit; end; + TType.TUByte: begin mIVal := readByte(st); mDefined := true; exit; end; + TType.TShort: begin mIVal := readSmallInt(st); mDefined := true; exit; end; + TType.TUShort: begin mIVal := readWord(st); mDefined := true; exit; end; + TType.TInt: begin mIVal := readLongInt(st); mDefined := true; exit; end; + TType.TUInt: begin mIVal := readLongWord(st); mDefined := true; exit; end; + TType.TString: + begin + raise Exception.Create('cannot read strings from binaries yet'); + exit; + end; + TType.TPoint: + begin + mIVal := readLongInt(st); + mIVal2 := readLongInt(st); + mDefined := true; + exit; + end; + TType.TSize: + begin + mIVal := readWord(st); + mIVal2 := readWord(st); + mDefined := true; + 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; + raise Exception.Create(Format('cannot parse field ''%s'' yet', [mName])); +end; + + +procedure TDynField.parseValue (pr: TTextParser); + + procedure parseInt (min, max: Integer); + begin + mIVal := pr.expectInt(); + if (mIVal < min) or (mIVal > max) then raise Exception.Create(Format('invalid %s value for field ''%s''', [getTypeName(mType), mName])); + mDefined := true; + end; + +var + rec, rc: TDynRecord; + es: TDynEBS = nil; + tfld: TDynField; + tk: AnsiString; + edim: AnsiChar; +begin + if (pr.tokType = pr.TTEOF) then raise Exception.Create('field value expected'); + if (pr.tokType = pr.TTSemi) then raise Exception.Create('extra semicolon'); + // if this field should contain struct, convert type and parse struct + case mEBS of + TEBS.TNone: begin end; + TEBS.TRec: + begin + // ugly hack. sorry. + if (mType = TType.TTrigData) then + begin + 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.trigTypeField(); + if (tfld = nil) then raise Exception.Create(Format('triggerdata value for field ''%s'' in record ''%s'' without ''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(mOwner.mHeaderRec); + rc.mHeaderRec := mOwner.mHeaderRec; + //writeln(rc.definition); + try + rc.parseValue(pr, true); + mRecRef := rc; + rc := nil; + finally + rc.Free(); + end; + 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 + 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 := 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(mOwner.mHeaderRec); + rc.mHeaderRec := mOwner.mHeaderRec; + rc.parseValue(pr); + mRecRef := rc; + mDefined := true; + if mOwner.addRecordByType(mEBSTypeName, rc) then + begin + //raise Exception.Create(Format('record type ''%s'' for field ''%s'' not found', [mEBSTypeName, mName])); + e_LogWritefln('duplicate record with id ''%s'' for field ''%s'' in record ''%s''', [rc.mId, mName, mOwner.mName]); + end; + 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(mEBSTypeName); - if (es = nil) then raise Exception.Create(Format('record enum type ''%s'' for field ''%s'' not found', [mEBSTypeName, 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, mEBSTypeName, mName])); mIVal := es.field[tk]; @@ -1088,9 +1693,10 @@ begin end; TEBS.TBitSet: begin - def := mOwner.mOwner; - es := def.findEBS(mEBSTypeName); - if (es = nil) then raise Exception.Create(Format('record bitset type ''%s'' for field ''%s'' not found', [mEBSTypeName, 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 @@ -1186,27 +1792,19 @@ begin TType.TPoint, TType.TSize: begin - pr.expectDelim('('); + if pr.eatDelim('[') then edim := ']' else begin pr.expectDelim('('); edim := ')'; end; mIVal := pr.expectInt(); - if (mType = TType.TPoint) then - begin - if (mIVal < -32768) or (mIVal > 32767) then raise Exception.Create(Format('invalid %s value for field ''%s''', [getTypeName(mType), mName])); - end - else + if (mType = TType.TSize) then begin if (mIVal < 0) or (mIVal > 32767) then raise Exception.Create(Format('invalid %s value for field ''%s''', [getTypeName(mType), mName])); end; mIVal2 := pr.expectInt(); - if (mType = TType.TPoint) then - begin - if (mIVal2 < -32768) or (mIVal2 > 32767) then raise Exception.Create(Format('invalid %s value for field ''%s''', [getTypeName(mType), mName])); - end - else + if (mType = TType.TSize) then begin if (mIVal2 < 0) or (mIVal2 > 32767) then raise Exception.Create(Format('invalid %s value for field ''%s''', [getTypeName(mType), mName])); end; mDefined := true; - pr.expectDelim(')'); + pr.expectDelim(edim); pr.expectTT(pr.TTSemi); exit; end; @@ -1226,11 +1824,6 @@ begin end; -procedure TDynField.parseBinValue (st: TStream); -begin -end; - - // ////////////////////////////////////////////////////////////////////////// // constructor TDynRecord.Create (pr: TTextParser); begin @@ -1238,10 +1831,16 @@ begin mId := ''; mName := ''; mSize := 0; - mFields := nil; + mFields := TDynFieldList.Create(); + {$IF DEFINED(XDYNREC_USE_FIELDHASH)} + mFieldsHash := hashNewStrInt(); + {$ENDIF} mTrigTypes := nil; mHeader := false; + mHeaderRec := nil; mBinBlock := -1; + mTagInt := 0; + mTagPtr := nil; parseDef(pr); end; @@ -1250,30 +1849,100 @@ constructor TDynRecord.Create (); begin mName := ''; mSize := 0; - mFields := nil; + mFields := TDynFieldList.Create(); + {$IF DEFINED(XDYNREC_USE_FIELDHASH)} + mFieldsHash := hashNewStrInt(); + {$ENDIF} mTrigTypes := nil; mHeader := false; + mHeaderRec := nil; + mTagInt := 0; + mTagPtr := nil; + mRec2Free := nil; end; destructor TDynRecord.Destroy (); +var + fld: TDynField; + rec: TDynRecord; begin + if (mRec2Free <> nil) then + begin + for rec in mRec2Free do + begin + if (rec <> self) then + begin + //writeln('freeing: ', LongWord(rec)); + rec.Free(); + end; + end; + mRec2Free.Free(); + mRec2Free := nil; + end; mName := ''; + for fld in mFields do fld.Free(); + mFields.Free(); mFields := nil; + {$IF DEFINED(XDYNREC_USE_FIELDHASH)} + mFieldsHash.Free(); + mFieldsHash := nil; + {$ENDIF} mTrigTypes := nil; + mHeaderRec := nil; + mTagInt := 0; + mTagPtr := nil; inherited; end; +procedure TDynRecord.regrec (rec: TDynRecord); +begin + if (rec <> nil) and (rec <> self) then + begin + if (mRec2Free = nil) then mRec2Free := TDynRecList.Create(); + mRec2Free.append(rec); + end; +end; + + +procedure TDynRecord.addField (fld: TDynField); inline; +begin + if (fld = nil) then raise Exception.Create('cannot append nil field to record'); + mFields.append(fld); + {$IF DEFINED(XDYNREC_USE_FIELDHASH)} + if (Length(fld.mName) > 0) then mFieldsHash.put(fld.mName, mFields.count-1); + {$ENDIF} +end; + + +function TDynRecord.addFieldChecked (fld: TDynField): Boolean; inline; // `true`: duplicate name +begin + result := false; + if (fld = nil) then raise Exception.Create('cannot append nil field to record'); + {$IF not DEFINED(XDYNREC_USE_FIELDHASH)} + if (Length(fld.mName) > 0) then result := hasByName(fld.mName); + {$ENDIF} + mFields.append(fld); + {$IF DEFINED(XDYNREC_USE_FIELDHASH)} + if (Length(fld.mName) > 0) then result := mFieldsHash.put(fld.mName, mFields.count-1); + {$ENDIF} +end; + + function TDynRecord.findByName (const aname: AnsiString): Integer; inline; begin + {$IF DEFINED(XDYNREC_USE_FIELDHASH)} + if not mFieldsHash.get(aname, result) then result := -1; + {$ELSE} result := 0; - while (result < Length(mFields)) do + while (result < mFields.count) do begin - if (CompareText(aname, mFields[result].mName) = 0) then exit; + if StrEqu(aname, mFields[result].mName) then exit; Inc(result); end; result := -1; + {$ENDIF} end; @@ -1292,6 +1961,18 @@ begin end; +function TDynRecord.getFieldAt (idx: Integer): TDynField; inline; +begin + if (idx >= 0) and (idx < mFields.count) then result := mFields[idx] else result := nil; +end; + + +function TDynRecord.getCount (): Integer; inline; +begin + result := mFields.count; +end; + + function TDynRecord.getIsTrigData (): Boolean; inline; begin result := (Length(mTrigTypes) > 0); @@ -1303,13 +1984,26 @@ var f: Integer; begin result := true; - for f := 0 to High(mTrigTypes) do if (CompareText(mTrigTypes[f], aname) = 0) then exit; + for f := 0 to High(mTrigTypes) do if StrEqu(mTrigTypes[f], aname) then exit; result := false; end; -function TDynRecord.clone (): TDynRecord; +function TDynRecord.getForTrigCount (): Integer; inline; +begin + result := Length(mTrigTypes); +end; + + +function TDynRecord.getForTrigAt (idx: Integer): AnsiString; inline; +begin + if (idx >= 0) and (idx < Length(mTrigTypes)) then result := mTrigTypes[idx] else result := ''; +end; + + +function TDynRecord.clone (registerIn: TDynRecord): TDynRecord; var + fld: TDynField; f: Integer; begin result := TDynRecord.Create(); @@ -1320,14 +2014,156 @@ begin result.mSize := mSize; result.mHeader := mHeader; result.mBinBlock := mBinBlock; - SetLength(result.mFields, Length(mFields)); - for f := 0 to High(mFields) do + result.mHeaderRec := mHeaderRec; + result.mTagInt := mTagInt; + result.mTagPtr := mTagPtr; + if (mFields.count > 0) then begin - result.mFields[f] := mFields[f].clone(); - result.mFields[f].mOwner := result; + result.mFields.capacity := mFields.count; + for fld in mFields do result.addField(fld.clone(result, registerIn)); end; SetLength(result.mTrigTypes, Length(mTrigTypes)); for f := 0 to High(mTrigTypes) do result.mTrigTypes[f] := mTrigTypes[f]; + if (registerIn <> nil) then registerIn.regrec(result); +end; + + +function TDynRecord.findRecordByTypeId (const atypename, aid: AnsiString): TDynRecord; +var + fld: TDynField; + idx: 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 + if (fld.mRVal <> nil) then + begin + if fld.mRHash.get(aid, idx) then begin result := fld.mRVal[idx]; exit; end; + end; + // alas +end; + + +function TDynRecord.findRecordNumByType (const atypename: AnsiString; rc: TDynRecord): Integer; +var + fld: TDynField; + idx: 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 + if (fld.mRVal <> nil) then + begin + for idx := 0 to fld.mRVal.count-1 do + begin + if (fld.mRVal[idx] = rc) then begin result := idx; exit; end; + end; + end; + // alas +end; + + +function TDynRecord.addRecordByType (const atypename: AnsiString; rc: TDynRecord): Boolean; +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; + mHeaderRec.addField(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 + if (fld.mRVal = nil) then + begin + fld.mRVal := TDynRecList.Create(); + fld.mRHash := hashNewStrInt(); + end; + result := fld.addListItem(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 (mFields.count <> rec.mFields.count) then begin result := false; exit; end; + result := false; + for f := 0 to mFields.count-1 do + begin + if not mFields[f].isSimpleEqu(rec.mFields[f]) then exit; + end; + result := true; +end; + + +function TDynRecord.trigTypeField (): TDynField; +var + fld: TDynField; + es: TDynEBS = nil; +begin + for fld in mFields do + begin + if (fld.mEBS <> TDynField.TEBS.TEnum) then continue; + if not (fld.mEBSType is TDynEBS) then continue; + es := (fld.mEBSType as TDynEBS); + assert(es <> nil); + if StrEqu(es.mName, 'TriggerType') then begin result := fld; exit; end; + end; + result := nil; +end; + + +// number of records of the given instance +function TDynRecord.instanceCount (const typename: AnsiString): Integer; +var + fld: TDynField; +begin + result := 0; + fld := field[typename]; + if (fld <> nil) and (fld.mType = fld.TType.TList) then result := fld.mRVal.count; +end; + + +function TDynRecord.getUserVar (const aname: AnsiString): Variant; +var + fld: TDynField; +begin + fld := getFieldByName(aname); + if (fld = nil) then result := Unassigned else result := fld.varvalue; +end; + + +procedure TDynRecord.setUserVar (const aname: AnsiString; val: Variant); +var + fld: TDynField; +begin + fld := getFieldByName(aname); + if (fld = nil) then + begin + if (Length(aname) = 0) then raise Exception.Create('cannot create nameless user field'); + fld := TDynField.Create(aname, val); + fld.mOwner := self; + fld.mInternal := true; + addField(fld); + end + else + begin + fld.varvalue := val; + end; end; @@ -1357,6 +2193,7 @@ begin SetLength(mTrigTypes, 1); mTrigTypes[0] := tdn; end; + mName := 'TriggerData'; end else begin @@ -1389,18 +2226,44 @@ begin while (pr.tokType <> pr.TTEnd) do begin fld := TDynField.Create(pr); - if hasByName(fld.name) then begin fld.Free(); raise Exception.Create(Format('duplicate field ''%s''', [fld.name])); end; + //if hasByName(fld.name) then begin fld.Free(); raise Exception.Create(Format('duplicate field ''%s''', [fld.name])); end; // append fld.mOwner := self; - SetLength(mFields, Length(mFields)+1); - mFields[High(mFields)] := fld; + if addFieldChecked(fld) then + begin + fld.Free(); + raise Exception.Create(Format('duplicate field ''%s''', [fld.name])); + end; // done with field - //writeln('DEF: ', fld.definition); end; pr.expectTT(pr.TTEnd); end; +function TDynRecord.pasdef (): AnsiString; +var + fld: TDynField; +begin + if isTrigData then + begin + assert(false); + result := ''; + end + else + begin + // record + result := ' '+mPasName+' = packed record'#10; + end; + for fld in mFields do + begin + if fld.mInternal then continue; + if (fld.mBinOfs < 0) then continue; + result += ' '+fld.pasdef+#10; + end; + result += ' end;'#10; +end; + + function TDynRecord.definition (): AnsiString; var f: Integer; @@ -1427,12 +2290,12 @@ 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; result += ' {'#10; - for f := 0 to High(mFields) do + for f := 0 to mFields.count-1 do begin result += ' '; result += mFields[f].definition; @@ -1442,16 +2305,153 @@ begin end; -procedure TDynRecord.writeBinTo (st: TStream; trigbufsz: Integer=-1); +procedure TDynRecord.parseBinValue (st: TStream; forceData: Boolean=false); var + sign: string[4]; + btype: Integer; + bsize: Integer; + buf: PByte = nil; + loaded: array[0..255] of Boolean; + rec, rect: TDynRecord; fld: TDynField; - rec: TDynRecord; + f: Integer; + mst: TSFSMemoryChunkStream = nil; + + procedure linkNames (rec: TDynRecord); + var + fld: TDynField; + rt: TDynRecord; + begin + //writeln('*** rec: ', rec.mName, '.', rec.mId, ' (', rec.mFields.count, ')'); + for fld in rec.mFields do + begin + if (fld.mType = TDynField.TType.TTrigData) then + begin + if (fld.mRecRef <> nil) then linkNames(fld.mRecRef); + continue; + end; + if (Length(fld.mRecRefId) = 0) then continue; + assert(fld.mEBSType <> nil); + rt := findRecordByTypeId(fld.mEBSTypeName, fld.mRecRefId); + if (rt = nil) then + begin + e_LogWritefln('record of type ''%s'' with id ''%s'' links to inexistant record of type ''%s'' with id ''%s''', [rec.mName, rec.mId, fld.mEBSTypeName, fld.mRecRefId], MSG_WARNING); + //raise Exception.Create(Format('record of type ''%s'' with id ''%s'' links to inexistant record of type ''%s'' with id ''%s''', [rec.mName, rec.mId, fld.mEBSTypeName, fld.mRecRefId])); + end; + //writeln(' ', rec.mName, '.', rec.mId, ':', fld.mName, ' -> ', rt.mName, '.', rt.mId, ' (', fld.mEBSTypeName, '.', fld.mRecRefId, ')'); + fld.mRecRefId := ''; + fld.mRecRef := rt; + fld.mDefined := true; + end; + for fld in rec.mFields do + begin + //writeln(' ', fld.mName); + fld.fixDefaultValue(); // just in case + end; + end; + +begin + for f := 0 to High(loaded) do loaded[f] := false; + mst := TSFSMemoryChunkStream.Create(nil, 0); + try + if mHeader and not forceData then + begin + // parse map file as sequence of blocks + sign[0] := #4; + st.ReadBuffer(sign[1], 4); + if (sign <> 'MAP'#1) then raise Exception.Create('invalid binary map signature'); + // parse blocks + while (st.position < st.size) do + begin + btype := readByte(st); + if (btype = 0) then break; // no more blocks + readLongWord(st); // reserved + bsize := readLongInt(st); + {$IF DEFINED(D2D_XDYN_DEBUG)}writeln('btype=', btype, '; bsize=', bsize);{$ENDIF} + if (bsize < 0) or (bsize > $1fffffff) then raise Exception.Create(Format('block of type %d has invalid size %d', [btype, bsize])); + if loaded[btype] then raise Exception.Create(Format('block of type %d already loaded', [btype])); + loaded[btype] := true; + // find record type for this block + rect := nil; + for rec in mOwner.recTypes do if (rec.mBinBlock = btype) then begin rect := rec; break; end; + if (rect = nil) then raise Exception.Create(Format('block of type %d has no corresponding record', [btype])); + //writeln('found type ''', rec.mName, ''' for block type ', btype); + if (rec.mSize = 0) or ((bsize mod rec.mSize) <> 0) then raise Exception.Create(Format('block of type %d has invalid number of records', [btype])); + // header? + if (rect.mHeader) then + begin + if (bsize <> mSize) then raise Exception.Create(Format('header block of type %d has invalid number of records', [btype])); + GetMem(buf, bsize); + st.ReadBuffer(buf^, bsize); + mst.setup(buf, mSize); + parseBinValue(mst, true); // force parsing data + end + else + begin + // create list for this type + fld := TDynField.Create(rec.mName, TDynField.TType.TList); + fld.mOwner := self; + addField(fld); + if (bsize > 0) then + begin + GetMem(buf, bsize); + st.ReadBuffer(buf^, bsize); + for f := 0 to (bsize div rec.mSize)-1 do + begin + mst.setup(buf+f*rec.mSize, rec.mSize); + rec := rect.clone(self); + rec.mHeaderRec := self; + rec.parseBinValue(mst); + rec.mId := Format('%s%d', [rec.mName, f]); + fld.addListItem(rec); + //writeln('parsed ''', rec.mId, '''...'); + end; + end; + end; + FreeMem(buf); + buf := nil; + //st.position := st.position+bsize; + end; + // link fields + for fld in mFields do + begin + if (fld.mType <> TDynField.TType.TList) then continue; + for rec in fld.mRVal do linkNames(rec); + end; + exit; + end; + + // read fields + if StrEqu(mName, 'TriggerData') then mSize := Integer(st.size-st.position); + if (mSize < 1) then raise Exception.Create(Format('cannot read record of type ''%s'' with unknown size', [mName])); + GetMem(buf, mSize); + st.ReadBuffer(buf^, mSize); + for fld in mFields do + begin + if fld.mInternal then continue; + if (fld.mBinOfs < 0) then continue; + if (fld.mBinOfs >= st.size) then raise Exception.Create(Format('record of type ''%s'' has invalid field ''%s''', [fld.mName])); + mst.setup(buf+fld.mBinOfs, mSize-fld.mBinOfs); + //writeln('parsing ''', mName, '.', fld.mName, '''...'); + fld.parseBinValue(mst); + end; + finally + mst.Free(); + if (buf <> nil) then FreeMem(buf); + end; +end; + + +procedure TDynRecord.writeBinTo (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; - oldh: TDynRecord; + //f, c: Integer; bufsz: Integer = 0; + blksz: Integer; begin if (trigbufsz < 0) then begin @@ -1463,35 +2463,28 @@ begin begin bufsz := trigbufsz; end; - oldh := mOwner.curheader; - if mHeader then - begin - if (mOwner.curheader <> nil) then raise Exception.Create('`writeBinTo()` cannot be called recursively'); - mOwner.curheader := self; - end; try GetMem(buf, bufsz); FillChar(buf^, bufsz, 0); ws := TSFSMemoryChunkStream.Create(buf, bufsz); // write normal fields - for f := 0 to High(mFields) do + for fld in 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, '>'); + //writeln('writing field <', fld.mName, '>'); fld.writeBinTo(ws); end; // write block with normal fields - if mHeader then + if mHeader and not onlyFields then begin - writeln('writing header...'); + //writeln('writing header...'); // signature and version writeIntBE(st, LongWord($4D415001)); writeInt(st, Byte(mBinBlock)); // type @@ -1504,18 +2497,17 @@ begin FreeMem(buf); buf := nil; // write other blocks, if any - if mHeader then + if mHeader and not onlyFields then begin // calculate blkmax blkmax := 0; - for f := 0 to High(mFields) do + for fld in 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.findRec(fld.mName); + if (fld.mRVal = nil) or (fld.mRVal.count = 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; @@ -1526,36 +2518,38 @@ begin begin if (blk = mBinBlock) then continue; ws := nil; - for f := 0 to High(mFields) do + for fld in 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.findRec(fld.mName); + if (fld.mRVal = nil) or (fld.mRVal.count = 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); + for rv in fld.mRVal do rv.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; end; + // write end marker + writeInt(st, Byte(0)); + writeInt(st, LongWord(0)); + writeInt(st, LongWord(0)); end; finally - mOwner.curheader := oldh; ws.Free(); if (buf <> nil) then FreeMem(buf); end; @@ -1564,8 +2558,8 @@ end; procedure TDynRecord.writeTo (wr: TTextWriter; putHeader: Boolean=true); var - f, c: Integer; fld: TDynField; + rec: TDynRecord; begin if putHeader then begin @@ -1576,17 +2570,20 @@ begin wr.put('{'#10); wr.indent(); try - for f := 0 to High(mFields) do + for fld in mFields do begin - fld := mFields[f]; // record list? if (fld.mType = fld.TType.TList) then begin if not mHeader then raise Exception.Create('record list in non-header record'); - for c := 0 to High(fld.mRVal) do + if (fld.mRVal <> nil) then begin - wr.putIndent(); - fld.mRVal[c].writeTo(wr, true); + for rec in fld.mRVal do + begin + if (Length(rec.mId) = 0) then continue; + wr.putIndent(); + rec.writeTo(wr, true); + end; end; continue; end; @@ -1603,111 +2600,123 @@ begin end; -procedure TDynRecord.parseValue (pr: TTextParser; asheader: Boolean=false); +{$IF DEFINED(D2D_DYNREC_PROFILER)} +var + profCloneRec: UInt64 = 0; + profFindRecType: UInt64 = 0; + profFieldSearching: UInt64 = 0; + profListDupChecking: UInt64 = 0; + profAddRecByType: UInt64 = 0; + profFieldValParsing: UInt64 = 0; + profFixDefaults: UInt64 = 0; + profRecValParse: UInt64 = 0; + +procedure xdynDumpProfiles (); +begin + writeln('=== XDYNREC PROFILES ==='); + writeln('record cloning: ', profCloneRec div 1000, '.', profCloneRec mod 1000, ' milliseconds'); + writeln('findRecType : ', profFindRecType div 1000, '.', profFindRecType mod 1000, ' milliseconds'); + writeln('field[] : ', profFieldSearching div 1000, '.', profFieldSearching mod 1000, ' milliseconds'); + writeln('list dup check: ', profListDupChecking div 1000, '.', profListDupChecking mod 1000, ' milliseconds'); + writeln('addRecByType : ', profAddRecByType div 1000, '.', profAddRecByType mod 1000, ' milliseconds'); + writeln('field valparse: ', profFieldValParsing div 1000, '.', profFieldValParsing mod 1000, ' milliseconds'); + writeln('fix defaults : ', profFixDefaults div 1000, '.', profFixDefaults mod 1000, ' milliseconds'); + writeln('recvalparse : ', profRecValParse div 1000, '.', profRecValParse mod 1000, ' milliseconds'); +end; +{$ENDIF} + + +procedure TDynRecord.parseValue (pr: TTextParser; beginEaten: Boolean=false); var - f, c: Integer; fld: TDynField; - rec, trc: TDynRecord; - //success: Boolean; + rec: TDynRecord = nil; + trc{, rv}: TDynRecord; + {$IF DEFINED(D2D_DYNREC_PROFILER)} + stt, stall: UInt64; + {$ENDIF} begin if (mOwner = nil) then raise Exception.Create(Format('can''t parse record ''%s'' value without owner', [mName])); - if not asheader then + {$IF DEFINED(D2D_DYNREC_PROFILER)}stall := curTimeMicro();{$ENDIF} + + // 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); // add records with this type (if any) - trc := mOwner.findRec(pr.tokStr); + {$IF DEFINED(D2D_DYNREC_PROFILER)}stt := curTimeMicro();{$ENDIF} + trc := mOwner.findRecType(pr.tokStr); + {$IF DEFINED(D2D_DYNREC_PROFILER)}profFindRecType := curTimeMicro()-stt;{$ENDIF} if (trc <> nil) then begin - rec := trc.clone(); + {$IF DEFINED(D2D_DYNREC_PROFILER)}stt := curTimeMicro();{$ENDIF} + rec := trc.clone(mHeaderRec); + {$IF DEFINED(D2D_DYNREC_PROFILER)}profCloneRec := curTimeMicro()-stt;{$ENDIF} + rec.mHeaderRec := mHeaderRec; try pr.skipToken(); rec.parseValue(pr); + (* if (Length(rec.mId) > 0) then begin + {$IF DEFINED(D2D_DYNREC_PROFILER)}stt := curTimeMicro();{$ENDIF} fld := field[pr.tokStr]; - if (fld <> nil) then + {$IF DEFINED(D2D_DYNREC_PROFILER)}profFieldSearching := curTimeMicro()-stt;{$ENDIF} + (* + if (fld <> nil) and (fld.mRVal <> 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; + {$IF DEFINED(D2D_DYNREC_PROFILER)}stt := curTimeMicro();{$ENDIF} + //idtmp := trc.mName+':'+rec.mId; + //if ids.put(idtmp, 1) then raise Exception.Create(Format('duplicate thing ''%s'' in record ''%s''', [fld.mName, mName])); + if fld.mRHash.has(rec.mId) then raise Exception.Create(Format('duplicate thing ''%s'' in record ''%s''', [fld.mName, mName])); + {$IF DEFINED(D2D_DYNREC_PROFILER)}profListDupChecking := curTimeMicro()-stt;{$ENDIF} end; end; - mOwner.addRecordByType(rec.mName, rec); + *) + {$IF DEFINED(D2D_DYNREC_PROFILER)}stt := curTimeMicro();{$ENDIF} + addRecordByType(rec.mName, rec); + {$IF DEFINED(D2D_DYNREC_PROFILER)}profAddRecByType := curTimeMicro()-stt;{$ENDIF} rec := nil; finally rec.Free(); end; continue; end; - { - success := false; - for f := 0 to High(mOwner.records) do - 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 - 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 - 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; - end; - end; - if success then continue; - } end; // fields + {$IF DEFINED(D2D_DYNREC_PROFILER)}stt := curTimeMicro();{$ENDIF} + //writeln('0: <', mName, '.', pr.tokStr, '>'); fld := field[pr.tokStr]; + //writeln('1: <', mName, '.', pr.tokStr, '>'); + {$IF DEFINED(D2D_DYNREC_PROFILER)}profFieldSearching := curTimeMicro()-stt;{$ENDIF} if (fld <> nil) then begin + //writeln('2: <', mName, '.', pr.tokStr, '>'); 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(); + pr.skipToken(); // skip field name + //writeln('3: <', mName, '.', pr.tokStr, '>:', pr.tokType); + {$IF DEFINED(D2D_DYNREC_PROFILER)}stt := curTimeMicro();{$ENDIF} fld.parseValue(pr); + {$IF DEFINED(D2D_DYNREC_PROFILER)}profFieldValParsing := curTimeMicro()-stt;{$ENDIF} continue; end; @@ -1716,13 +2725,12 @@ begin end; pr.expectTT(pr.TTEnd); // fix field defaults - for f := 0 to High(mFields) do mFields[f].fixDefaultValue(); - writeln('done parsing record <', mName, '>'); -end; - - -procedure TDynRecord.parseBinValue (st: TStream); -begin + {$IF DEFINED(D2D_DYNREC_PROFILER)}stt := curTimeMicro();{$ENDIF} + for fld in mFields do fld.fixDefaultValue(); + {$IF DEFINED(D2D_DYNREC_PROFILER)}profFixDefaults := curTimeMicro()-stt;{$ENDIF} + //writeln('done parsing record <', mName, '>'); + //{$IF DEFINED(D2D_DYNREC_PROFILER)}writeln('stall: ', curTimeMicro()-stall);{$ENDIF} + {$IF DEFINED(D2D_DYNREC_PROFILER)}profRecValParse := curTimeMicro()-stall;{$ENDIF} end; @@ -1757,7 +2765,7 @@ begin result := 0; while (result < Length(mIds)) do begin - if (CompareText(aname, mIds[result]) = 0) then exit; + if StrEqu(aname, mIds[result]) then exit; Inc(result); end; result := -1; @@ -1810,6 +2818,31 @@ begin end; +function TDynEBS.pasdef (): AnsiString; +var + f: Integer; +begin + result := '// '+mName+#10'const'#10; + // fields + for f := 0 to High(mIds) do + begin + result += formatstrf(' %s = %d;'#10, [mIds[f], mVals[f]]); + end; +end; + + +function TDynEBS.nameByValue (v: Integer): AnsiString; +var + f: Integer; +begin + for f := 0 to High(mVals) do + begin + if (mVals[f] = v) then begin result := mIds[f]; exit; end; + end; + result := ''; +end; + + procedure TDynEBS.parseDef (pr: TTextParser); var idname: AnsiString; @@ -1830,9 +2863,9 @@ begin idname := pr.expectId(); for f := 0 to High(mIds) do begin - if (CompareText(mIds[f], idname) = 0) then raise Exception.Create(Format('duplicate field ''%s'' in enum/bitset ''%s''', [idname, mName])); + if StrEqu(mIds[f], idname) then raise Exception.Create(Format('duplicate field ''%s'' in enum/bitset ''%s''', [idname, mName])); end; - if (CompareText(mMaxName, idname) = 0) then raise Exception.Create(Format('duplicate field ''%s'' in enum/bitset ''%s''', [idname, mName])); + if StrEqu(mMaxName, idname) then raise Exception.Create(Format('duplicate field ''%s'' in enum/bitset ''%s''', [idname, mName])); skipAdd := false; hasV := false; v := cv; @@ -1889,163 +2922,115 @@ end; // ////////////////////////////////////////////////////////////////////////// // constructor TDynMapDef.Create (pr: TTextParser); begin - records := nil; - trigDatas := nil; - ebs := nil; - curheader := nil; + recTypes := TDynRecList.Create(); + trigTypes := TDynRecList.Create(); + ebsTypes := TDynEBSList.Create(); parseDef(pr); end; destructor TDynMapDef.Destroy (); var - f: Integer; + rec: TDynRecord; + ebs: TDynEBS; 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 rec in recTypes do rec.Free(); + for rec in trigTypes do rec.Free(); + for ebs in ebsTypes do ebs.Free(); + recTypes.Free(); + trigTypes.Free(); + ebsTypes.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 (recTypes.count = 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; + rec: TDynRecord; begin - for f := 0 to High(records) do + for rec in recTypes do begin - if (CompareText(records[f].name, aname) = 0) then begin result := records[f]; exit; end; + if StrEqu(rec.name, aname) then begin result := rec; exit; end; end; result := nil; end; -function TDynMapDef.findTrigDataFor (const aname: AnsiString): TDynRecord; +function TDynMapDef.findTrigFor (const aname: AnsiString): TDynRecord; var - f: Integer; + rec: TDynRecord; begin - for f := 0 to High(trigDatas) do + for rec in trigTypes do begin - if (trigDatas[f].isForTrig[aname]) then begin result := trigDatas[f]; exit; end; + if (rec.isForTrig[aname]) then begin result := rec; exit; end; end; result := nil; end; -function TDynMapDef.findEBS (const aname: AnsiString): TDynEBS; +function TDynMapDef.findEBSType (const aname: AnsiString): TDynEBS; var - f: Integer; + ebs: TDynEBS; begin - for f := 0 to High(ebs) do + for ebs in ebsTypes do begin - if (CompareText(ebs[f].name, aname) = 0) then begin result := ebs[f]; exit; end; + if StrEqu(ebs.name, aname) then begin result := ebs; exit; end; end; result := nil; end; -function TDynMapDef.findRecordByTypeId (const atypename, aid: AnsiString): TDynRecord; +procedure TDynMapDef.parseDef (pr: TTextParser); var - rec: TDynRecord; - fld: TDynField; + rec, hdr: TDynRecord; + eb: TDynEBS; 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 + fld: TDynField; begin - if (CompareText(fld.mRVal[f].mId, aid) = 0) then + rec.mHeaderRec := recTypes[0]; + for fld in rec.mFields do begin - //writeln(' FOUND!'); - result := fld.mRVal[f]; - exit; + 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; - -procedure TDynMapDef.addRecordByType (const atypename: AnsiString; rc: TDynRecord); -var - rec: TDynRecord; - fld: TDynField; -begin - assert(curheader <> nil); - // find record type - rec := findRec(atypename); - assert(rec <> nil); - // find record data - //writeln('searching for data of type <', atypename, '>'); - fld := curheader.field[atypename]; - if (fld = nil) then + // setup default values + procedure fixRecordDefaults (rec: TDynRecord); + var + fld: TDynField; 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): Integer; -var - rec: TDynRecord; - fld: TDynField; - f: Integer; -begin - result := -1; - if (curheader = nil) then exit; - // find record type - rec := findRec(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; + for fld in rec.mFields do if fld.mHasDefault then fld.parseDefaultValue(); end; - // alas -end; - -procedure TDynMapDef.parseDef (pr: TTextParser); -var - dr, hdr: TDynRecord; - eb: TDynEBS; - f: Integer; begin hdr := nil; while true do @@ -2056,57 +3041,63 @@ 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; + ebsTypes.append(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; + trigTypes.append(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 StrEqu(rec.name, hdr.name) 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; + recTypes.append(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; + recTypes.append(nil); + for f := recTypes.count-1 downto 1 do recTypes[f] := recTypes[f-1]; + recTypes[0] := hdr; + + // setup header links and type links + for rec in recTypes do linkRecord(rec); + for rec in trigTypes do linkRecord(rec); + + // setup default values + for rec in recTypes do fixRecordDefaults(rec); + for rec in trigTypes do fixRecordDefaults(rec); end; @@ -2115,26 +3106,97 @@ 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(nil); + res.mHeaderRec := res; + res.parseValue(pr); result := res; res := nil; finally - curheader := nil; res.Free(); end; end; function TDynMapDef.parseBinMap (st: TStream): TDynRecord; +var + res: TDynRecord = nil; begin result := nil; + try + res := headerType.clone(nil); + res.mHeaderRec := res; + res.parseBinValue(st); + result := res; + res := nil; + finally + res.Free(); + end; +end; + + +function TDynMapDef.pasdef (): AnsiString; +var + ebs: TDynEBS; + rec: TDynRecord; + fld: TDynField; + needComma: Boolean; + tn: AnsiString; +begin + result := ''; + result += '// ////////////////////////////////////////////////////////////////////////// //'#10; + result += '// enums and bitsets'#10; + for ebs in ebsTypes do result += #10+ebs.pasdef(); + result += #10#10'// ////////////////////////////////////////////////////////////////////////// //'#10; + result += '// records'#10'type'#10; + for rec in recTypes do + begin + if (rec.mSize < 1) then continue; + result += rec.pasdef(); + result += #10; + end; + result += #10#10'// ////////////////////////////////////////////////////////////////////////// //'#10; + result += '// triggerdata'#10'type'#10; + result += ' TTriggerData = record'#10; + result += ' case Byte of'#10; + result += ' 0: (Default: Byte128);'#10; + for rec in trigTypes do + begin + result += ' '; + needComma := false; + for tn in rec.mTrigTypes do + begin + if needComma then result += ', ' else needComma := true; + result += tn; + end; + result += ': ('#10; + for fld in rec.mFields do + begin + if fld.mInternal then continue; + if (fld.mBinOfs < 0) then continue; + result += ' '+fld.pasdef+#10; + end; + result += ' );'#10; + end; + result += ' end;'#10; end; +function TDynMapDef.pasdefconst (): AnsiString; +var + ebs: TDynEBS; +begin + result := ''; + result += '// ////////////////////////////////////////////////////////////////////////// //'#10; + result += '// enums and bitsets'#10; + for ebs in ebsTypes do result += #10+ebs.pasdef(); +end; + + +function TDynMapDef.getTrigTypeCount (): Integer; inline; begin result := trigTypes.count; end; +function TDynMapDef.getTrigTypeAt (idx: Integer): TDynRecord; inline; begin if (idx >= 0) and (idx < trigTypes.count) then result := trigTypes[idx] else result := nil; end; + + end.