X-Git-Url: https://deadsoftware.ru/gitweb?a=blobdiff_plain;f=src%2Fshared%2Fxdynrec.pas;h=d82867e7d504dd34ad0d1a152a9ffe7a872069d6;hb=51bbf0eef2641d7766e22e188d6c349d9b836023;hp=3a31a9663c9c96ef3e0bd3d3ba2d5c8603dc679f;hpb=223356cbae3197afc861efa6241c4ae91bd92885;p=d2df-sdl.git diff --git a/src/shared/xdynrec.pas b/src/shared/xdynrec.pas index 3a31a96..d82867e 100644 --- a/src/shared/xdynrec.pas +++ b/src/shared/xdynrec.pas @@ -14,13 +14,14 @@ * 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, utils; + Variants, Classes, + xparser, xstreams, utils, hashtable; // ////////////////////////////////////////////////////////////////////////// // @@ -45,9 +46,6 @@ type // TTrigData: array of mMaxDim bytes, but internally a record (mRecRef) // arrays of chars are pascal shortstrings (with counter in the first byte) - TDynFieldArray = array of TDynField; - TDynRecordArray = array of TDynRecord; - private type TEBS = (TNone, TRec, TEnum, TBitSet); @@ -61,10 +59,10 @@ type mIVal2: Integer; // for point and size mSVal: AnsiString; // string; for byte and char arrays 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; @@ -73,6 +71,7 @@ type mInternal: Boolean; 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 @@ -85,6 +84,10 @@ type // for binary parser mRecRefId: AnsiString; + // for userdata + mTagInt: Integer; + mTagPtr: Pointer; + private procedure cleanup (); @@ -94,16 +97,33 @@ type 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; + + 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 (newOwner: TDynRecord=nil): TDynField; + function clone (newOwner: TDynRecord=nil; registerIn: TDynRecord=nil): TDynField; procedure parseValue (pr: TTextParser); procedure parseBinValue (st: TStream); @@ -116,24 +136,37 @@ type 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 ival: Integer read mIVal; + property hasTPrefix: Boolean read mAsT; + property separatePasFields: Boolean read mSepPosSize; + property binOfs: Integer read mBinOfs; + property ival: Integer read mIVal write setIVal; + property ival2: Integer read mIVal2; property sval: AnsiString read mSVal; property hasDefault: Boolean read mHasDefault; property defsval: AnsiString read mDefSVal; property ebs: TEBS read mEBS; property ebstype: TObject read mEBSType; property ebstypename: AnsiString read mEBSTypeName; // enum/bitset name - - property x: Integer read mIVal; - property w: Integer read mIVal; - property y: Integer read mIVal2; - property h: Integer read mIVal2; + 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; @@ -146,25 +179,44 @@ type mName: AnsiString; mSize: Integer; 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 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; - procedure addRecordByType (const atypename: AnsiString; rc: TDynRecord); + 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 (); @@ -172,8 +224,9 @@ type destructor Destroy (); override; function definition (): AnsiString; + function pasdef (): AnsiString; - function clone (): TDynRecord; + function clone (registerIn: TDynRecord): TDynRecord; function isSimpleEqu (rec: TDynRecord): Boolean; @@ -181,24 +234,44 @@ type 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: TDynFieldList read 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; @@ -223,6 +296,7 @@ type destructor Destroy (); override; function definition (): AnsiString; + function pasdef (): AnsiString; // return empty string if not found function nameByValue (v: Integer): AnsiString; @@ -246,6 +320,9 @@ type 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; @@ -254,6 +331,9 @@ type 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; @@ -262,13 +342,33 @@ type public 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; + 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; // ////////////////////////////////////////////////////////////////////////// // @@ -276,10 +376,15 @@ constructor TDynField.Create (const aname: AnsiString; atype: TType); begin mRVal := nil; mRecRef := nil; + mRHash := nil; cleanup(); mName := aname; mType := atype; - if (mType = TType.TList) then mRVal := TDynRecList.Create(); + if (mType = TType.TList) then + begin + mRVal := TDynRecList.Create(); + mRHash := hashNewStrInt(); + end; end; @@ -290,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(); @@ -306,10 +477,11 @@ begin mSVal := ''; mRVal.Free(); mRVal := nil; + mRHash.Free(); + mRHash := nil; mRecRef := nil; mMaxDim := -1; mBinOfs := -1; - mRecOfs := -1; mSepPosSize := false; mAsT := false; mHasDefault := false; @@ -325,13 +497,15 @@ begin mEBSTypeName := ''; mEBSType := nil; mBitSetUnique := false; + mAsMonsterId := false; mNegBool := false; mRecRefId := ''; - if (mType = TType.TList) then mRVal := TDynRecList.Create(); + mTagInt := 0; + mTagPtr := nil; end; -function TDynField.clone (newOwner: TDynRecord=nil): TDynField; +function TDynField.clone (newOwner: TDynRecord=nil; registerIn: TDynRecord=nil): TDynField; var rec: TDynRecord; begin @@ -346,17 +520,13 @@ begin result.mSVal := mSVal; if (mRVal <> nil) then begin - result.mRVal := TDynRecList.Create(mRVal.count); - for rec in mRVal do result.mRVal.append(rec.clone()); - end - else - begin - if (mType = TType.TList) then result.mRVal := TDynRecList.Create() else result.mRVal := nil; + 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; @@ -365,6 +535,7 @@ begin result.mInternal := mInternal; result.mNegBool := mNegBool; result.mBitSetUnique := mBitSetUnique; + result.mAsMonsterId := mAsMonsterId; result.mDefUnparsed := mDefUnparsed; result.mDefSVal := mDefSVal; result.mDefIVal := mDefIVal; @@ -374,6 +545,128 @@ begin result.mEBSTypeName := mEBSTypeName; 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.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; @@ -491,6 +784,37 @@ begin 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; + + class function TDynField.getTypeName (t: TType): AnsiString; begin case t of @@ -517,13 +841,14 @@ begin 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 mAsMonsterId then result += ' as monsterid'; if mHasDefault and (Length(mDefUnparsed) > 0) then result += ' default '+mDefUnparsed; if mSepPosSize then begin @@ -535,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; @@ -546,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 := ''; @@ -566,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; @@ -605,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; @@ -645,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; @@ -698,17 +1064,22 @@ begin end; if hasdefStr then self.mDefUnparsed := quoteStr(defstr) - else if hasdefInt then self.mDefUnparsed := Format('%d', [defint]) - else if hasdefId then self.mDefUnparsed := defstr; + else if hasdefId then self.mDefUnparsed := defstr + else if hasdefInt then + begin + 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); self.mPasName := fldpasname; 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; @@ -716,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; @@ -753,17 +1131,6 @@ begin exit; end; // record reference - if (mRecRef = nil) then - begin - // no ref, write -1 - case mType of - TType.TByte, TType.TUByte: writeInt(st, Byte(-1)); - TType.TShort, TType.TUShort: writeInt(st, SmallInt(-1)); - TType.TInt, TType.TUInt: writeInt(st, Integer(-1)); - else raise Exception.Create(Format('record reference type ''%s'' in field ''%s'' cannot be written', [mEBSTypeName, mName])); - end; - exit; - end; case mType of TType.TByte: maxv := 127; TType.TUByte: maxv := 254; @@ -774,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.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; @@ -1019,6 +1394,7 @@ begin raise Exception.Create(Format('cannot parse field ''%s'' yet', [mName])); end; + procedure TDynField.parseBinValue (st: TStream); var rec, rc: TDynRecord; @@ -1042,7 +1418,7 @@ begin 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 := rc.clone(mOwner.mHeaderRec); rc.mHeaderRec := mOwner.mHeaderRec; try rc.parseBinValue(st, true); @@ -1066,6 +1442,7 @@ begin 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; @@ -1220,6 +1597,8 @@ var 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; @@ -1243,7 +1622,7 @@ begin 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(); + rc := rc.clone(mOwner.mHeaderRec); rc.mHeaderRec := mOwner.mHeaderRec; //writeln(rc.definition); try @@ -1282,12 +1661,16 @@ begin rec := nil; if (mEBSType <> nil) and (mEBSType is TDynRecord) then rec := (mEBSType as TDynRecord); if (rec = nil) then raise Exception.Create(Format('record type ''%s'' for field ''%s'' not found', [mEBSTypeName, mName])); - rc := rec.clone(); + rc := rec.clone(mOwner.mHeaderRec); rc.mHeaderRec := mOwner.mHeaderRec; rc.parseValue(pr); mRecRef := rc; mDefined := true; - mOwner.addRecordByType(mEBSTypeName, rc); + 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; @@ -1449,10 +1832,15 @@ begin mName := ''; mSize := 0; 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; @@ -1462,32 +1850,99 @@ begin mName := ''; mSize := 0; 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 < 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; @@ -1506,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); @@ -1517,12 +1984,24 @@ 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; @@ -1533,23 +2012,26 @@ begin result.mPasName := mPasName; result.mName := mName; result.mSize := mSize; + result.mHeader := mHeader; + result.mBinBlock := mBinBlock; + result.mHeaderRec := mHeaderRec; + result.mTagInt := mTagInt; + result.mTagPtr := mTagPtr; if (mFields.count > 0) then begin result.mFields.capacity := mFields.count; - for fld in mFields do result.mFields.append(fld.clone(result)); + 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]; - result.mHeader := mHeader; - result.mBinBlock := mBinBlock; - result.mHeaderRec := mHeaderRec; + if (registerIn <> nil) then registerIn.regrec(result); end; function TDynRecord.findRecordByTypeId (const atypename, aid: AnsiString): TDynRecord; var fld: TDynField; - rec: TDynRecord; + idx: Integer; begin result := nil; if (Length(aid) = 0) then exit; @@ -1560,10 +2042,7 @@ begin // find by id if (fld.mRVal <> nil) then begin - for rec in fld.mRVal do - begin - if (CompareText(rec.mId, aid) = 0) then begin result := rec; exit; end; - end; + if fld.mRHash.get(aid, idx) then begin result := fld.mRVal[idx]; exit; end; end; // alas end; @@ -1572,7 +2051,7 @@ end; function TDynRecord.findRecordNumByType (const atypename: AnsiString; rc: TDynRecord): Integer; var fld: TDynField; - f: Integer; + idx: Integer; begin result := -1; // find record data @@ -1582,16 +2061,16 @@ begin // find by ref if (fld.mRVal <> nil) then begin - for f := 0 to fld.mRVal.count-1 do + for idx := 0 to fld.mRVal.count-1 do begin - if (fld.mRVal[f] = rc) then begin result := f; exit; end; + if (fld.mRVal[idx] = rc) then begin result := idx; exit; end; end; end; // alas end; -procedure TDynRecord.addRecordByType (const atypename: AnsiString; rc: TDynRecord); +function TDynRecord.addRecordByType (const atypename: AnsiString; rc: TDynRecord): Boolean; var fld: TDynField; begin @@ -1602,12 +2081,16 @@ begin // first record fld := TDynField.Create(atypename, TDynField.TType.TList); fld.mOwner := mHeaderRec; - mHeaderRec.mFields.append(fld); + 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 fld.mRVal := TDynRecList.Create(); - fld.mRVal.append(rc); + if (fld.mRVal = nil) then + begin + fld.mRVal := TDynRecList.Create(); + fld.mRHash := hashNewStrInt(); + end; + result := fld.addListItem(rc); end; @@ -1638,12 +2121,52 @@ begin if not (fld.mEBSType is TDynEBS) then continue; es := (fld.mEBSType as TDynEBS); assert(es <> nil); - if (CompareText(es.mName, 'TriggerType') = 0) then begin result := fld; exit; end; + 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; + + procedure TDynRecord.parseDef (pr: TTextParser); var fld: TDynField; @@ -1703,16 +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; - mFields.append(fld); + if addFieldChecked(fld) then + begin + fld.Free(); + raise Exception.Create(Format('duplicate field ''%s''', [fld.name])); + end; // done with field 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; @@ -1782,7 +2333,11 @@ var if (Length(fld.mRecRefId) = 0) then continue; assert(fld.mEBSType <> nil); rt := findRecordByTypeId(fld.mEBSTypeName, fld.mRecRefId); - if (rt = nil) then raise Exception.Create(Format('record of type ''%s'' with id ''%s'' links to inexistant record of type ''%s'' with id ''%d''', [rec.mName, rec.mId, 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; @@ -1812,7 +2367,7 @@ begin if (btype = 0) then break; // no more blocks readLongWord(st); // reserved bsize := readLongInt(st); - writeln('btype=', btype, '; bsize=', bsize); + {$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; @@ -1820,7 +2375,7 @@ begin 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); + //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 @@ -1836,7 +2391,7 @@ begin // create list for this type fld := TDynField.Create(rec.mName, TDynField.TType.TList); fld.mOwner := self; - mFields.append(fld); + addField(fld); if (bsize > 0) then begin GetMem(buf, bsize); @@ -1844,11 +2399,11 @@ begin for f := 0 to (bsize div rec.mSize)-1 do begin mst.setup(buf+f*rec.mSize, rec.mSize); - rec := rect.clone(); + rec := rect.clone(self); rec.mHeaderRec := self; rec.parseBinValue(mst); rec.mId := Format('%s%d', [rec.mName, f]); - fld.mRVal.append(rec); + fld.addListItem(rec); //writeln('parsed ''', rec.mId, '''...'); end; end; @@ -1867,7 +2422,7 @@ begin end; // read fields - if (CompareText(mName, 'TriggerData') = 0) then mSize := Integer(st.size-st.position); + 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); @@ -1887,7 +2442,7 @@ begin end; -procedure TDynRecord.writeBinTo (st: TStream; trigbufsz: Integer=-1); +procedure TDynRecord.writeBinTo (st: TStream; trigbufsz: Integer=-1; onlyFields: Boolean=false); var fld: TDynField; rec, rv: TDynRecord; @@ -1927,7 +2482,7 @@ begin end; // write block with normal fields - if mHeader then + if mHeader and not onlyFields then begin //writeln('writing header...'); // signature and version @@ -1942,7 +2497,7 @@ begin FreeMem(buf); buf := nil; // write other blocks, if any - if mHeader then + if mHeader and not onlyFields then begin // calculate blkmax blkmax := 0; @@ -2045,13 +2600,45 @@ begin end; +{$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 fld: TDynField; - rec, trc, rv: TDynRecord; + 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 DEFINED(D2D_DYNREC_PROFILER)}stall := curTimeMicro();{$ENDIF} + // not a header? if not mHeader then begin @@ -2074,26 +2661,38 @@ begin if mHeader then begin // add records with this type (if any) + {$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 DEFINED(D2D_DYNREC_PROFILER)}profFieldSearching := curTimeMicro()-stt;{$ENDIF} + (* if (fld <> nil) and (fld.mRVal <> nil) then begin - for rv in fld.mRVal do - begin - if (Length(rv.mId) > 0) and (CompareText(rv.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; + *) + {$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(); @@ -2103,13 +2702,21 @@ begin 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; @@ -2118,8 +2725,12 @@ begin end; pr.expectTT(pr.TTEnd); // fix field defaults + {$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; @@ -2154,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; @@ -2207,6 +2818,19 @@ 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; @@ -2239,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; @@ -2336,7 +2960,7 @@ var begin for rec in recTypes do begin - if (CompareText(rec.name, aname) = 0) then begin result := rec; exit; end; + if StrEqu(rec.name, aname) then begin result := rec; exit; end; end; result := nil; end; @@ -2360,7 +2984,7 @@ var begin for ebs in ebsTypes do begin - if (CompareText(ebs.name, aname) = 0) then begin result := ebs; exit; end; + if StrEqu(ebs.name, aname) then begin result := ebs; exit; end; end; result := nil; end; @@ -2448,7 +3072,7 @@ begin rec := TDynRecord.Create(pr); //writeln(dr.definition); writeln; if (findRecType(rec.name) <> nil) then begin rec.Free(); raise Exception.Create(Format('duplicate record ''%s''', [rec.name])); end; - if (hdr <> nil) and (CompareText(rec.name, hdr.name) = 0) then begin rec.Free(); raise Exception.Create(Format('duplicate record ''%s''', [rec.name])); end; + 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 @@ -2485,16 +3109,13 @@ begin result := nil; try pr.expectId(headerType.name); - res := headerType.clone(); + res := headerType.clone(nil); res.mHeaderRec := res; res.parseValue(pr); result := res; res := nil; - except on E: Exception do - begin - res.Free(); - raise; - end; + finally + res.Free(); end; end; @@ -2505,18 +3126,77 @@ var begin result := nil; try - res := headerType.clone(); + res := headerType.clone(nil); res.mHeaderRec := res; res.parseBinValue(st); result := res; res := nil; - except on E: Exception do + 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 - res.Free(); - raise; + 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.