X-Git-Url: http://deadsoftware.ru/gitweb?a=blobdiff_plain;f=src%2Fshared%2Fxdynrec.pas;h=e1bd571235d2ba9be15abe8d1e8e1480df4d22a6;hb=8213065ce7c035c3c2bb8d8b90ab423d42c0a5ac;hp=e5d0b39acc3a8189fc2ac66bd23e2ada8be5cf59;hpb=662b1b0c24197c50a92078b4daa1a69ae8085fe1;p=d2df-sdl.git diff --git a/src/shared/xdynrec.pas b/src/shared/xdynrec.pas index e5d0b39..e1bd571 100644 --- a/src/shared/xdynrec.pas +++ b/src/shared/xdynrec.pas @@ -123,7 +123,7 @@ type 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); @@ -143,7 +143,7 @@ type property name: AnsiString read mName; property baseType: TType read mType; property negbool: Boolean read mNegBool; - property defined: Boolean read mDefined write mDefined; + property defined: Boolean read mDefined; property internal: Boolean read mInternal write mInternal; property hasTPrefix: Boolean read mAsT; property separatePasFields: Boolean read mSepPosSize; @@ -156,7 +156,7 @@ type property ebs: TEBS read mEBS; property ebstype: TObject read mEBSType; property ebstypename: AnsiString read mEBSTypeName; // enum/bitset name - property recref: TDynRecord read mRecRef write mRecRef; //FIXME: writing is a hack! + 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; @@ -191,6 +191,8 @@ type mTagInt: Integer; mTagPtr: Pointer; + mRec2Free: TDynRecList; + private procedure parseDef (pr: TTextParser); // parse definition @@ -206,6 +208,8 @@ type 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; @@ -222,7 +226,7 @@ type function definition (): AnsiString; function pasdef (): AnsiString; - function clone (): TDynRecord; + function clone (registerIn: TDynRecord): TDynRecord; function isSimpleEqu (rec: TDynRecord): Boolean; @@ -501,7 +505,7 @@ begin end; -function TDynField.clone (newOwner: TDynRecord=nil): TDynField; +function TDynField.clone (newOwner: TDynRecord=nil; registerIn: TDynRecord=nil): TDynField; var rec: TDynRecord; begin @@ -518,7 +522,7 @@ 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 result.addListItem(rec.clone()); + for rec in mRVal do result.addListItem(rec.clone(registerIn)); end; result.mRecRef := mRecRef; result.mMaxDim := mMaxDim; @@ -895,7 +899,7 @@ var ainternal: Boolean; omitdef: Boolean; defstr: AnsiString; - defint: Integer; + defint, defint2: Integer; hasdefStr: Boolean; hasdefInt: Boolean; hasdefId: Boolean; @@ -903,6 +907,7 @@ var lebs: TDynField.TEBS; unique: Boolean; asmonid: Boolean; + defech: AnsiChar; begin fldpasname := ''; fldname := ''; @@ -916,6 +921,7 @@ begin omitdef := false; defstr := ''; defint := 0; + defint2 := 0; hasdefStr := false; hasdefInt := false; hasdefId := false; @@ -997,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; @@ -1050,8 +1064,13 @@ 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; @@ -1399,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); @@ -1601,7 +1620,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 @@ -1640,7 +1659,7 @@ 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; @@ -1837,12 +1856,23 @@ begin 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 if (rec <> self) then rec.Free(); + mRec2Free.Free(); + mRec2Free := nil; + end; mName := ''; + for fld in mFields do fld.Free(); mFields.Free(); mFields := nil; {$IF DEFINED(XDYNREC_USE_FIELDHASH)} @@ -1857,6 +1887,16 @@ begin 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'); @@ -1952,7 +1992,7 @@ begin end; -function TDynRecord.clone (): TDynRecord; +function TDynRecord.clone (registerIn: TDynRecord): TDynRecord; var fld: TDynField; f: Integer; @@ -1963,18 +2003,19 @@ 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.addField(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; - result.mTagInt := mTagInt; - result.mTagPtr := mTagPtr; + if (registerIn <> nil) then registerIn.regrec(result); end; @@ -2117,83 +2158,6 @@ begin 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; @@ -2426,7 +2390,7 @@ 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]); @@ -2694,7 +2658,7 @@ begin if (trc <> nil) then begin {$IF DEFINED(D2D_DYNREC_PROFILER)}stt := curTimeMicro();{$ENDIF} - rec := trc.clone(); + rec := trc.clone(mHeaderRec); {$IF DEFINED(D2D_DYNREC_PROFILER)}profCloneRec := curTimeMicro()-stt;{$ENDIF} rec.mHeaderRec := mHeaderRec; try @@ -3132,7 +3096,7 @@ begin result := nil; try pr.expectId(headerType.name); - res := headerType.clone(); + res := headerType.clone(nil); res.mHeaderRec := res; res.parseValue(pr); result := res; @@ -3149,7 +3113,7 @@ var begin result := nil; try - res := headerType.clone(); + res := headerType.clone(nil); res.mHeaderRec := res; res.parseBinValue(st); result := res;