X-Git-Url: http://deadsoftware.ru/gitweb?a=blobdiff_plain;ds=sidebyside;f=src%2Fshared%2Fxdynrec.pas;h=2d8f430e961b42869074883a327fb405fa8e0f90;hb=27db2871c8507404a1957487d66d037e0bbc81da;hp=f3400d87730d0594b176a233c5d5913558c5be21;hpb=bfebb0f03424f28d5241607f5d927c5b4c460ebe;p=d2df-sdl.git diff --git a/src/shared/xdynrec.pas b/src/shared/xdynrec.pas index f3400d8..2d8f430 100644 --- a/src/shared/xdynrec.pas +++ b/src/shared/xdynrec.pas @@ -19,7 +19,8 @@ unit xdynrec; interface uses - xparser; + Classes, + xparser, xstreams; // ////////////////////////////////////////////////////////////////////////// // @@ -56,7 +57,6 @@ type 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 mBinOfs: Integer; // offset in binary; <0 - none mRecOfs: Integer; // offset in record; <0 - none @@ -70,7 +70,7 @@ type // default values mDefSVal: AnsiString; mEBS: TEBS; - mEBSName: AnsiString; // name of enum, bitset or record + mEBSTypeName: AnsiString; // name of enum, bitset or record mBitSetUnique: Boolean; // bitset can contain only one value mNegBool: Boolean; @@ -82,9 +82,6 @@ type procedure parseDef (pr: TTextParser); - procedure setIVal (v: Integer); inline; - procedure setSVal (const v: AnsiString); inline; - procedure fixDefaultValue (); function isDefaultValue (): Boolean; @@ -99,9 +96,11 @@ type function clone (): TDynField; - procedure parseValue (pr: TTextParser); + procedure parseValue (pr: TTextParser; curheader: TDynRecord); + procedure parseBinValue (st: TStream); procedure writeTo (wr: TTextWriter); + procedure writeBinTo (st: TStream; curheader: TDynRecord); // won't work for lists function isSimpleEqu (fld: TDynField): Boolean; @@ -112,16 +111,16 @@ type property baseType: TType read mType; property defined: Boolean read mDefined write mDefined; property internal: Boolean read mInternal write mInternal; - property ival: Integer read mIVal write setIVal; - property sval: AnsiString read mSVal write setSVal; + //property 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 hasDefault: Boolean read mHasDefault; property defsval: AnsiString read mDefSVal write mDefSVal; - property ebs: TEBS read mEBS write mEBS; - property ebsname: AnsiString read mEBSName write mEBSName; // enum/bitset name + property ebstype: 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; @@ -161,9 +160,11 @@ type function clone (): TDynRecord; - procedure parseValue (pr: TTextParser; asheader: Boolean=false); + procedure parseValue (pr: TTextParser; curheader: TDynRecord); + procedure parseBinValue (st: TStream); procedure writeTo (wr: TTextWriter; putHeader: Boolean=true); + procedure writeBinTo (st: TStream; curheader: TDynRecord; trigbufsz: Integer=-1); public property id: AnsiString read mId; // for map parser @@ -213,40 +214,44 @@ type TDynMapDef = class private - curheader: TDynRecord; // for parser - - private - function findRecordById (const atypename, aid: AnsiString): TDynRecord; + procedure addRecordByType (const atypename: AnsiString; rc: TDynRecord; curheader: TDynRecord); + function findRecordByTypeId (const atypename, aid: AnsiString; curheader: TDynRecord): TDynRecord; + function findRecordNumByType (const atypename: AnsiString; rc: TDynRecord; curheader: TDynRecord): Integer; public - records: array of TDynRecord; // [0] is always header - trigDatas: array of TDynRecord; - ebs: array of TDynEBS; + recTypes: array of TDynRecord; // [0] is always header + trigTypes: array of TDynRecord; // trigdata + ebsTypes: array of TDynEBS; // enums, bitsets private procedure parseDef (pr: TTextParser); - function getHeader (): TDynRecord; inline; + function getHeaderRecType (): TDynRecord; inline; public - constructor Create (pr: TTextParser); + constructor Create (pr: TTextParser); // parses data definition destructor Destroy (); override; - function findRec (const aname: AnsiString): TDynRecord; - function findTrigDataFor (const aname: AnsiString): TDynRecord; - function findEBS (const aname: AnsiString): TDynEBS; + function findRecType (const aname: AnsiString): TDynRecord; + function findTrigFor (const aname: AnsiString): TDynRecord; + function findEBSType (const aname: AnsiString): TDynEBS; + // creates new header record function parseMap (pr: TTextParser): TDynRecord; + // creates new header record + function parseBinMap (st: TStream): TDynRecord; + public - property header: TDynRecord read getHeader; + property headerType: TDynRecord read getHeaderRecType; end; implementation uses - SysUtils; + SysUtils, + utils; // ////////////////////////////////////////////////////////////////////////// // @@ -254,7 +259,6 @@ constructor TDynField.Create (const aname: AnsiString; atype: TType); begin mRVal := nil; mRecRef := nil; - mRecRefOwned := false; cleanup(); mName := aname; mType := atype; @@ -283,9 +287,7 @@ begin mIVal2 := 0; mSVal := ''; mRVal := nil; - if mRecRefOwned then mRecRef.Free(); mRecRef := nil; - mRecRefOwned := false; mMaxDim := -1; mBinOfs := -1; mRecOfs := -1; @@ -297,7 +299,7 @@ begin mInternal := true; mDefSVal := ''; mEBS := TEBS.TNone; - mEBSName := ''; + mEBSTypeName := ''; mBitSetUnique := false; mNegBool := false; mDefId := ''; @@ -319,15 +321,7 @@ begin result.mSVal := mSVal; SetLength(result.mRVal, Length(mRVal)); for f := 0 to High(mRVal) do result.mRVal[f] := mRVal[f].clone(); - result.mRecRefOwned := mRecRefOwned; - if mRecRefOwned then - begin - if (mRecRef <> nil) then result.mRecRef := mRecRef.clone(); - end - else - begin - result.mRecRef := mRecRef; - end; + result.mRecRef := mRecRef; result.mMaxDim := mMaxDim; result.mBinOfs := mBinOfs; result.mRecOfs := mRecOfs; @@ -339,7 +333,7 @@ begin result.mInternal := mInternal; result.mDefSVal := mDefSVal; result.mEBS := mEBS; - result.mEBSName := mEBSName; + result.mEBSTypeName := mEBSTypeName; result.mBitSetUnique := mBitSetUnique; result.mNegBool := mNegBool; result.mDefId := mDefId; @@ -347,10 +341,6 @@ begin end; -procedure TDynField.setIVal (v: Integer); inline; begin mIVal := v; mDefined := true; end; -procedure TDynField.setSVal (const v: AnsiString); inline; begin mSVal := v; mDefined := true; end; - - // won't work for lists function TDynField.isSimpleEqu (fld: TDynField): Boolean; begin @@ -406,7 +396,7 @@ begin //writeln('DEFAULT for <', mName, '>: <', s, '>'); stp := TStrTextParser.Create(s); try - parseValue(stp); + parseValue(stp, nil); finally stp.Free(); end; @@ -434,7 +424,7 @@ begin stp := TStrTextParser.Create(s); try fld := clone(); - fld.parseValue(stp); + fld.parseValue(stp, nil); result := isSimpleEqu(fld); finally fld.Free(); @@ -472,9 +462,9 @@ begin if (mRecOfs >= 0) then result += Format(' offset %d', [mRecOfs]); case mEBS of TEBS.TNone: begin end; - TEBS.TRec: result += ' '+mEBSName; - TEBS.TEnum: result += ' enum '+mEBSName; - TEBS.TBitSet: begin result += ' bitset '; if mBitSetUnique then result += 'unique '; result += mEBSName; end; + 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 @@ -675,7 +665,7 @@ begin self.mHasDefault := (hasdefStr or hasdefId or hasdefInt); self.mPasName := fldpasname; self.mEBS := lebs; - self.mEBSName := fldrecname; + self.mEBSTypeName := fldrecname; self.mBitSetUnique := unique; self.mMaxDim := lmaxdim; self.mBinOfs := fldofs; @@ -687,6 +677,167 @@ begin end; +procedure TDynField.writeBinTo (st: TStream; curheader: TDynRecord); +var + s: AnsiString; + f: Integer; + maxv: Integer; + buf: PByte; + ws: TStream = nil; +begin + case mEBS of + 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 + 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 + FillChar(buf^, mMaxDim, 0); + if (mRecRef <> nil) then + begin + ws := TSFSMemoryChunkStream.Create(buf, mMaxDim); + mRecRef.writeBinTo(ws, curheader, mMaxDim); // as trigdata + end; + st.WriteBuffer(buf^, mMaxDim); + finally + ws.Free(); + if (buf <> nil) then FreeMem(buf); + 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; + case mType of + TType.TByte: maxv := 127; + TType.TUByte: maxv := 254; + TType.TShort: maxv := 32767; + TType.TUShort: maxv := 65534; + TType.TInt: maxv := $7fffffff; + TType.TUInt: maxv := $7fffffff; + else raise Exception.Create(Format('record reference type ''%s'' in field ''%s'' cannot be written', [mEBSTypeName, mName])); + end; + // find record number + f := mOwner.mOwner.findRecordNumByType(mEBSTypeName, mRecRef, curheader); + if (f < 0) then raise Exception.Create(Format('record reference type ''%s'' in field ''%s'' not found in record list', [mEBSTypeName, mName])); + if (f > maxv) then raise Exception.Create(Format('record reference type ''%s'' in field ''%s'' has too big index', [mEBSTypeName, mName])); + case mType of + TType.TByte, TType.TUByte: writeInt(st, Byte(f)); + TType.TShort, TType.TUShort: writeInt(st, SmallInt(f)); + TType.TInt, TType.TUInt: writeInt(st, Integer(f)); + else raise Exception.Create(Format('record reference type ''%s'' in field ''%s'' cannot be written', [mEBSTypeName, mName])); + end; + exit; + end; + TEBS.TEnum: begin end; + TEBS.TBitSet: begin end; + else raise Exception.Create('ketmar forgot to handle some EBS type'); + end; + + case mType of + TType.TBool: + begin + if (mIVal <> 0) then writeInt(st, Byte(1)) else writeInt(st, Byte(0)); + exit; + end; + TType.TChar: + begin + if (mMaxDim = 0) then raise Exception.Create(Format('invalid string size definition for field ''%s''', [mName])); + if (mMaxDim < 0) then + begin + if (Length(mSVal) <> 1) then raise Exception.Create(Format('invalid string size definition for field ''%s''', [mName])); + writeInt(st, Byte(mSVal[1])); + end + else + begin + if (Length(mSVal) > mMaxDim) then raise Exception.Create(Format('invalid string size definition for field ''%s''', [mName])); + //FillChar(s[0], sizeof(s), 0); + s := utfTo1251(mSVal); + //writeln('writing char[', mMaxDim, '] <', mName, '>: ', TTextParser.quote(s)); + if (Length(s) > 0) then st.WriteBuffer(PChar(s)^, Length(s)); + for f := Length(s) to mMaxDim do writeInt(st, Byte(0)); + end; + exit; + end; + TType.TByte, + TType.TUByte: + begin + // 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; + exit; + end; + TType.TShort, + TType.TUShort: + begin + if (mMaxDim > 0) then raise Exception.Create(Format('short array in field ''%s'' cannot be written', [mName])); + writeInt(st, Word(mIVal)); + exit; + end; + TType.TInt, + TType.TUInt: + begin + if (mMaxDim > 0) then raise Exception.Create(Format('int array in field ''%s'' cannot be written', [mName])); + writeInt(st, LongWord(mIVal)); + exit; + end; + TType.TString: + begin + raise Exception.Create(Format('cannot write string field ''%s''', [mName])); + end; + TType.TPoint, + TType.TSize: + begin + if (mMaxDim > 0) then raise Exception.Create(Format('pos/size array in field ''%s'' cannot be written', [mName])); + writeInt(st, Word(mIVal)); + writeInt(st, Word(mIVal2)); + exit; + end; + TType.TList: + begin + assert(false); + exit; + end; + TType.TTrigData: + begin + assert(false); + exit; + end; + else raise Exception.Create('ketmar forgot to handle some field type'); + end; +end; + + procedure TDynField.writeTo (wr: TTextWriter); var def: TDynMapDef; @@ -705,7 +856,7 @@ begin begin wr.put('null;'#10); end - else if mRecRefOwned then + else if (Length(mRecRef.mId) = 0) then begin mRecRef.writeTo(wr, false); // only data, no header end @@ -719,8 +870,8 @@ begin TEBS.TEnum: begin def := mOwner.mOwner; - es := def.findEBS(mEBSName); - if (es = nil) then raise Exception.Create(Format('record enum type ''%s'' for field ''%s'' not found', [mEBSName, mName])); + es := def.findEBSType(mEBSTypeName); + if (es = nil) then raise Exception.Create(Format('record enum type ''%s'' for field ''%s'' not found', [mEBSTypeName, mName])); for f := 0 to High(es.mVals) do begin if (es.mVals[f] = mIVal) then @@ -730,13 +881,13 @@ begin exit; end; end; - raise Exception.Create(Format('value %d in record enum type ''%s'' for field ''%s'' not found', [mIVal, mEBSName, mName])); + raise Exception.Create(Format('value %d in record enum type ''%s'' for field ''%s'' not found', [mIVal, mEBSTypeName, mName])); end; TEBS.TBitSet: begin def := mOwner.mOwner; - es := def.findEBS(mEBSName); - if (es = nil) then raise Exception.Create(Format('record bitset type ''%s'' for field ''%s'' not found', [mEBSName, mName])); + es := def.findEBSType(mEBSTypeName); + if (es = nil) then raise Exception.Create(Format('record bitset type ''%s'' for field ''%s'' not found', [mEBSTypeName, mName])); // none? if (mIVal = 0) then begin @@ -749,7 +900,7 @@ begin exit; end; end; - raise Exception.Create(Format('value %d in record bitset type ''%s'' for field ''%s'' not found', [0, mEBSName, mName])); + raise Exception.Create(Format('value %d in record bitset type ''%s'' for field ''%s'' not found', [0, mEBSTypeName, mName])); end; // not none mask := 1; @@ -769,7 +920,7 @@ begin break; end; end; - if not found then raise Exception.Create(Format('value %d in record bitset type ''%s'' for field ''%s'' not found', [mask, mEBSName, mName])); + if not found then raise Exception.Create(Format('value %d in record bitset type ''%s'' for field ''%s'' not found', [mask, mEBSTypeName, mName])); end; mask := mask shl 1; end; @@ -830,7 +981,7 @@ begin end; -procedure TDynField.parseValue (pr: TTextParser); +procedure TDynField.parseValue (pr: TTextParser; curheader: TDynRecord); procedure parseInt (min, max: Integer); begin @@ -853,19 +1004,17 @@ begin begin def := mOwner.mOwner; // ugly hack. sorry. - if (CompareText(mEBSName, 'triggerdata') = 0) then + if (CompareText(mEBSTypeName, 'triggerdata') = 0) then begin rec := mOwner; // find trigger definition tfld := rec.field['type']; if (tfld = nil) then raise Exception.Create(Format('triggerdata value for field ''%s'' in record ''%s'' without ''type'' field', [mName, rec.mName])); if (tfld.mEBS <> TEBS.TEnum) then raise Exception.Create(Format('triggerdata value for field ''%s'' in record ''%s'' with bad ''type'' field', [mName, rec.mName])); - rc := def.findTrigDataFor(tfld.mSVal); + rc := def.findTrigFor(tfld.mSVal); if (rc = nil) then raise Exception.Create(Format('triggerdata definition for field ''%s'' in record ''%s'' with type ''%s'' not found', [mName, rec.mName, tfld.mSVal])); rc := rc.clone(); - rc.parseValue(pr); - if mRecRefOwned then mRecRef.Free(); - mRecRefOwned := true; + rc.parseValue(pr, curheader); mRecRef := rc; mDefined := true; exit; @@ -873,11 +1022,9 @@ begin // other record types if (pr.tokType = pr.TTId) then begin - rec := def.findRecordById(mEBSName, pr.tokStr); - if (rec = nil) then raise Exception.Create(Format('record ''%s'' (%s) value for field ''%s'' not found', [pr.tokStr, mEBSName, mName])); + rec := def.findRecordByTypeId(mEBSTypeName, pr.tokStr, curheader); + 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; mDefined := true; pr.expectTT(pr.TTSemi); @@ -885,14 +1032,13 @@ begin end else if (pr.tokType = pr.TTBegin) then begin - rec := def.findRec(mEBSName); - if (rec = nil) then raise Exception.Create(Format('record type ''%s'' for field ''%s'' not found', [mEBSName, mName])); + rec := def.findRecType(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; + rc.parseValue(pr, curheader); mRecRef := rc; mDefined := true; + mOwner.mOwner.addRecordByType(mEBSTypeName, rc, curheader); exit; end; pr.expectTT(pr.TTBegin); @@ -900,10 +1046,10 @@ begin TEBS.TEnum: begin def := mOwner.mOwner; - es := def.findEBS(mEBSName); - if (es = nil) then raise Exception.Create(Format('record enum type ''%s'' for field ''%s'' not found', [mEBSName, mName])); + es := def.findEBSType(mEBSTypeName); + if (es = nil) then raise Exception.Create(Format('record enum type ''%s'' for field ''%s'' not found', [mEBSTypeName, mName])); tk := pr.expectId(); - if not es.has[tk] then raise Exception.Create(Format('record enum value ''%s'' of type ''%s'' for field ''%s'' not found', [tk, mEBSName, mName])); + if not es.has[tk] then raise Exception.Create(Format('record enum value ''%s'' of type ''%s'' for field ''%s'' not found', [tk, mEBSTypeName, mName])); mIVal := es.field[tk]; mSVal := tk; //writeln('ENUM ', mEBSName, '; element <', mSVal, '> with value ', mIVal); @@ -914,17 +1060,17 @@ begin TEBS.TBitSet: begin def := mOwner.mOwner; - es := def.findEBS(mEBSName); - if (es = nil) then raise Exception.Create(Format('record bitset type ''%s'' for field ''%s'' not found', [mEBSName, mName])); + es := def.findEBSType(mEBSTypeName); + if (es = nil) then raise Exception.Create(Format('record bitset type ''%s'' for field ''%s'' not found', [mEBSTypeName, mName])); mIVal := 0; while true do begin tk := pr.expectId(); - if not es.has[tk] then raise Exception.Create(Format('record bitset value ''%s'' of type ''%s'' for field ''%s'' not found', [tk, mEBSName, mName])); + if not es.has[tk] then raise Exception.Create(Format('record bitset value ''%s'' of type ''%s'' for field ''%s'' not found', [tk, mEBSTypeName, mName])); mIVal := mIVal or es.field[tk]; mSVal := tk; if (pr.tokType <> pr.TTDelim) or ((pr.tokChar <> '|') and (pr.tokChar <> '+')) then break; - if mBitSetUnique then raise Exception.Create(Format('record bitset of type ''%s'' for field ''%s'' expects only one value', [tk, mEBSName, mName])); + if mBitSetUnique then raise Exception.Create(Format('record bitset of type ''%s'' for field ''%s'' expects only one value', [tk, mEBSTypeName, mName])); //pr.expectDelim('|'); pr.skipToken(); // plus or pipe end; @@ -1051,6 +1197,11 @@ begin end; +procedure TDynField.parseBinValue (st: TStream); +begin +end; + + // ////////////////////////////////////////////////////////////////////////// // constructor TDynRecord.Create (pr: TTextParser); begin @@ -1139,6 +1290,7 @@ begin result.mName := mName; result.mSize := mSize; result.mHeader := mHeader; + result.mBinBlock := mBinBlock; SetLength(result.mFields, Length(mFields)); for f := 0 to High(mFields) do begin @@ -1261,6 +1413,119 @@ begin end; +procedure TDynRecord.writeBinTo (st: TStream; curheader: TDynRecord; trigbufsz: Integer=-1); +var + fld: TDynField; + rec: TDynRecord; + buf: PByte = nil; + ws: TStream = nil; + blk, blkmax: Integer; + f, c: Integer; + bufsz: Integer = 0; +begin + if (curheader = nil) and mHeader then curheader := self; + if (trigbufsz < 0) then + begin + if (mBinBlock < 1) then raise Exception.Create('cannot write binary record without block number'); + if (mSize < 1) then raise Exception.Create('cannot write binary record without size'); + bufsz := mSize; + end + else + begin + bufsz := trigbufsz; + end; + try + GetMem(buf, bufsz); + FillChar(buf^, bufsz, 0); + ws := TSFSMemoryChunkStream.Create(buf, bufsz); + + // write normal fields + for f := 0 to High(mFields) do + begin + fld := mFields[f]; + // record list? + if (fld.mType = fld.TType.TList) then continue; // later + if fld.mInternal then continue; + if (fld.mBinOfs < 0) then continue; + if (fld.mBinOfs >= bufsz) then raise Exception.Create('binary value offset is outside of the buffer'); + TSFSMemoryChunkStream(ws).setup(buf+fld.mBinOfs, bufsz-fld.mBinOfs); + writeln('writing field <', fld.mName, '>'); + fld.writeBinTo(ws, curheader); + end; + + // write block with normal fields + if mHeader then + begin + writeln('writing header...'); + // signature and version + writeIntBE(st, LongWord($4D415001)); + writeInt(st, Byte(mBinBlock)); // type + writeInt(st, LongWord(0)); // reserved + writeInt(st, LongWord(bufsz)); // size + end; + st.WriteBuffer(buf^, bufsz); + + ws.Free(); ws := nil; + FreeMem(buf); buf := nil; + + // write other blocks, if any + if mHeader then + begin + // calculate blkmax + blkmax := 0; + for f := 0 to High(mFields) do + begin + fld := mFields[f]; + // record list? + if (fld.mType = fld.TType.TList) then + begin + if (Length(fld.mRVal) = 0) then continue; + rec := mOwner.findRecType(fld.mName); + if (rec = nil) then continue; + if (rec.mBinBlock <= 0) then continue; + if (blkmax < rec.mBinBlock) then blkmax := rec.mBinBlock; + end; + end; + // write blocks + for blk := 1 to blkmax do + begin + if (blk = mBinBlock) then continue; + ws := nil; + for f := 0 to High(mFields) do + begin + fld := mFields[f]; + // record list? + if (fld.mType = fld.TType.TList) then + begin + if (Length(fld.mRVal) = 0) then continue; + rec := mOwner.findRecType(fld.mName); + if (rec = nil) then continue; + if (rec.mBinBlock <> blk) then continue; + if (ws = nil) then ws := TMemoryStream.Create(); + //rec.writeBinTo(ws); + for c := 0 to High(fld.mRVal) do fld.mRVal[c].writeBinTo(ws, curheader); + end; + end; + // flush block + if (ws <> nil) then + begin + ws.position := 0; + writeInt(st, Byte(blk)); // type + writeInt(st, LongWord(0)); // reserved + writeInt(st, LongWord(ws.size)); // size + st.CopyFrom(ws, ws.size); + ws.Free(); + ws := nil; + end; + end; + end; + finally + ws.Free(); + if (buf <> nil) then FreeMem(buf); + end; +end; + + procedure TDynRecord.writeTo (wr: TTextWriter; putHeader: Boolean=true); var f, c: Integer; @@ -1302,16 +1567,17 @@ begin end; -procedure TDynRecord.parseValue (pr: TTextParser; asheader: Boolean=false); +procedure TDynRecord.parseValue (pr: TTextParser; curheader: TDynRecord); var f, c: Integer; fld: TDynField; - rec: TDynRecord; - success: Boolean; + rec, trc: TDynRecord; + //success: Boolean; begin if (mOwner = nil) then raise Exception.Create(Format('can''t parse record ''%s'' value without owner', [mName])); - if not asheader then + // not a header? + if (curheader <> self) then begin // id? if (pr.tokType = pr.TTId) then mId := pr.expectId(); @@ -1322,53 +1588,37 @@ begin while (pr.tokType <> pr.TTEnd) do begin if (pr.tokType <> pr.TTId) then raise Exception.Create('identifier expected'); - - writeln('<', pr.tokStr, ':', asheader, '>'); + //writeln('<', pr.tokStr, ':', asheader, '>'); // records - if (asheader) then + if (curheader = self) then begin - assert(self = mOwner.curheader); - success := false; - for f := 0 to High(mOwner.records) do + // add records with this type (if any) + trc := mOwner.findRecType(pr.tokStr); + if (trc <> nil) then begin - if (CompareText(mOwner.records[f].mName, pr.tokStr) = 0) then - begin - // find (or create) list of records with this type - fld := field[pr.tokStr]; - if (fld = nil) then + rec := trc.clone(); + try + pr.skipToken(); + rec.parseValue(pr, curheader); + if (Length(rec.mId) > 0) then begin - // first record - fld := TDynField.Create(mOwner.records[f].mName, TDynField.TType.TList); - fld.mOwner := self; - SetLength(mFields, Length(mFields)+1); - mFields[High(mFields)] := fld; - end; - if (fld.mType <> TDynField.TType.TList) then raise Exception.Create(Format('thing ''%s'' in record ''%s'' must be record', [fld.mName, mName])); - rec := mOwner.records[f].clone(); - try - pr.skipToken(); - rec.parseValue(pr); - if (Length(rec.mId) > 0) then + fld := field[pr.tokStr]; + if (fld <> nil) then begin for c := 0 to High(fld.mRVal) do begin if (Length(fld.mRVal[c].mId) > 0) and (CompareText(fld.mRVal[c].mId, rec.mId) = 0) then raise Exception.Create(Format('duplicate thing ''%s'' in record ''%s''', [fld.mName, mName])); end; end; - SetLength(fld.mRVal, Length(fld.mRVal)+1); - fld.mRVal[High(fld.mRVal)] := rec; - writeln('added ''', mOwner.records[f].mName, ''' with id ''', rec.mId, ''' (total:', Length(fld.mRVal), ')'); - //assert(mOwner.findRecordById(mOwner.records[f].mName, rec.mId) <> nil); - rec := nil; - finally - rec.Free(); end; - success := true; - break; + mOwner.addRecordByType(rec.mName, rec, curheader); + rec := nil; + finally + rec.Free(); end; + continue; end; - if success then continue; end; // fields @@ -1378,7 +1628,7 @@ begin 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(); - fld.parseValue(pr); + fld.parseValue(pr, curheader); continue; end; @@ -1392,6 +1642,11 @@ begin end; +procedure TDynRecord.parseBinValue (st: TStream); +begin +end; + + // ////////////////////////////////////////////////////////////////////////// // constructor TDynEBS.Create (pr: TTextParser); begin @@ -1555,10 +1810,9 @@ end; // ////////////////////////////////////////////////////////////////////////// // constructor TDynMapDef.Create (pr: TTextParser); begin - records := nil; - trigDatas := nil; - ebs := nil; - curheader := nil; + recTypes := nil; + trigTypes := nil; + ebsTypes := nil; parseDef(pr); end; @@ -1567,70 +1821,70 @@ destructor TDynMapDef.Destroy (); var f: Integer; begin - for f := 0 to High(records) do records[f].Free(); - for f := 0 to High(trigDatas) do trigDatas[f].Free(); - for f := 0 to High(ebs) do ebs[f].Free(); - records := nil; - trigDatas := nil; - ebs := nil; + for f := 0 to High(recTypes) do recTypes[f].Free(); + for f := 0 to High(trigTypes) do trigTypes[f].Free(); + for f := 0 to High(ebsTypes) do ebsTypes[f].Free(); + recTypes := nil; + trigTypes := nil; + ebsTypes := nil; inherited; end; -function TDynMapDef.getHeader (): TDynRecord; inline; +function TDynMapDef.getHeaderRecType (): TDynRecord; inline; begin - if (Length(records) = 0) then raise Exception.Create('no header in empty mapdef'); - result := records[0]; + if (Length(recTypes) = 0) then raise Exception.Create('no header in empty mapdef'); + result := recTypes[0]; end; -function TDynMapDef.findRec (const aname: AnsiString): TDynRecord; +function TDynMapDef.findRecType (const aname: AnsiString): TDynRecord; var f: Integer; begin - for f := 0 to High(records) do + for f := 0 to High(recTypes) do begin - if (CompareText(records[f].name, aname) = 0) then begin result := records[f]; exit; end; + if (CompareText(recTypes[f].name, aname) = 0) then begin result := recTypes[f]; exit; end; end; result := nil; end; -function TDynMapDef.findTrigDataFor (const aname: AnsiString): TDynRecord; +function TDynMapDef.findTrigFor (const aname: AnsiString): TDynRecord; var f: Integer; begin - for f := 0 to High(trigDatas) do + for f := 0 to High(trigTypes) do begin - if (trigDatas[f].isForTrig[aname]) then begin result := trigDatas[f]; exit; end; + if (trigTypes[f].isForTrig[aname]) then begin result := trigTypes[f]; exit; end; end; result := nil; end; -function TDynMapDef.findEBS (const aname: AnsiString): TDynEBS; +function TDynMapDef.findEBSType (const aname: AnsiString): TDynEBS; var f: Integer; begin - for f := 0 to High(ebs) do + for f := 0 to High(ebsTypes) do begin - if (CompareText(ebs[f].name, aname) = 0) then begin result := ebs[f]; exit; end; + if (CompareText(ebsTypes[f].name, aname) = 0) then begin result := ebsTypes[f]; exit; end; end; result := nil; end; -function TDynMapDef.findRecordById (const atypename, aid: AnsiString): TDynRecord; +function TDynMapDef.findRecordByTypeId (const atypename, aid: AnsiString; curheader: TDynRecord): TDynRecord; var rec: TDynRecord; fld: TDynField; f: Integer; begin result := nil; - if (curheader = nil) then exit; // find record type + if (curheader = nil) then exit; //writeln('searching for type <', atypename, '>'); - rec := findRec(atypename); + rec := findRecType(atypename); if (rec = nil) then exit; // find record data //writeln('searching for data of type <', atypename, '>'); @@ -1652,6 +1906,61 @@ begin end; +procedure TDynMapDef.addRecordByType (const atypename: AnsiString; rc: TDynRecord; curheader: TDynRecord); +var + rec: TDynRecord; + fld: TDynField; +begin + assert(curheader <> nil); + // find record type + rec := findRecType(atypename); + assert(rec <> nil); + // find record data + //writeln('searching for data of type <', atypename, '>'); + fld := curheader.field[atypename]; + if (fld = nil) then + 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; curheader: TDynRecord): Integer; +var + rec: TDynRecord; + fld: TDynField; + f: Integer; +begin + result := -1; + if (curheader = nil) then exit; + // find record type + rec := findRecType(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; + end; + // alas +end; + + procedure TDynMapDef.parseDef (pr: TTextParser); var dr, hdr: TDynRecord; @@ -1667,14 +1976,14 @@ begin if (pr.tokStr = 'enum') or (pr.tokStr = 'bitset') then begin eb := TDynEBS.Create(pr); - if (findEBS(eb.name) <> nil) then + if (findEBSType(eb.name) <> nil) then begin eb.Free(); raise Exception.Create(Format('duplicate enum/bitset ''%s''', [eb.name])); end; eb.mOwner := self; - SetLength(ebs, Length(ebs)+1); - ebs[High(ebs)] := eb; + SetLength(ebsTypes, Length(ebsTypes)+1); + ebsTypes[High(ebsTypes)] := eb; //writeln(eb.definition); writeln; continue; end; @@ -1684,22 +1993,22 @@ begin dr := TDynRecord.Create(pr); for f := 0 to High(dr.mTrigTypes) do begin - if (findTrigDataFor(dr.mTrigTypes[f]) <> nil) then + if (findTrigFor(dr.mTrigTypes[f]) <> nil) then begin dr.Free(); raise Exception.Create(Format('duplicate trigdata ''%s''', [dr.mTrigTypes[f]])); end; end; dr.mOwner := self; - SetLength(trigDatas, Length(trigDatas)+1); - trigDatas[High(trigDatas)] := dr; + SetLength(trigTypes, Length(trigTypes)+1); + trigTypes[High(trigTypes)] := dr; //writeln(dr.definition); writeln; continue; end; dr := 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 (findRecType(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 @@ -1709,15 +2018,15 @@ begin end else begin - SetLength(records, Length(records)+1); - records[High(records)] := dr; + SetLength(recTypes, Length(recTypes)+1); + recTypes[High(recTypes)] := dr; end; end; if (hdr = nil) then raise Exception.Create('header definition not found in mapdef'); - SetLength(records, Length(records)+1); - for f := High(records) downto 1 do records[f] := records[f-1]; - records[0] := hdr; + SetLength(recTypes, Length(recTypes)+1); + for f := High(recTypes) downto 1 do recTypes[f] := recTypes[f-1]; + recTypes[0] := hdr; end; @@ -1726,20 +2035,26 @@ function TDynMapDef.parseMap (pr: TTextParser): TDynRecord; var res: TDynRecord = nil; begin - if (curheader <> nil) then raise Exception.Create('cannot call `parseMap()` recursively, sorry'); result := nil; try - pr.expectId(header.name); - res := header.clone(); - curheader := res; - res.parseValue(pr, true); // as header + pr.expectId(headerType.name); + res := headerType.clone(); + res.parseValue(pr, res); result := res; res := nil; - finally - curheader := nil; - res.Free(); + except on E: Exception do + begin + res.Free(); + raise; + end; end; end; +function TDynMapDef.parseBinMap (st: TStream): TDynRecord; +begin + result := nil; +end; + + end.