X-Git-Url: http://deadsoftware.ru/gitweb?a=blobdiff_plain;f=src%2Fshared%2Fxdynrec.pas;h=e5d0b39acc3a8189fc2ac66bd23e2ada8be5cf59;hb=662b1b0c24197c50a92078b4daa1a69ae8085fe1;hp=105a755439d4c846345933270ad6da24f5b455f0;hpb=3049aec7dbcc5e50e0f59be54ee94cf4e10e4c6a;p=d2df-sdl.git diff --git a/src/shared/xdynrec.pas b/src/shared/xdynrec.pas index 105a755..e5d0b39 100644 --- a/src/shared/xdynrec.pas +++ b/src/shared/xdynrec.pas @@ -14,12 +14,13 @@ * 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, + Variants, Classes, xparser, xstreams, utils, hashtable; @@ -62,7 +63,6 @@ type 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; @@ -84,6 +84,10 @@ type // for binary parser mRecRefId: AnsiString; + // for userdata + mTagInt: Integer; + mTagPtr: Pointer; + private procedure cleanup (); @@ -94,11 +98,24 @@ type function isDefaultValue (): Boolean; function getListCount (): Integer; inline; - function getListItem (idx: Integer): TDynRecord; 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; @@ -119,27 +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 negbool: Boolean read mNegBool; property defined: Boolean read mDefined write 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 list: TDynRecList read mRVal; // for list + property recref: TDynRecord read mRecRef write mRecRef; //FIXME: writing is a hack! + 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 x: Integer read mIVal; - property w: Integer read mIVal; - property y: Integer read mIVal2; - property h: Integer read mIVal2; + 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; @@ -152,25 +179,40 @@ 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; + 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; + 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 (); @@ -196,18 +238,34 @@ type // 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 headerType: TDynRecord read mHeaderRec; + 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 @@ -258,6 +316,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; @@ -267,6 +328,7 @@ type function findEBSType (const aname: AnsiString): TDynEBS; function pasdef (): AnsiString; + function pasdefconst (): AnsiString; // creates new header record function parseMap (pr: TTextParser): TDynRecord; @@ -276,6 +338,8 @@ type public property headerType: TDynRecord read getHeaderRecType; + property trigTypeCount: Integer read getTrigTypeCount; + property trigType[idx: Integer]: TDynRecord read getTrigTypeAt; end; @@ -295,6 +359,14 @@ uses 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; + + // ////////////////////////////////////////////////////////////////////////// // constructor TDynField.Create (const aname: AnsiString; atype: TType); begin @@ -319,6 +391,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(); @@ -340,7 +478,6 @@ begin mRecRef := nil; mMaxDim := -1; mBinOfs := -1; - mRecOfs := -1; mSepPosSize := false; mAsT := false; mHasDefault := false; @@ -359,12 +496,14 @@ begin mAsMonsterId := false; mNegBool := false; mRecRefId := ''; + mTagInt := 0; + mTagPtr := nil; end; function TDynField.clone (newOwner: TDynRecord=nil): TDynField; var - rec, nrc: TDynRecord; + rec: TDynRecord; begin result := TDynField.Create(mName, mType); result.mOwner := mOwner; @@ -379,17 +518,11 @@ begin begin if (result.mRVal = nil) then result.mRVal := TDynRecList.Create(mRVal.count); if (result.mRHash = nil) then result.mRHash := hashNewStrInt(); - for rec in mRVal do - begin - nrc := rec.clone(); - result.mRVal.append(nrc); - if (Length(nrc.mId) > 0) then result.mRHash.put(nrc.mId, result.mRVal.count-1); - end; + for rec in mRVal do result.addListItem(rec.clone()); end; result.mRecRef := mRecRef; result.mMaxDim := mMaxDim; result.mBinOfs := mBinOfs; - result.mRecOfs := mRecOfs; result.mSepPosSize := mSepPosSize; result.mAsT := mAsT; result.mDefined := mDefined; @@ -408,6 +541,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; @@ -531,12 +786,31 @@ begin end; -function TDynField.getListItem (idx: Integer): TDynRecord; inline; +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 @@ -563,7 +837,7 @@ 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; @@ -787,7 +1061,6 @@ begin self.mAsMonsterId := asmonid; self.mMaxDim := lmaxdim; self.mBinOfs := fldofs; - self.mRecOfs := fldofs; self.mSepPosSize := (asxy or aswh); self.mAsT := ast; self.mOmitDef := omitdef; @@ -795,6 +1068,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; @@ -1095,6 +1375,7 @@ begin raise Exception.Create(Format('cannot parse field ''%s'' yet', [mName])); end; + procedure TDynField.parseBinValue (st: TStream); var rec, rc: TDynRecord; @@ -1364,7 +1645,11 @@ begin 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; @@ -1526,10 +1811,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; @@ -1539,9 +1829,14 @@ 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; end; @@ -1550,14 +1845,47 @@ begin mName := ''; 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.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 @@ -1565,6 +1893,7 @@ begin Inc(result); end; result := -1; + {$ENDIF} end; @@ -1583,6 +1912,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); @@ -1599,6 +1940,18 @@ begin end; +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 (): TDynRecord; var fld: TDynField; @@ -1613,20 +1966,21 @@ begin 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)); 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; + result.mTagInt := mTagInt; + result.mTagPtr := mTagPtr; end; function TDynRecord.findRecordByTypeId (const atypename, aid: AnsiString): TDynRecord; var fld: TDynField; - //rec: TDynRecord; idx: Integer; begin result := nil; @@ -1638,12 +1992,6 @@ begin // find by id if (fld.mRVal <> nil) then begin - { - for rec in fld.mRVal do - begin - if StrEqu(rec.mId, aid) then begin result := rec; exit; end; - end; - } if fld.mRHash.get(aid, idx) then begin result := fld.mRVal[idx]; exit; end; end; // alas @@ -1672,7 +2020,7 @@ begin end; -procedure TDynRecord.addRecordByType (const atypename: AnsiString; rc: TDynRecord); +function TDynRecord.addRecordByType (const atypename: AnsiString; rc: TDynRecord): Boolean; var fld: TDynField; begin @@ -1683,7 +2031,7 @@ 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 @@ -1692,8 +2040,7 @@ begin fld.mRVal := TDynRecList.Create(); fld.mRHash := hashNewStrInt(); end; - fld.mRVal.append(rc); - if (Length(rc.mId) > 0) then fld.mRHash.put(rc.mId, fld.mRVal.count-1); + result := fld.addListItem(rc); end; @@ -1741,6 +2088,112 @@ begin 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.setUserField (const fldname: AnsiString; v: LongInt); +var + fld: TDynField; +begin + if (Length(fldname) = 0) then exit; + fld := field[fldname]; + if (fld <> nil) then + begin + if (fld.mType <> fld.TType.TInt) or (fld.mEBS <> fld.TEBS.TNone) then + begin + raise Exception.Create(Format('invalid user field ''%s'' type', [fld.name])); + end; + end + else + begin + fld := TDynField.Create(fldname, fld.TType.TInt); + fld.mOwner := self; + fld.mIVal := v; + fld.mInternal := true; + fld.mDefined := true; + addField(fld); + end; +end; + + +procedure TDynRecord.setUserField (const fldname: AnsiString; v: AnsiString); +var + fld: TDynField; +begin + if (Length(fldname) = 0) then exit; + fld := field[fldname]; + if (fld <> nil) then + begin + if (fld.mType <> fld.TType.TString) or (fld.mEBS <> fld.TEBS.TNone) then + begin + raise Exception.Create(Format('invalid user field ''%s'' type', [fld.name])); + end; + end + else + begin + fld := TDynField.Create(fldname, fld.TType.TString); + fld.mOwner := self; + fld.mSVal := v; + fld.mInternal := true; + fld.mDefined := true; + addField(fld); + end; +end; + + +procedure TDynRecord.setUserField (const fldname: AnsiString; v: Boolean); +var + fld: TDynField; +begin + if (Length(fldname) = 0) then exit; + fld := field[fldname]; + if (fld <> nil) then + begin + if (fld.mType <> fld.TType.TBool) or (fld.mEBS <> fld.TEBS.TNone) then + begin + raise Exception.Create(Format('invalid user field ''%s'' type', [fld.name])); + end; + end + else + begin + fld := TDynField.Create(fldname, fld.TType.TBool); + fld.mOwner := self; + fld.mIVal := Integer(v); + fld.mInternal := true; + fld.mDefined := true; + addField(fld); + end; +end; +} + + procedure TDynRecord.parseDef (pr: TTextParser); var fld: TDynField; @@ -1800,10 +2253,14 @@ 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); @@ -1961,7 +2418,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); @@ -1973,8 +2430,7 @@ begin rec.mHeaderRec := self; rec.parseBinValue(mst); rec.mId := Format('%s%d', [rec.mName, f]); - fld.mRVal.append(rec); - fld.mRHash.put(rec.mId, fld.mRVal.count-1); + fld.addListItem(rec); //writeln('parsed ''', rec.mId, '''...'); end; end; @@ -2244,12 +2700,14 @@ begin 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) and (Length(rec.mId) > 0) then + (* + if (fld <> nil) and (fld.mRVal <> nil) then begin {$IF DEFINED(D2D_DYNREC_PROFILER)}stt := curTimeMicro();{$ENDIF} //idtmp := trc.mName+':'+rec.mId; @@ -2258,6 +2716,7 @@ begin {$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} @@ -2748,4 +3207,19 @@ begin 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.