1 (* Copyright (C) DooM 2D:Forever Developers
3 * This program is free software: you can redistribute it and/or modify
4 * it under the terms of the GNU General Public License as published by
5 * the Free Software Foundation, either version 3 of the License, or
6 * (at your option) any later version.
8 * This program is distributed in the hope that it will be useful,
9 * but WITHOUT ANY WARRANTY; without even the implied warranty of
10 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
11 * GNU General Public License for more details.
13 * You should have received a copy of the GNU General Public License
14 * along with this program. If not, see <http://www.gnu.org/licenses/>.
16 {$INCLUDE a_modes.inc}
17 {.$DEFINE XDYNREC_USE_FIELDHASH} // actually, it is SLOWER with this
24 xparser
, xstreams
, utils
, hashtable
;
27 // ////////////////////////////////////////////////////////////////////////// //
34 TDynFieldList
= specialize TSimpleList
<TDynField
>;
35 TDynRecList
= specialize TSimpleList
<TDynRecord
>;
36 TDynEBSList
= specialize TSimpleList
<TDynEBS
>;
38 // this is base type for all scalars (and arrays)
42 TType
= (TBool
, TChar
, TByte
, TUByte
, TShort
, TUShort
, TInt
, TUInt
, TString
, TPoint
, TSize
, TList
, TTrigData
);
43 // TPoint: pair of Integers
44 // TSize: pair of UShorts
45 // TList: actually, array of records
46 // TTrigData: array of mMaxDim bytes, but internally a record (mRecRef)
47 // arrays of chars are pascal shortstrings (with counter in the first byte)
51 TEBS
= (TNone
, TRec
, TEnum
, TBitSet
);
58 mIVal
: Integer; // for all integer types
59 mIVal2
: Integer; // for point and size
60 mSVal
: AnsiString; // string; for byte and char arrays
61 mRVal
: TDynRecList
; // for list
62 mRHash
: THashStrInt
; // id -> index in mRVal
63 mRecRef
: TDynRecord
; // for TEBS.TRec
64 mMaxDim
: Integer; // for byte and char arrays; <0: not an array; 0: impossible value
65 mBinOfs
: Integer; // offset in binary; <0 - none
66 mSepPosSize
: Boolean; // for points and sizes, use separate fields
67 mAsT
: Boolean; // for points and sizes, use separate fields, names starts with `t`
73 mBitSetUnique
: Boolean; // bitset can contain only one value
74 mAsMonsterId
: Boolean; // special hack for triggers: monster record number+1 in binary (so 0 means "none")
76 mDefUnparsed
: AnsiString;
77 mDefSVal
: AnsiString; // default string value
78 mDefIVal
, mDefIVal2
: Integer; // default integer values
79 mDefRecRef
: TDynRecord
;
80 mEBS
: TEBS
; // complex type type
81 mEBSTypeName
: AnsiString; // name of enum, bitset or record
82 mEBSType
: TObject
; // either TDynRecord or TDynEBS; nil means "simple type"; nil for `TTrigData` too
85 mRecRefId
: AnsiString;
94 procedure parseDef (pr
: TTextParser
);
96 procedure parseDefaultValue (); // parse `mDefUnparsed` to `mDefSVal`, `mDefIVal`, `mDefIVal2`, `mDefRecRef`
97 procedure fixDefaultValue (); // this will NOT clone `mDefRecRef`
98 function isDefaultValue (): Boolean;
100 function getListCount (): Integer; inline;
101 function getListItem (idx
: Integer): TDynRecord
; inline; overload
;
102 function getListItem (const aname
: AnsiString): TDynRecord
; inline; overload
;
104 function getRecRefIndex (): Integer;
106 procedure setIVal (v
: Integer); inline;
108 function getVar (): Variant;
109 procedure setVar (val
: Variant);
112 // returns `true` for duplicate record id
113 function addListItem (rec
: TDynRecord
): Boolean; inline;
116 constructor Create (const aname
: AnsiString; atype
: TType
);
117 constructor Create (pr
: TTextParser
);
118 constructor Create (const aname
: AnsiString; val
: Variant);
119 destructor Destroy (); override;
121 class function getTypeName (t
: TType
): AnsiString;
123 function definition (): AnsiString;
124 function pasdef (): AnsiString;
126 function clone (newOwner
: TDynRecord
=nil; registerIn
: TDynRecord
=nil): TDynField
;
128 procedure parseValue (pr
: TTextParser
);
129 procedure parseBinValue (st
: TStream
);
131 procedure writeTo (wr
: TTextWriter
);
132 procedure writeBinTo (st
: TStream
);
134 // won't work for lists
135 function isSimpleEqu (fld
: TDynField
): Boolean;
137 procedure setValue (const s
: AnsiString);
139 function GetEnumerator (): TDynRecList
.TEnumerator
; inline;
142 property pasname
: AnsiString read mPasName
;
143 property name
: AnsiString read mName
;
144 property baseType
: TType read mType
;
145 property negbool
: Boolean read mNegBool
;
146 property defined
: Boolean read mDefined
;
147 property internal
: Boolean read mInternal write mInternal
;
148 property hasTPrefix
: Boolean read mAsT
;
149 property separatePasFields
: Boolean read mSepPosSize
;
150 property binOfs
: Integer read mBinOfs
;
151 property ival
: Integer read mIVal write setIVal
;
152 property ival2
: Integer read mIVal2
;
153 property sval
: AnsiString read mSVal
;
154 property hasDefault
: Boolean read mHasDefault
;
155 property defsval
: AnsiString read mDefSVal
;
156 property ebs
: TEBS read mEBS
;
157 property ebstype
: TObject read mEBSType
;
158 property ebstypename
: AnsiString read mEBSTypeName
; // enum/bitset name
159 property recref
: TDynRecord read mRecRef
;
160 property recrefIndex
: Integer read getRecRefIndex
; // search for this record in header; -1: not found
162 property count
: Integer read getListCount
;
163 property item
[idx
: Integer]: TDynRecord read getListItem
;
164 property items
[const aname
: AnsiString]: TDynRecord read getListItem
; default
; // alas, FPC 3+ lost property overloading feature
166 property tagInt
: Integer read mTagInt write mTagInt
;
167 property tagPtr
: Pointer read mTagPtr write mTagPtr
;
169 property varvalue
: Variant read getVar write setVar
;
173 // "value" header record contains TList fields, with name equal to record type
178 mPasName
: AnsiString;
181 mFields
: TDynFieldList
;
182 {$IF DEFINED(XDYNREC_USE_FIELDHASH)}
183 mFieldsHash
: THashStrInt
; // id -> index in mRVal
185 mTrigTypes
: array of AnsiString; // if this is triggerdata, we'll hold list of triggers here
186 mHeader
: Boolean; // true for header record
187 mBinBlock
: Integer; // -1: none
188 mHeaderRec
: TDynRecord
; // for "value" records this is header record with data, for "type" records this is header type record
194 mRec2Free
: TDynRecList
;
197 procedure parseDef (pr
: TTextParser
); // parse definition
199 function findByName (const aname
: AnsiString): Integer; inline;
200 function hasByName (const aname
: AnsiString): Boolean; inline;
201 function getFieldByName (const aname
: AnsiString): TDynField
; inline;
202 function getFieldAt (idx
: Integer): TDynField
; inline;
203 function getCount (): Integer; inline;
205 function getIsTrigData (): Boolean; inline;
206 function getIsForTrig (const aname
: AnsiString): Boolean; inline;
208 function getForTrigCount (): Integer; inline;
209 function getForTrigAt (idx
: Integer): AnsiString; inline;
211 procedure regrec (rec
: TDynRecord
);
214 function findRecordByTypeId (const atypename
, aid
: AnsiString): TDynRecord
;
215 function findRecordNumByType (const atypename
: AnsiString; rc
: TDynRecord
): Integer;
216 function addRecordByType (const atypename
: AnsiString; rc
: TDynRecord
): Boolean; // `true`: duplicate record id
218 procedure addField (fld
: TDynField
); inline;
219 function addFieldChecked (fld
: TDynField
): Boolean; inline; // `true`: duplicate name
222 constructor Create ();
223 constructor Create (pr
: TTextParser
); // parse definition
224 destructor Destroy (); override;
226 function definition (): AnsiString;
227 function pasdef (): AnsiString;
229 function clone (registerIn
: TDynRecord
): TDynRecord
;
231 function isSimpleEqu (rec
: TDynRecord
): Boolean;
233 procedure parseValue (pr
: TTextParser
; beginEaten
: Boolean=false);
234 procedure parseBinValue (st
: TStream
; forceData
: Boolean=false);
236 procedure writeTo (wr
: TTextWriter
; putHeader
: Boolean=true);
237 procedure writeBinTo (st
: TStream
; trigbufsz
: Integer=-1; onlyFields
: Boolean=false);
239 // find field with `TriggerType` type
240 function trigTypeField (): TDynField
;
242 // number of records of the given instance
243 function instanceCount (const typename
: AnsiString): Integer;
245 //procedure setUserField (const fldname: AnsiString; v: LongInt);
246 //procedure setUserField (const fldname: AnsiString; v: AnsiString);
247 //procedure setUserField (const fldname: AnsiString; v: Boolean);
249 function getUserVar (const aname
: AnsiString): Variant;
250 procedure setUserVar (const aname
: AnsiString; val
: Variant);
253 property id
: AnsiString read mId
; // for map parser
254 property pasname
: AnsiString read mPasName
;
255 property name
: AnsiString read mName
; // record name
256 property size
: Integer read mSize
; // size in bytes
257 //property fields: TDynFieldList read mFields;
258 property has
[const aname
: AnsiString]: Boolean read hasByName
;
259 property count
: Integer read getCount
;
260 property field
[const aname
: AnsiString]: TDynField read getFieldByName
; default
;
261 property fieldAt
[idx
: Integer]: TDynField read getFieldAt
;
262 property isTrigData
: Boolean read getIsTrigData
;
263 property isForTrig
[const aname
: AnsiString]: Boolean read getIsForTrig
;
264 property forTrigCount
: Integer read getForTrigCount
;
265 property forTrigAt
[idx
: Integer]: AnsiString read getForTrigAt
;
266 property headerRec
: TDynRecord read mHeaderRec
;
267 property isHeader
: Boolean read mHeader
;
269 property tagInt
: Integer read mTagInt write mTagInt
;
270 property tagPtr
: Pointer read mTagPtr write mTagPtr
;
272 property user
[const aname
: AnsiString]: Variant read getUserVar write setUserVar
;
280 mIds
: array of AnsiString;
281 mVals
: array of Integer;
282 mMaxName
: AnsiString; // MAX field
283 mMaxVal
: Integer; // max value
286 procedure cleanup ();
288 procedure parseDef (pr
: TTextParser
); // parse definition
290 function findByName (const aname
: AnsiString): Integer; inline;
291 function hasByName (const aname
: AnsiString): Boolean; inline;
292 function getFieldByName (const aname
: AnsiString): Integer; inline;
295 constructor Create (pr
: TTextParser
); // parse definition
296 destructor Destroy (); override;
298 function definition (): AnsiString;
299 function pasdef (): AnsiString;
301 // return empty string if not found
302 function nameByValue (v
: Integer): AnsiString;
305 property name
: AnsiString read mName
; // record name
306 property isEnum
: Boolean read mIsEnum
;
307 property has
[const aname
: AnsiString]: Boolean read hasByName
;
308 property field
[const aname
: AnsiString]: Integer read getFieldByName
;
314 recTypes
: TDynRecList
; // [0] is always header
315 trigTypes
: TDynRecList
; // trigdata
316 ebsTypes
: TDynEBSList
; // enums, bitsets
319 procedure parseDef (pr
: TTextParser
);
321 function getHeaderRecType (): TDynRecord
; inline;
323 function getTrigTypeCount (): Integer; inline;
324 function getTrigTypeAt (idx
: Integer): TDynRecord
; inline;
327 constructor Create (pr
: TTextParser
); // parses data definition
328 destructor Destroy (); override;
330 function findRecType (const aname
: AnsiString): TDynRecord
;
331 function findTrigFor (const aname
: AnsiString): TDynRecord
;
332 function findEBSType (const aname
: AnsiString): TDynEBS
;
334 function pasdef (): AnsiString;
335 function pasdefconst (): AnsiString;
337 // creates new header record
338 function parseMap (pr
: TTextParser
): TDynRecord
;
340 // creates new header record
341 function parseBinMap (st
: TStream
): TDynRecord
;
344 property headerType
: TDynRecord read getHeaderRecType
;
345 property trigTypeCount
: Integer read getTrigTypeCount
;
346 property trigType
[idx
: Integer]: TDynRecord read getTrigTypeAt
;
350 {$IF DEFINED(D2D_DYNREC_PROFILER)}
351 procedure xdynDumpProfiles ();
359 {$IF DEFINED(D2D_DYNREC_PROFILER)},xprofiler
{$ENDIF};
362 // ////////////////////////////////////////////////////////////////////////// //
363 function StrEqu (const a
, b
: AnsiString): Boolean; inline; begin result
:= (a
= b
); end;
366 // ////////////////////////////////////////////////////////////////////////// //
367 function TDynField
.GetEnumerator (): TDynRecList
.TEnumerator
; inline;
369 //result := TListEnumerator.Create(mRVal);
370 if (mRVal
<> nil) then result
:= mRVal
.GetEnumerator
else result
:= TDynRecList
.TEnumerator
.Create(nil, 0);
374 // ////////////////////////////////////////////////////////////////////////// //
375 constructor TDynField
.Create (const aname
: AnsiString; atype
: TType
);
383 if (mType
= TType
.TList
) then
385 mRVal
:= TDynRecList
.Create();
386 mRHash
:= hashNewStrInt();
391 constructor TDynField
.Create (pr
: TTextParser
);
398 constructor TDynField
.Create (const aname
: AnsiString; val
: Variant);
399 procedure setInt32 (v
: LongInt);
403 if (v
= 0) then mIVal
:= 0
404 else if (v
= 1) then mIVal
:= 1
405 else raise Exception
.Create('cannot convert shortint variant to field value');
407 if (v
>= -128) and (v
<= 127) then mIVal
:= v
408 else raise Exception
.Create('cannot convert shortint variant to field value');
410 if (v
>= 0) and (v
<= 255) then mIVal
:= v
411 else raise Exception
.Create('cannot convert shortint variant to field value');
413 if (v
>= -32768) and (v
<= 32767) then mIVal
:= v
414 else raise Exception
.Create('cannot convert shortint variant to field value');
416 if (v
>= 0) and (v
<= 65535) then mIVal
:= v
417 else raise Exception
.Create('cannot convert shortint variant to field value');
423 mSVal
:= formatstrf('%s', [v
]);
425 raise Exception
.Create('cannot convert integral variant to field value');
435 varEmpty
: raise Exception
.Create('cannot convert empty variant to field value');
436 varNull
: raise Exception
.Create('cannot convert null variant to field value');
437 varSingle
: raise Exception
.Create('cannot convert single variant to field value');
438 varDouble
: raise Exception
.Create('cannot convert double variant to field value');
439 varDecimal
: raise Exception
.Create('cannot convert decimal variant to field value');
440 varCurrency
: raise Exception
.Create('cannot convert currency variant to field value');
441 varDate
: raise Exception
.Create('cannot convert date variant to field value');
442 varOleStr
: raise Exception
.Create('cannot convert olestr variant to field value');
443 varStrArg
: raise Exception
.Create('cannot convert stdarg variant to field value');
444 varString
: mType
:= TType
.TString
;
445 varDispatch
: raise Exception
.Create('cannot convert dispatch variant to field value');
446 varBoolean
: mType
:= TType
.TBool
;
447 varVariant
: raise Exception
.Create('cannot convert variant variant to field value');
448 varUnknown
: raise Exception
.Create('cannot convert unknown variant to field value');
449 varByte
: mType
:= TType
.TUByte
;
450 varWord
: mType
:= TType
.TUShort
;
451 varShortInt
: mType
:= TType
.TByte
;
452 varSmallint
: mType
:= TType
.TShort
;
453 varInteger
: mType
:= TType
.TInt
;
454 varInt64
: raise Exception
.Create('cannot convert int64 variant to field value');
455 varLongWord
: raise Exception
.Create('cannot convert longword variant to field value');
456 varQWord
: raise Exception
.Create('cannot convert uint64 variant to field value');
457 varError
: raise Exception
.Create('cannot convert error variant to field value');
458 else raise Exception
.Create('cannot convert undetermined variant to field value');
464 destructor TDynField
.Destroy ();
471 procedure TDynField
.cleanup ();
485 mSepPosSize
:= false;
487 mHasDefault
:= false;
499 mBitSetUnique
:= false;
500 mAsMonsterId
:= false;
508 function TDynField
.clone (newOwner
: TDynRecord
=nil; registerIn
: TDynRecord
=nil): TDynField
;
512 result
:= TDynField
.Create(mName
, mType
);
513 result
.mOwner
:= mOwner
;
514 if (newOwner
<> nil) then result
.mOwner
:= newOwner
else result
.mOwner
:= mOwner
;
515 result
.mPasName
:= mPasName
;
516 result
.mName
:= mName
;
517 result
.mType
:= mType
;
518 result
.mIVal
:= mIVal
;
519 result
.mIVal2
:= mIVal2
;
520 result
.mSVal
:= mSVal
;
521 if (mRVal
<> nil) then
523 if (result
.mRVal
= nil) then result
.mRVal
:= TDynRecList
.Create(mRVal
.count
);
524 if (result
.mRHash
= nil) then result
.mRHash
:= hashNewStrInt();
525 for rec
in mRVal
do result
.addListItem(rec
.clone(registerIn
));
527 result
.mRecRef
:= mRecRef
;
528 result
.mMaxDim
:= mMaxDim
;
529 result
.mBinOfs
:= mBinOfs
;
530 result
.mSepPosSize
:= mSepPosSize
;
532 result
.mDefined
:= mDefined
;
533 result
.mHasDefault
:= mHasDefault
;
534 result
.mOmitDef
:= mOmitDef
;
535 result
.mInternal
:= mInternal
;
536 result
.mNegBool
:= mNegBool
;
537 result
.mBitSetUnique
:= mBitSetUnique
;
538 result
.mAsMonsterId
:= mAsMonsterId
;
539 result
.mDefUnparsed
:= mDefUnparsed
;
540 result
.mDefSVal
:= mDefSVal
;
541 result
.mDefIVal
:= mDefIVal
;
542 result
.mDefIVal2
:= mDefIVal2
;
543 result
.mDefRecRef
:= mDefRecRef
;
545 result
.mEBSTypeName
:= mEBSTypeName
;
546 result
.mEBSType
:= mEBSType
;
547 result
.mRecRefId
:= mRecRefId
;
548 result
.mTagInt
:= mTagInt
;
549 result
.mTagPtr
:= mTagPtr
;
553 procedure TDynField
.setIVal (v
: Integer); inline;
561 function TDynField
.getVar (): Variant;
563 if (mEBS
= TEBS
.TRec
) then begin result
:= LongInt(getRecRefIndex
); exit
; end;
565 TType
.TBool
: result
:= (mIVal
<> 0);
566 TType
.TChar
: result
:= mSVal
;
567 TType
.TByte
: result
:= ShortInt(mIVal
);
568 TType
.TUByte
: result
:= Byte(mIVal
);
569 TType
.TShort
: result
:= SmallInt(mIVal
);
570 TType
.TUShort
: result
:= Word(mIVal
);
571 TType
.TInt
: result
:= LongInt(mIVal
);
572 TType
.TUInt
: result
:= LongWord(mIVal
);
573 TType
.TString
: result
:= mSVal
;
574 TType
.TPoint
: raise Exception
.Create('cannot convert point field to variant');
575 TType
.TSize
: raise Exception
.Create('cannot convert size field to variant');
576 TType
.TList
: raise Exception
.Create('cannot convert list field to variant');
577 TType
.TTrigData
: raise Exception
.Create('cannot convert trigdata field to variant');
578 else result
:= Unassigned
; raise Exception
.Create('ketmar forgot to handle some field type');
583 procedure TDynField
.setVar (val
: Variant);
584 procedure setInt32 (v
: LongInt);
588 if (v
= 0) then mIVal
:= 0
589 else if (v
= 1) then mIVal
:= 1
590 else raise Exception
.Create('cannot convert shortint variant to field value');
592 if (v
>= -128) and (v
<= 127) then mIVal
:= v
593 else raise Exception
.Create('cannot convert shortint variant to field value');
595 if (v
>= 0) and (v
<= 255) then mIVal
:= v
596 else raise Exception
.Create('cannot convert shortint variant to field value');
598 if (v
>= -32768) and (v
<= 32767) then mIVal
:= v
599 else raise Exception
.Create('cannot convert shortint variant to field value');
601 if (v
>= 0) and (v
<= 65535) then mIVal
:= v
602 else raise Exception
.Create('cannot convert shortint variant to field value');
608 mSVal
:= formatstrf('%s', [v
]);
610 raise Exception
.Create('cannot convert integral variant to field value');
615 varEmpty
: raise Exception
.Create('cannot convert empty variant to field value');
616 varNull
: raise Exception
.Create('cannot convert null variant to field value');
617 varSingle
: raise Exception
.Create('cannot convert single variant to field value');
618 varDouble
: raise Exception
.Create('cannot convert double variant to field value');
619 varDecimal
: raise Exception
.Create('cannot convert decimal variant to field value');
620 varCurrency
: raise Exception
.Create('cannot convert currency variant to field value');
621 varDate
: raise Exception
.Create('cannot convert date variant to field value');
622 varOleStr
: raise Exception
.Create('cannot convert olestr variant to field value');
623 varStrArg
: raise Exception
.Create('cannot convert stdarg variant to field value');
625 if (mType
= TType
.TChar
) or (mType
= TType
.TString
) then
631 raise Exception
.Create('cannot convert string variant to field value');
633 varDispatch
: raise Exception
.Create('cannot convert dispatch variant to field value');
643 if val
then mIVal
:= 1 else mIVal
:= 0;
645 if val
then mSVal
:= 'true' else mSVal
:= 'false';
647 raise Exception
.Create('cannot convert boolean variant to field value');
649 varVariant
: raise Exception
.Create('cannot convert variant variant to field value');
650 varUnknown
: raise Exception
.Create('cannot convert unknown variant to field value');
658 if (val
< Int64(LongInt($80000000))) or (val
> LongInt($7FFFFFFF)) then
659 raise Exception
.Create('cannot convert boolean variant to field value')
661 mIVal
:= LongInt(val
);
663 if (val
> LongWord($7FFFFFFF)) then raise Exception
.Create('cannot convert longword variant to field value')
664 else setInt32(Integer(val
));
665 varQWord
: raise Exception
.Create('cannot convert uint64 variant to field value');
666 varError
: raise Exception
.Create('cannot convert error variant to field value');
667 else raise Exception
.Create('cannot convert undetermined variant to field value');
673 // won't work for lists
674 function TDynField
.isSimpleEqu (fld
: TDynField
): Boolean;
676 if (fld
= nil) or (mType
<> fld
.mType
) then begin result
:= false; exit
; end;
678 TType
.TBool
: result
:= ((mIVal
<> 0) = (fld
.mIVal
<> 0));
679 TType
.TChar
: result
:= (mSVal
= fld
.mSVal
);
686 result
:= (mIVal
= fld
.mIVal
);
687 TType
.TString
: result
:= (mSVal
= fld
.mSVal
);
690 result
:= ((mIVal
= fld
.mIVal
) and (mIVal2
= fld
.mIVal2
));
691 TType
.TList
: result
:= false;
694 if (mRecRef
= nil) then begin result
:= (fld
.mRecRef
= nil); exit
; end;
695 result
:= mRecRef
.isSimpleEqu(fld
.mRecRef
);
697 else raise Exception
.Create('ketmar forgot to handle some field type');
702 procedure TDynField
.setValue (const s
: AnsiString);
706 stp
:= TStrTextParser
.Create(s
+';');
715 procedure TDynField
.parseDefaultValue ();
717 stp
: TTextParser
= nil;
719 oIVal
, oIVal2
: Integer;
723 if not mHasDefault
then
738 stp
:= TStrTextParser
.Create(mDefUnparsed
+';');
743 mDefRecRef
:= mRecRef
;
756 // default value should be parsed
757 procedure TDynField
.fixDefaultValue ();
759 if mDefined
then exit
;
760 if not mHasDefault
then
762 if mInternal
then exit
;
763 raise Exception
.Create(Format('field ''%s'' in record ''%s'' of record type ''%s'' is not set', [mName
, mOwner
.mId
, mOwner
.mName
]));
765 if (mEBS
= TEBS
.TRec
) then mRecRef
:= mDefRecRef
;
773 // default value should be parsed
774 function TDynField
.isDefaultValue (): Boolean;
776 if not mHasDefault
then begin result
:= false; exit
; end;
777 if (mEBS
= TEBS
.TRec
) then begin result
:= (mRecRef
= mDefRecRef
); exit
; end;
779 TType
.TChar
, TType
.TString
: result
:= (mSVal
= mDefSVal
);
780 TType
.TPoint
, TType
.TSize
: result
:= (mIVal
= mDefIVal2
) and (mIVal2
= mDefIVal2
);
781 TType
.TList
, TType
.TTrigData
: result
:= false; // no default values for those types
782 else result
:= (mIVal
= mDefIVal
);
787 function TDynField
.getListCount (): Integer; inline;
789 if (mRVal
<> nil) then result
:= mRVal
.count
else result
:= 0;
793 function TDynField
.getListItem (idx
: Integer): TDynRecord
; inline; overload
;
795 if (mRVal
<> nil) and (idx
>= 0) and (idx
< mRVal
.count
) then result
:= mRVal
[idx
] else result
:= nil;
799 function TDynField
.getListItem (const aname
: AnsiString): TDynRecord
; inline; overload
;
803 if (mRVal
<> nil) and mRHash
.get(aname
, idx
) then result
:= mRVal
[idx
] else result
:= nil;
807 function TDynField
.addListItem (rec
: TDynRecord
): Boolean; inline;
810 if (mRVal
<> nil) then
813 if (Length(rec
.mId
) > 0) then result
:= mRHash
.put(rec
.mId
, mRVal
.count
-1);
818 class function TDynField
.getTypeName (t
: TType
): AnsiString;
821 TType
.TBool
: result
:= 'bool';
822 TType
.TChar
: result
:= 'char';
823 TType
.TByte
: result
:= 'byte';
824 TType
.TUByte
: result
:= 'ubyte';
825 TType
.TShort
: result
:= 'short';
826 TType
.TUShort
: result
:= 'ushort';
827 TType
.TInt
: result
:= 'int';
828 TType
.TUInt
: result
:= 'uint';
829 TType
.TString
: result
:= 'string';
830 TType
.TPoint
: result
:= 'point';
831 TType
.TSize
: result
:= 'size';
832 TType
.TList
: result
:= 'array';
833 TType
.TTrigData
: result
:= 'trigdata';
834 else raise Exception
.Create('ketmar forgot to handle some field type');
839 function TDynField
.definition (): AnsiString;
841 result
:= mPasName
+' is '+quoteStr(mName
)+' type ';
842 result
+= getTypeName(mType
);
843 if (mMaxDim
>= 0) then result
+= Format('[%d]', [mMaxDim
]);
844 if (mBinOfs
>= 0) then result
+= Format(' offset %d', [mBinOfs
]);
846 TEBS
.TNone
: begin end;
847 TEBS
.TRec
: result
+= ' '+mEBSTypeName
;
848 TEBS
.TEnum
: result
+= ' enum '+mEBSTypeName
;
849 TEBS
.TBitSet
: begin result
+= ' bitset '; if mBitSetUnique
then result
+= 'unique '; result
+= mEBSTypeName
; end;
851 if mAsMonsterId
then result
+= ' as monsterid';
852 if mHasDefault
and (Length(mDefUnparsed
) > 0) then result
+= ' default '+mDefUnparsed
;
855 if (mType
= TType
.TPoint
) then begin if (mAsT
) then result
+= ' as txy' else result
+= ' as xy'; end
856 else if (mType
= TType
.TSize
) then begin if (mAsT
) then result
+= ' as twh' else result
+= ' as wh'; end;
858 if mOmitDef
then result
+= ' omitdefault';
859 if mInternal
then result
+= ' internal';
863 function TDynField
.pasdef (): AnsiString;
865 result
:= mPasName
+': ';
867 TType
.TBool
: result
+= 'Boolean;';
868 TType
.TChar
: if (mMaxDim
> 0) then result
+= formatstrf('Char%d;', [mMaxDim
]) else result
+= 'Char;';
869 TType
.TByte
: result
+= 'ShortInt;';
870 TType
.TUByte
: result
+= 'Byte;';
871 TType
.TShort
: result
+= 'SmallInt;';
872 TType
.TUShort
: result
+= 'Word;';
873 TType
.TInt
: result
+= 'LongInt;';
874 TType
.TUInt
: result
+= 'LongWord;';
875 TType
.TString
: result
+= 'AnsiString;';
877 if mAsT
then result
:= 'tX, tY: Integer;'
878 else if mSepPosSize
then result
:= 'X, Y: Integer;'
879 else result
+= 'TDFPoint;';
881 if mAsT
then result
:= 'tWidth, tHeight: Word;'
882 else if mSepPosSize
then result
:= 'Width, Height: Word;'
883 else result
+= 'TSize;';
884 TType
.TList
: assert(false);
885 TType
.TTrigData
: result
+= formatstrf('Byte%d;', [mMaxDim
]);
886 else raise Exception
.Create('ketmar forgot to handle some field type');
891 procedure TDynField
.parseDef (pr
: TTextParser
);
896 fldrecname
: AnsiString;
897 fldpasname
: AnsiString;
898 asxy
, aswh
, ast
: Boolean;
902 defint
, defint2
: Integer;
907 lebs
: TDynField
.TEBS
;
931 lebs
:= TDynField.TEBS.TNone
;
933 fldpasname
:= pr.expectId
(); // pascal field name
936 fldname
:= pr.expectStr
();
939 fldtype
:= pr.expectId
();
942 if pr.eatDelim
('[') then
944 lmaxdim
:= pr.expectInt
();
945 if
(lmaxdim
< 1) then raise Exception.Create
(Format
('invalid field ''%s'' array size', [fldname
]));
949 while (pr
.tokType
<> pr
.TTSemi
) do
951 if pr
.eatId('offset') then
953 if (fldofs
>= 0) then raise Exception
.Create(Format('duplicate field ''%s'' offset', [fldname
]));
954 fldofs
:= pr
.expectInt();
955 if (fldofs
< 0) then raise Exception
.Create(Format('invalid field ''%s'' offset', [fldname
]));
959 if pr
.eatId('as') then
961 if pr
.eatId('xy') then asxy
:= true
962 else if pr
.eatId('wh') then aswh
:= true
963 else if pr
.eatId('txy') then begin asxy
:= true; ast
:= true; end
964 else if pr
.eatId('twh') then begin aswh
:= true; ast
:= true; end
965 else if pr
.eatId('monsterid') then begin asmonid
:= true
; end
966 else raise Exception.Create
(Format
('invalid field ''%s'' as what?', [fldname
]));
970 if pr
.eatId('enum') then
972 lebs
:= TDynField
.TEBS
.TEnum
;
973 if (Length(fldrecname
) <> 0) then raise Exception
.Create(Format('field ''%s'' already typed as ''%s''', [fldname
, fldrecname
]));
974 fldrecname
:= pr
.expectId();
978 if pr
.eatId('bitset') then
980 lebs
:= TDynField
.TEBS
.TBitSet
;
981 if (Length(fldrecname
) <> 0) then raise Exception
.Create(Format('field ''%s'' already typed as ''%s''', [fldname
, fldrecname
]));
982 unique
:= pr
.eatId('unique');
983 fldrecname
:= pr
.expectId();
987 if pr
.eatId('default') then
989 if hasdefStr
or hasdefInt
or hasdefId
then raise Exception
.Create(Format('field ''%s'' has duplicate default', [fldname
]));
994 defstr
:= pr
.expectStr(true); // allow empty strings
999 defstr
:= pr
.expectId();
1004 defint
:= pr
.expectInt();
1009 if pr
.eatDelim('[') then defech
:= ']' else begin pr
.expectDelim('('); defech
:= ')'; end;
1010 defint
:= pr
.expectInt();
1011 defint2
:= pr
.expectInt();
1012 pr
.expectDelim(defech
);
1015 raise Exception
.Create(Format('field ''%s'' has invalid default', [fldname
]));
1020 if pr
.eatId('omitdefault') then
1026 if pr
.eatId('internal') then
1032 if (pr
.tokType
<> pr
.TTId
) then raise Exception
.Create(Format('field ''%s'' has something unexpected in definition', [fldname
]));
1034 if (Length(fldrecname
) <> 0) then raise Exception
.Create(Format('field ''%s'' already typed as ''%s''', [fldname
, fldrecname
]));
1035 fldrecname
:= pr
.expectId();
1036 lebs
:= TDynField
.TEBS
.TRec
;
1039 pr
.expectTT(pr
.TTSemi
);
1043 if (fldtype
= 'bool') then mType
:= TType
.TBool
1044 else if (fldtype
= 'negbool') then begin mType
:= TType
.TBool
; mNegBool
:= true; end
1045 else if (fldtype
= 'char') then mType
:= TType
.TChar
1046 else if (fldtype
= 'byte') then mType
:= TType
.TByte
1047 else if (fldtype
= 'ubyte') then mType
:= TType
.TUByte
1048 else if (fldtype
= 'short') then mType
:= TType
.TShort
1049 else if (fldtype
= 'ushort') then mType
:= TType
.TUShort
1050 else if (fldtype
= 'int') then mType
:= TType
.TInt
1051 else if (fldtype
= 'uint') then mType
:= TType
.TUInt
1052 else if (fldtype
= 'string') then mType
:= TType
.TString
1053 else if (fldtype
= 'point') then mType
:= TType
.TPoint
1054 else if (fldtype
= 'size') then mType
:= TType
.TSize
1055 else if (fldtype
= 'trigdata') then mType
:= TType
.TTrigData
1056 else raise Exception
.Create(Format('field ''%s'' has invalid type ''%s''', [fldname
, fldtype
]));
1058 if (lmaxdim
> 0) and (mType
<> TType
.TChar
) and (mType
<> TType
.TTrigData
) then raise Exception
.Create(Format('field ''%s'' of type ''%s'' cannot be array', [fldname
, fldtype
]));
1059 if (mType
= TType
.TTrigData
) then
1061 if (lmaxdim
< 1) then raise Exception
.Create(Format('field ''%s'' of type ''%s'' cannot be array', [fldname
, fldtype
]));
1062 if (Length(fldrecname
) > 0) then raise Exception
.Create(Format('field ''%s'' of type ''%s'' cannot have another type', [fldname
, fldtype
]));
1063 lebs
:= TDynField
.TEBS
.TRec
;
1066 if hasdefStr
then self
.mDefUnparsed
:= quoteStr(defstr
)
1067 else if hasdefId
then self
.mDefUnparsed
:= defstr
1068 else if hasdefInt
then
1070 if (mType
= TType
.TPoint
) then self
.mDefUnparsed
:= Format('(%d %d)', [defint
, defint2
])
1071 else if (mType
= TType
.TSize
) then self
.mDefUnparsed
:= Format('[%d %d]', [defint
, defint2
])
1072 else self
.mDefUnparsed
:= Format('%d', [defint
]);
1075 self
.mHasDefault
:= (hasdefStr
or hasdefId
or hasdefInt
);
1076 self
.mPasName
:= fldpasname
;
1078 self
.mEBSTypeName
:= fldrecname
;
1079 self
.mBitSetUnique
:= unique
;
1080 self
.mAsMonsterId
:= asmonid
;
1081 self.mMaxDim
:= lmaxdim
;
1082 self.mBinOfs
:= fldofs
;
1083 self.mSepPosSize
:= (asxy
or aswh
);
1085 self.mOmitDef
:= omitdef
;
1086 self.mInternal
:= ainternal
;
1090 function TDynField
.getRecRefIndex (): Integer;
1092 if (mRecRef
= nil) then begin result
:= -1; exit
; end;
1093 result
:= mOwner
.findRecordNumByType(mEBSTypeName
, mRecRef
);
1097 procedure TDynField
.writeBinTo (st
: TStream
);
1106 TEBS
.TNone
: begin end;
1109 if (mMaxDim
>= 0) then
1111 // this must be triggerdata
1112 if (mType
<> TType
.TTrigData
) then
1114 raise Exception
.Create(Format('record reference type ''%s'' in field ''%s'' cannot be written', [mEBSTypeName
, mName
]));
1116 // write triggerdata
1117 GetMem(buf
, mMaxDim
);
1118 if (buf
= nil) then raise Exception
.Create(Format('record reference type ''%s'' in field ''%s'' cannot be written', [mEBSTypeName
, mName
]));
1120 FillChar(buf
^, mMaxDim
, 0);
1121 if (mRecRef
<> nil) then
1123 ws
:= TSFSMemoryChunkStream
.Create(buf
, mMaxDim
);
1124 mRecRef
.writeBinTo(ws
, mMaxDim
); // as trigdata
1126 st
.WriteBuffer(buf
^, mMaxDim
);
1129 if (buf
<> nil) then FreeMem(buf
);
1135 TType
.TByte
: maxv
:= 127;
1136 TType
.TUByte
: maxv
:= 254;
1137 TType
.TShort
: maxv
:= 32767;
1138 TType
.TUShort
: maxv
:= 65534;
1139 TType
.TInt
: maxv
:= $7fffffff;
1140 TType
.TUInt
: maxv
:= $7fffffff;
1141 else raise Exception
.Create(Format('record reference type ''%s'' in field ''%s'' cannot be written', [mEBSTypeName
, mName
]));
1143 // find record number
1144 if (mRecRef
<> nil) then
1146 f
:= mOwner
.findRecordNumByType(mEBSTypeName
, mRecRef
);
1147 if (f
< 0) then raise Exception
.Create(Format('record reference type ''%s'' in field ''%s'' not found in record list', [mEBSTypeName
, mName
]));
1148 if mAsMonsterId
then Inc(f
);
1149 if (f
> maxv
) then raise Exception
.Create(Format('record reference type ''%s'' in field ''%s'' has too big index', [mEBSTypeName
, mName
]));
1153 if mAsMonsterId
then f
:= 0 else f
:= -1;
1156 TType
.TByte
, TType
.TUByte
: writeInt(st
, Byte(f
));
1157 TType
.TShort
, TType
.TUShort
: writeInt(st
, SmallInt(f
));
1158 TType
.TInt
, TType
.TUInt
: writeInt(st
, LongWord(f
));
1159 else raise Exception
.Create(Format('record reference type ''%s'' in field ''%s'' cannot be written', [mEBSTypeName
, mName
]));
1163 TEBS
.TEnum
: begin end;
1164 TEBS
.TBitSet
: begin end;
1165 else raise Exception
.Create('ketmar forgot to handle some EBS type');
1171 if not mNegBool
then
1173 if (mIVal
<> 0) then writeInt(st
, Byte(1)) else writeInt(st
, Byte(0));
1177 if (mIVal
= 0) then writeInt(st
, Byte(1)) else writeInt(st
, Byte(0));
1183 if (mMaxDim
= 0) then raise Exception
.Create(Format('invalid string size definition for field ''%s''', [mName
]));
1184 if (mMaxDim
< 0) then
1186 if (Length(mSVal
) <> 1) then raise Exception
.Create(Format('invalid string size definition for field ''%s''', [mName
]));
1187 writeInt(st
, Byte(mSVal
[1]));
1191 if (Length(mSVal
) > mMaxDim
) then raise Exception
.Create(Format('invalid string size definition for field ''%s''', [mName
]));
1192 s
:= utf2win(mSVal
);
1193 if (Length(s
) > 0) then st
.WriteBuffer(PChar(s
)^, Length(s
));
1194 for f
:= Length(s
) to mMaxDim
do writeInt(st
, Byte(0));
1201 // triggerdata array was processed earlier
1202 if (mMaxDim
>= 0) then Exception
.Create(Format('byte array in field ''%s'' cannot be written', [mName
]));
1203 writeInt(st
, Byte(mIVal
));
1209 if (mMaxDim
>= 0) then raise Exception
.Create(Format('short array in field ''%s'' cannot be written', [mName
]));
1210 writeInt(st
, Word(mIVal
));
1216 if (mMaxDim
>= 0) then raise Exception
.Create(Format('int array in field ''%s'' cannot be written', [mName
]));
1217 writeInt(st
, LongWord(mIVal
));
1222 raise Exception
.Create(Format('cannot write string field ''%s''', [mName
]));
1226 if (mMaxDim
>= 0) then raise Exception
.Create(Format('pos/size array in field ''%s'' cannot be written', [mName
]));
1227 writeInt(st
, LongInt(mIVal
));
1228 writeInt(st
, LongInt(mIVal2
));
1233 if (mMaxDim
>= 0) then raise Exception
.Create(Format('pos/size array in field ''%s'' cannot be written', [mName
]));
1234 writeInt(st
, Word(mIVal
));
1235 writeInt(st
, Word(mIVal2
));
1248 else raise Exception
.Create('ketmar forgot to handle some field type');
1253 procedure TDynField
.writeTo (wr
: TTextWriter
);
1257 first
, found
: Boolean;
1262 TEBS
.TNone
: begin end;
1265 if (mRecRef
= nil) then
1267 if (mType
= TType
.TTrigData
) then wr
.put('{}'#10) else wr
.put('null;'#10);
1269 else if (Length(mRecRef
.mId
) = 0) then
1271 mRecRef
.writeTo(wr
, false); // only data, no header
1275 wr
.put(mRecRef
.mId
);
1282 //def := mOwner.mOwner;
1283 //es := def.findEBSType(mEBSTypeName);
1285 if (mEBSType
<> nil) and (mEBSType
is TDynEBS
) then es
:= (mEBSType
as TDynEBS
);
1286 if (es
= nil) or (not es
.mIsEnum
) then raise Exception
.Create(Format('record enum type ''%s'' for field ''%s'' not found', [mEBSTypeName
, mName
]));
1287 for f
:= 0 to High(es
.mVals
) do
1289 if (es
.mVals
[f
] = mIVal
) then
1296 raise Exception
.Create(Format('value %d in record enum type ''%s'' for field ''%s'' not found', [mIVal
, mEBSTypeName
, mName
]));
1300 //def := mOwner.mOwner;
1301 //es := def.findEBSType(mEBSTypeName);
1303 if (mEBSType
<> nil) and (mEBSType
is TDynEBS
) then es
:= (mEBSType
as TDynEBS
);
1304 if (es
= nil) or es
.mIsEnum
then raise Exception
.Create(Format('record bitset type ''%s'' for field ''%s'' not found', [mEBSTypeName
, mName
]));
1308 for f
:= 0 to High(es
.mVals
) do
1310 if (es
.mVals
[f
] = 0) then
1317 raise Exception
.Create(Format('value %d in record bitset type ''%s'' for field ''%s'' not found', [0, mEBSTypeName
, mName
]));
1322 while (mask
<> 0) do
1324 if ((mIVal
and mask
) <> 0) then
1327 for f
:= 0 to High(es
.mVals
) do
1329 if (es
.mVals
[f
] = mask
) then
1331 if not first
then wr
.put('+') else first
:= false;
1337 if not found
then raise Exception
.Create(Format('value %d in record bitset type ''%s'' for field ''%s'' not found', [mask
, mEBSTypeName
, mName
]));
1344 else raise Exception
.Create('ketmar forgot to handle some EBS type');
1350 if (mIVal
= 0) then wr
.put('false;'#10) else wr
.put('true;'#10);
1355 if (mMaxDim
= 0) then raise Exception
.Create(Format('invalid string size definition for field ''%s''', [mName
]));
1356 wr
.put(quoteStr(mSVal
));
1367 wr
.put('%d;'#10, [mIVal
]);
1372 wr
.put(quoteStr(mSVal
));
1379 wr
.put('(%d %d);'#10, [mIVal
, mIVal2
]);
1392 else raise Exception
.Create('ketmar forgot to handle some field type');
1394 raise Exception
.Create(Format('cannot parse field ''%s'' yet', [mName
]));
1398 procedure TDynField
.parseBinValue (st
: TStream
);
1400 rec
, rc
: TDynRecord
;
1408 TEBS
.TNone
: begin end;
1411 // this must be triggerdata
1412 if (mType
= TType
.TTrigData
) then
1414 assert(mMaxDim
> 0);
1416 // find trigger definition
1417 tfld
:= rec
.trigTypeField();
1418 if (tfld
= nil) then raise Exception
.Create(Format('triggerdata value for field ''%s'' in record ''%s'' without TriggerType field', [mName
, rec
.mName
]));
1419 rc
:= mOwner
.mOwner
.findTrigFor(tfld
.mSVal
); // find in mapdef
1420 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
]));
1421 rc
:= rc
.clone(mOwner
.mHeaderRec
);
1422 rc
.mHeaderRec
:= mOwner
.mHeaderRec
;
1423 // on error, it will be freed be memowner
1424 rc
.parseBinValue(st
, true);
1431 // not a trigger data
1433 TType
.TByte
: f
:= readShortInt(st
);
1434 TType
.TUByte
: f
:= readByte(st
);
1435 TType
.TShort
: f
:= readSmallInt(st
);
1436 TType
.TUShort
: f
:= readWord(st
);
1437 TType
.TInt
: f
:= readLongInt(st
);
1438 TType
.TUInt
: f
:= readLongWord(st
);
1439 else raise Exception
.Create(Format('invalid non-numeric type ''%s'' for field ''%s'' of record ''%s''', [getTypeName(mType
), mName
, mEBSTypeName
]));
1441 if mAsMonsterId
then Dec(f
);
1442 if (f
< 0) then mRecRefId
:= '' else mRecRefId
:= Format('%s%d', [mEBSTypeName
, f
]);
1450 assert(mMaxDim
< 0);
1452 TType
.TByte
: f
:= readShortInt(st
);
1453 TType
.TUByte
: f
:= readByte(st
);
1454 TType
.TShort
: f
:= readSmallInt(st
);
1455 TType
.TUShort
: f
:= readWord(st
);
1456 TType
.TInt
: f
:= readLongInt(st
);
1457 TType
.TUInt
: f
:= readLongWord(st
);
1458 else raise Exception
.Create(Format('invalid non-numeric type ''%s'' for field ''%s'' of record ''%s''', [getTypeName(mType
), mName
, mEBSTypeName
]));
1461 if (mEBSType
<> nil) and (mEBSType
is TDynEBS
) then es
:= (mEBSType
as TDynEBS
);
1462 if (es
= nil) or (es
.mIsEnum
<> (mEBS
= TEBS
.TEnum
)) then raise Exception
.Create(Format('record enum type ''%s'' for field ''%s'' not found', [mEBSTypeName
, mName
]));
1464 // build enum/bitfield values
1465 if (mEBS
= TEBS
.TEnum
) then
1467 mSVal
:= es
.nameByValue(mIVal
);
1468 if (Length(mSVal
) = 0) then raise Exception
.Create(Format('record enum type ''%s'' for field ''%s'' has invalid value %d', [mEBSTypeName
, mName
, mIVal
]));
1472 // special for 'none'
1475 mSVal
:= es
.nameByValue(mIVal
);
1476 if (Length(mSVal
) = 0) then raise Exception
.Create(Format('record bitset type ''%s'' for field ''%s'' has invalid value %d', [mEBSTypeName
, mName
, mIVal
]));
1482 while (mask
<> 0) do
1484 if ((mIVal
and mask
) <> 0) then
1486 s
:= es
.nameByValue(mask
);
1487 if (Length(s
) = 0) then raise Exception
.Create(Format('record bitset type ''%s'' for field ''%s'' has invalid value %d', [mEBSTypeName
, mName
, mask
]));
1488 if (Length(mSVal
) <> 0) then mSVal
+= '+';
1495 //writeln('ebs <', es.mName, '>: ', mSVal);
1499 else raise Exception
.Create('ketmar forgot to handle some EBS type');
1506 if (f
<> 0) then f
:= 1;
1507 if mNegBool
then f
:= 1-f
;
1514 if (mMaxDim
< 0) then
1516 mIVal
:= readByte(st
);
1521 GetMem(tdata
, mMaxDim
);
1523 st
.ReadBuffer(tdata
^, mMaxDim
);
1525 while (f
< mMaxDim
) and (tdata
[f
] <> 0) do Inc(f
);
1528 SetLength(mSVal
, f
);
1529 Move(tdata
^, PChar(mSVal
)^, f
);
1530 mSVal
:= win2utf(mSVal
);
1539 TType
.TByte
: begin mIVal
:= readShortInt(st
); mDefined
:= true; exit
; end;
1540 TType
.TUByte
: begin mIVal
:= readByte(st
); mDefined
:= true; exit
; end;
1541 TType
.TShort
: begin mIVal
:= readSmallInt(st
); mDefined
:= true; exit
; end;
1542 TType
.TUShort
: begin mIVal
:= readWord(st
); mDefined
:= true; exit
; end;
1543 TType
.TInt
: begin mIVal
:= readLongInt(st
); mDefined
:= true; exit
; end;
1544 TType
.TUInt
: begin mIVal
:= readLongWord(st
); mDefined
:= true; exit
; end;
1547 raise Exception
.Create('cannot read strings from binaries yet');
1552 mIVal
:= readLongInt(st
);
1553 mIVal2
:= readLongInt(st
);
1559 mIVal
:= readWord(st
);
1560 mIVal2
:= readWord(st
);
1574 else raise Exception
.Create('ketmar forgot to handle some field type');
1576 raise Exception
.Create(Format('cannot parse field ''%s'' yet', [mName
]));
1580 procedure TDynField
.parseValue (pr
: TTextParser
);
1582 procedure parseInt (min
, max
: Integer);
1584 mIVal
:= pr
.expectInt();
1585 if (mIVal
< min
) or (mIVal
> max
) then raise Exception
.Create(Format('invalid %s value for field ''%s''', [getTypeName(mType
), mName
]));
1590 rec
, rc
: TDynRecord
;
1596 if (pr
.tokType
= pr
.TTEOF
) then raise Exception
.Create('field value expected');
1597 if (pr
.tokType
= pr
.TTSemi
) then raise Exception
.Create('extra semicolon');
1598 // if this field should contain struct, convert type and parse struct
1600 TEBS
.TNone
: begin end;
1603 // ugly hack. sorry.
1604 if (mType
= TType
.TTrigData
) then
1606 pr
.expectTT(pr
.TTBegin
);
1607 if (pr
.tokType
= pr
.TTEnd
) then
1611 pr
.expectTT(pr
.TTEnd
);
1616 // find trigger definition
1617 tfld
:= rec
.trigTypeField();
1618 if (tfld
= nil) then raise Exception
.Create(Format('triggerdata value for field ''%s'' in record ''%s'' without ''type'' field', [mName
, rec
.mName
]));
1619 rc
:= mOwner
.mOwner
.findTrigFor(tfld
.mSVal
); // find in mapdef
1620 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
]));
1621 rc
:= rc
.clone(mOwner
.mHeaderRec
);
1622 rc
.mHeaderRec
:= mOwner
.mHeaderRec
;
1623 //writeln(rc.definition);
1624 // on error, it will be freed be memowner
1625 rc
.parseValue(pr
, true);
1629 pr
.eatTT(pr
.TTSemi
); // hack: allow (but don't require) semicolon after inline records
1632 // other record types
1633 if (pr
.tokType
= pr
.TTId
) then
1635 if pr
.eatId('null') then
1641 rec
:= mOwner
.findRecordByTypeId(mEBSTypeName
, pr
.tokStr
);
1644 //raise Exception.Create(Format('record ''%s'' (%s) value for field ''%s'' not found', [pr.tokStr, mEBSTypeName, mName]));
1645 mRecRefId
:= pr
.tokStr
;
1655 pr
.expectTT(pr
.TTSemi
);
1658 else if (pr
.tokType
= pr
.TTBegin
) then
1660 //rec := mOwner.mOwner.findRecType(mEBSTypeName); // find in mapdef
1662 if (mEBSType
<> nil) and (mEBSType
is TDynRecord
) then rec
:= (mEBSType
as TDynRecord
);
1663 if (rec
= nil) then raise Exception
.Create(Format('record type ''%s'' for field ''%s'' not found', [mEBSTypeName
, mName
]));
1664 rc
:= rec
.clone(mOwner
.mHeaderRec
);
1665 rc
.mHeaderRec
:= mOwner
.mHeaderRec
;
1669 if mOwner
.addRecordByType(mEBSTypeName
, rc
) then
1671 //raise Exception.Create(Format('record type ''%s'' for field ''%s'' not found', [mEBSTypeName, mName]));
1672 e_LogWritefln('duplicate record with id ''%s'' for field ''%s'' in record ''%s''', [rc
.mId
, mName
, mOwner
.mName
]);
1674 pr
.eatTT(pr
.TTSemi
); // hack: allow (but don't require) semicolon after inline records
1677 pr
.expectTT(pr
.TTBegin
);
1681 //es := mOwner.mOwner.findEBSType(mEBSTypeName); // find in mapdef
1683 if (mEBSType
<> nil) and (mEBSType
is TDynEBS
) then es
:= (mEBSType
as TDynEBS
);
1684 if (es
= nil) or (not es
.mIsEnum
) then raise Exception
.Create(Format('record enum type ''%s'' for field ''%s'' not found', [mEBSTypeName
, mName
]));
1685 tk
:= pr
.expectId();
1686 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
]));
1687 mIVal
:= es
.field
[tk
];
1689 //writeln('ENUM ', mEBSName, '; element <', mSVal, '> with value ', mIVal);
1691 pr
.expectTT(pr
.TTSemi
);
1696 //es := mOwner.mOwner.findEBSType(mEBSTypeName); // find in mapdef
1698 if (mEBSType
<> nil) and (mEBSType
is TDynEBS
) then es
:= (mEBSType
as TDynEBS
);
1699 if (es
= nil) or es
.mIsEnum
then raise Exception
.Create(Format('record bitset type ''%s'' for field ''%s'' not found', [mEBSTypeName
, mName
]));
1703 tk
:= pr
.expectId();
1704 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
]));
1705 mIVal
:= mIVal
or es
.field
[tk
];
1707 if (pr
.tokType
<> pr
.TTDelim
) or ((pr
.tokChar
<> '|') and (pr
.tokChar
<> '+')) then break
;
1708 if mBitSetUnique
then raise Exception
.Create(Format('record bitset of type ''%s'' for field ''%s'' expects only one value', [tk
, mEBSTypeName
, mName
]));
1709 //pr.expectDelim('|');
1710 pr
.skipToken(); // plus or pipe
1713 pr
.expectTT(pr
.TTSemi
);
1716 else raise Exception
.Create('ketmar forgot to handle some EBS type');
1722 if pr
.eatId('true') or pr
.eatId('tan') or pr
.eatId('yes') then mIVal
:= 1
1723 else if pr
.eatId('false') or pr
.eatId('ona') or pr
.eatId('no') then mIVal
:= 0
1724 else raise Exception
.Create(Format('invalid bool value for field ''%s''', [mName
]));
1726 pr
.expectTT(pr
.TTSemi
);
1731 if (mMaxDim
= 0) then raise Exception
.Create(Format('invalid string size definition for field ''%s''', [mName
]));
1732 mSVal
:= pr
.expectStr(true);
1733 if (mMaxDim
< 0) then
1736 if (Length(mSVal
) <> 1) then raise Exception
.Create(Format('invalid string size for field ''%s''', [mName
]));
1737 mIVal
:= Integer(mSVal
[1]);
1743 if (Length(mSVal
) > mMaxDim
) then raise Exception
.Create(Format('invalid string size for field ''%s''', [mName
]));
1746 pr
.expectTT(pr
.TTSemi
);
1751 parseInt(-128, 127);
1752 pr
.expectTT(pr
.TTSemi
);
1758 pr
.expectTT(pr
.TTSemi
);
1763 parseInt(-32768, 32768);
1764 pr
.expectTT(pr
.TTSemi
);
1770 pr
.expectTT(pr
.TTSemi
);
1775 parseInt(Integer($80000000), $7fffffff);
1776 pr
.expectTT(pr
.TTSemi
);
1781 parseInt(0, $7fffffff); //FIXME
1782 pr
.expectTT(pr
.TTSemi
);
1787 mSVal
:= pr
.expectStr(true);
1789 pr
.expectTT(pr
.TTSemi
);
1795 if pr
.eatDelim('[') then edim
:= ']' else begin pr
.expectDelim('('); edim
:= ')'; end;
1796 mIVal
:= pr
.expectInt();
1797 if (mType
= TType
.TSize
) then
1799 if (mIVal
< 0) or (mIVal
> 32767) then raise Exception
.Create(Format('invalid %s value for field ''%s''', [getTypeName(mType
), mName
]));
1801 mIVal2
:= pr
.expectInt();
1802 if (mType
= TType
.TSize
) then
1804 if (mIVal2
< 0) or (mIVal2
> 32767) then raise Exception
.Create(Format('invalid %s value for field ''%s''', [getTypeName(mType
), mName
]));
1807 pr
.expectDelim(edim
);
1808 pr
.expectTT(pr
.TTSemi
);
1821 else raise Exception
.Create('ketmar forgot to handle some field type');
1823 raise Exception
.Create(Format('cannot parse field ''%s'' yet', [mName
]));
1827 // ////////////////////////////////////////////////////////////////////////// //
1828 constructor TDynRecord
.Create (pr
: TTextParser
);
1830 if (pr
= nil) then raise Exception
.Create('cannot create record type without type definition');
1834 mFields
:= TDynFieldList
.Create();
1835 {$IF DEFINED(XDYNREC_USE_FIELDHASH)}
1836 mFieldsHash
:= hashNewStrInt();
1848 constructor TDynRecord
.Create ();
1852 mFields
:= TDynFieldList
.Create();
1853 {$IF DEFINED(XDYNREC_USE_FIELDHASH)}
1854 mFieldsHash
:= hashNewStrInt();
1865 destructor TDynRecord
.Destroy ();
1870 if (mRec2Free
<> nil) then
1872 for rec
in mRec2Free
do
1874 if (rec
<> self
) then
1876 //writeln(formatstrf('freeing: 0x%08x; name=%s; id=%s', [Pointer(rec), rec.mName, rec.mId]));
1884 for fld
in mFields
do fld
.Free();
1887 {$IF DEFINED(XDYNREC_USE_FIELDHASH)}
1899 procedure TDynRecord
.regrec (rec
: TDynRecord
);
1901 if (rec
<> nil) and (rec
<> self
) then
1903 if (mRec2Free
= nil) then mRec2Free
:= TDynRecList
.Create();
1904 mRec2Free
.append(rec
);
1909 procedure TDynRecord
.addField (fld
: TDynField
); inline;
1911 if (fld
= nil) then raise Exception
.Create('cannot append nil field to record');
1912 mFields
.append(fld
);
1913 {$IF DEFINED(XDYNREC_USE_FIELDHASH)}
1914 if (Length(fld
.mName
) > 0) then mFieldsHash
.put(fld
.mName
, mFields
.count
-1);
1919 function TDynRecord
.addFieldChecked (fld
: TDynField
): Boolean; inline; // `true`: duplicate name
1922 if (fld
= nil) then raise Exception
.Create('cannot append nil field to record');
1923 {$IF not DEFINED(XDYNREC_USE_FIELDHASH)}
1924 if (Length(fld
.mName
) > 0) then result
:= hasByName(fld
.mName
);
1926 mFields
.append(fld
);
1927 {$IF DEFINED(XDYNREC_USE_FIELDHASH)}
1928 if (Length(fld
.mName
) > 0) then result
:= mFieldsHash
.put(fld
.mName
, mFields
.count
-1);
1933 function TDynRecord
.findByName (const aname
: AnsiString): Integer; inline;
1935 {$IF DEFINED(XDYNREC_USE_FIELDHASH)}
1936 if not mFieldsHash
.get(aname
, result
) then result
:= -1;
1939 while (result
< mFields
.count
) do
1941 if StrEqu(aname
, mFields
[result
].mName
) then exit
;
1949 function TDynRecord
.hasByName (const aname
: AnsiString): Boolean; inline;
1951 result
:= (findByName(aname
) >= 0);
1955 function TDynRecord
.getFieldByName (const aname
: AnsiString): TDynField
; inline;
1959 f
:= findByName(aname
);
1960 if (f
>= 0) then result
:= mFields
[f
] else result
:= nil;
1964 function TDynRecord
.getFieldAt (idx
: Integer): TDynField
; inline;
1966 if (idx
>= 0) and (idx
< mFields
.count
) then result
:= mFields
[idx
] else result
:= nil;
1970 function TDynRecord
.getCount (): Integer; inline;
1972 result
:= mFields
.count
;
1976 function TDynRecord
.getIsTrigData (): Boolean; inline;
1978 result
:= (Length(mTrigTypes
) > 0);
1982 function TDynRecord
.getIsForTrig (const aname
: AnsiString): Boolean; inline;
1987 for f
:= 0 to High(mTrigTypes
) do if StrEqu(mTrigTypes
[f
], aname
) then exit
;
1992 function TDynRecord
.getForTrigCount (): Integer; inline;
1994 result
:= Length(mTrigTypes
);
1998 function TDynRecord
.getForTrigAt (idx
: Integer): AnsiString; inline;
2000 if (idx
>= 0) and (idx
< Length(mTrigTypes
)) then result
:= mTrigTypes
[idx
] else result
:= '';
2004 function TDynRecord
.clone (registerIn
: TDynRecord
): TDynRecord
;
2009 result
:= TDynRecord
.Create();
2010 result
.mOwner
:= mOwner
;
2012 result
.mPasName
:= mPasName
;
2013 result
.mName
:= mName
;
2014 result
.mSize
:= mSize
;
2015 result
.mHeader
:= mHeader
;
2016 result
.mBinBlock
:= mBinBlock
;
2017 result
.mHeaderRec
:= mHeaderRec
;
2018 result
.mTagInt
:= mTagInt
;
2019 result
.mTagPtr
:= mTagPtr
;
2020 if (mFields
.count
> 0) then
2022 result
.mFields
.capacity
:= mFields
.count
;
2023 for fld
in mFields
do result
.addField(fld
.clone(result
, registerIn
));
2025 SetLength(result
.mTrigTypes
, Length(mTrigTypes
));
2026 for f
:= 0 to High(mTrigTypes
) do result
.mTrigTypes
[f
] := mTrigTypes
[f
];
2027 if (registerIn
<> nil) then registerIn
.regrec(result
);
2031 function TDynRecord
.findRecordByTypeId (const atypename
, aid
: AnsiString): TDynRecord
;
2037 if (Length(aid
) = 0) then exit
;
2039 fld
:= mHeaderRec
.field
[atypename
];
2040 if (fld
= nil) then exit
;
2041 if (fld
.mType
<> fld
.TType
.TList
) then raise Exception
.Create(Format('cannot get record of type ''%s'' due to name conflict with ordinary field', [atypename
]));
2043 if (fld
.mRVal
<> nil) then
2045 if fld
.mRHash
.get(aid
, idx
) then begin result
:= fld
.mRVal
[idx
]; exit
; end;
2051 function TDynRecord
.findRecordNumByType (const atypename
: AnsiString; rc
: TDynRecord
): Integer;
2058 fld
:= mHeaderRec
.field
[atypename
];
2059 if (fld
= nil) then exit
;
2060 if (fld
.mType
<> fld
.TType
.TList
) then raise Exception
.Create(Format('cannot get record of type ''%s'' due to name conflict with ordinary field', [atypename
]));
2062 if (fld
.mRVal
<> nil) then
2064 for idx
:= 0 to fld
.mRVal
.count
-1 do
2066 if (fld
.mRVal
[idx
] = rc
) then begin result
:= idx
; exit
; end;
2073 function TDynRecord
.addRecordByType (const atypename
: AnsiString; rc
: TDynRecord
): Boolean;
2078 fld
:= mHeaderRec
.field
[atypename
];
2082 fld
:= TDynField
.Create(atypename
, TDynField
.TType
.TList
);
2083 fld
.mOwner
:= mHeaderRec
;
2084 mHeaderRec
.addField(fld
);
2086 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
]));
2088 if (fld
.mRVal
= nil) then
2090 fld
.mRVal
:= TDynRecList
.Create();
2091 fld
.mRHash
:= hashNewStrInt();
2093 result
:= fld
.addListItem(rc
);
2097 function TDynRecord
.isSimpleEqu (rec
: TDynRecord
): Boolean;
2101 if (rec
= nil) then begin result
:= false; exit
; end; // self.mRecRef can't be `nil` here
2102 if (rec
= self
) then begin result
:= true; exit
; end;
2103 if (mFields
.count
<> rec
.mFields
.count
) then begin result
:= false; exit
; end;
2105 for f
:= 0 to mFields
.count
-1 do
2107 if not mFields
[f
].isSimpleEqu(rec
.mFields
[f
]) then exit
;
2113 function TDynRecord
.trigTypeField (): TDynField
;
2118 for fld
in mFields
do
2120 if (fld
.mEBS
<> TDynField
.TEBS
.TEnum
) then continue
;
2121 if not (fld
.mEBSType
is TDynEBS
) then continue
;
2122 es
:= (fld
.mEBSType
as TDynEBS
);
2124 if StrEqu(es
.mName
, 'TriggerType') then begin result
:= fld
; exit
; end;
2130 // number of records of the given instance
2131 function TDynRecord
.instanceCount (const typename
: AnsiString): Integer;
2136 fld
:= field
[typename
];
2137 if (fld
<> nil) and (fld
.mType
= fld
.TType
.TList
) then result
:= fld
.mRVal
.count
;
2141 function TDynRecord
.getUserVar (const aname
: AnsiString): Variant;
2145 fld
:= getFieldByName(aname
);
2146 if (fld
= nil) then result
:= Unassigned
else result
:= fld
.varvalue
;
2150 procedure TDynRecord
.setUserVar (const aname
: AnsiString; val
: Variant);
2154 fld
:= getFieldByName(aname
);
2157 if (Length(aname
) = 0) then raise Exception
.Create('cannot create nameless user field');
2158 fld
:= TDynField
.Create(aname
, val
);
2160 fld
.mInternal
:= true;
2165 fld
.varvalue
:= val
;
2170 procedure TDynRecord
.parseDef (pr
: TTextParser
);
2175 if pr
.eatId('TriggerData') then
2178 if pr
.eatDelim('(') then
2182 while pr
.eatTT(pr
.TTComma
) do begin end;
2183 if pr
.eatDelim(')') then break
;
2184 tdn
:= pr
.expectId();
2185 if isForTrig
[tdn
] then raise Exception
.Create(Format('duplicate trigdata ''%s'' trigtype ''%s''', [mName
, tdn
]));
2186 SetLength(mTrigTypes
, Length(mTrigTypes
)+1);
2187 mTrigTypes
[High(mTrigTypes
)] := tdn
;
2192 tdn
:= pr
.expectId();
2193 SetLength(mTrigTypes
, 1);
2194 mTrigTypes
[0] := tdn
;
2196 mName
:= 'TriggerData';
2200 mPasName
:= pr
.expectId(); // pascal record name
2202 mName
:= pr
.expectStr();
2203 while (pr
.tokType
<> pr
.TTBegin
) do
2205 if pr
.eatId('header') then begin mHeader
:= true; continue
; end;
2206 if pr
.eatId('size') then
2208 if (mSize
> 0) then raise Exception
.Create(Format('duplicate `size` in record ''%s''', [mName
]));
2209 mSize
:= pr
.expectInt();
2210 if (mSize
< 1) then raise Exception
.Create(Format('invalid record ''%s'' size: %d', [mName
, mSize
]));
2211 pr
.expectId('bytes');
2214 if pr
.eatId('binblock') then
2216 if (mBinBlock
>= 0) then raise Exception
.Create(Format('duplicate `binblock` in record ''%s''', [mName
]));
2217 mBinBlock
:= pr
.expectInt();
2218 if (mBinBlock
< 1) then raise Exception
.Create(Format('invalid record ''%s'' binblock: %d', [mName
, mBinBlock
]));
2224 pr
.expectTT(pr
.TTBegin
);
2226 while (pr
.tokType
<> pr
.TTEnd
) do
2228 fld
:= TDynField
.Create(pr
);
2229 //if hasByName(fld.name) then begin fld.Free(); raise Exception.Create(Format('duplicate field ''%s''', [fld.name])); end;
2232 if addFieldChecked(fld
) then
2235 raise Exception
.Create(Format('duplicate field ''%s''', [fld
.name
]));
2239 pr
.expectTT(pr
.TTEnd
);
2243 function TDynRecord
.pasdef (): AnsiString;
2255 result
:= ' '+mPasName
+' = packed record'#10;
2257 for fld
in mFields
do
2259 if fld
.mInternal
then continue
;
2260 if (fld
.mBinOfs
< 0) then continue
;
2261 result
+= ' '+fld
.pasdef
+#10;
2263 result
+= ' end;'#10;
2267 function TDynRecord
.definition (): AnsiString;
2274 result
:= 'TriggerData for ';
2275 if (Length(mTrigTypes
) > 1) then
2278 for f
:= 0 to High(mTrigTypes
) do
2280 if (f
<> 0) then result
+= ', ';
2281 result
+= mTrigTypes
[f
];
2287 result
+= mTrigTypes
[0];
2293 result
:= mPasName
+' is '+quoteStr(mName
);
2294 if (mSize
>= 0) then result
+= Format(' size %d bytes', [mSize
]);
2295 if mHeader
then result
+= ' header';
2298 for f
:= 0 to mFields
.count
-1 do
2301 result
+= mFields
[f
].definition
;
2308 procedure TDynRecord
.parseBinValue (st
: TStream
; forceData
: Boolean=false);
2314 loaded
: array[0..255] of Boolean;
2315 rec
, rect
: TDynRecord
;
2318 mst
: TSFSMemoryChunkStream
= nil;
2320 procedure linkNames (rec
: TDynRecord
);
2325 //writeln('*** rec: ', rec.mName, '.', rec.mId, ' (', rec.mFields.count, ')');
2326 for fld
in rec
.mFields
do
2328 if (fld
.mType
= TDynField
.TType
.TTrigData
) then
2330 if (fld
.mRecRef
<> nil) then linkNames(fld
.mRecRef
);
2333 if (Length(fld
.mRecRefId
) = 0) then continue
;
2334 assert(fld
.mEBSType
<> nil);
2335 rt
:= findRecordByTypeId(fld
.mEBSTypeName
, fld
.mRecRefId
);
2338 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
);
2339 //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]));
2341 //writeln(' ', rec.mName, '.', rec.mId, ':', fld.mName, ' -> ', rt.mName, '.', rt.mId, ' (', fld.mEBSTypeName, '.', fld.mRecRefId, ')');
2342 fld
.mRecRefId
:= '';
2344 fld
.mDefined
:= true;
2346 for fld
in rec
.mFields
do
2348 //writeln(' ', fld.mName);
2349 fld
.fixDefaultValue(); // just in case
2354 for f
:= 0 to High(loaded
) do loaded
[f
] := false;
2355 mst
:= TSFSMemoryChunkStream
.Create(nil, 0);
2357 if mHeader
and not forceData
then
2359 // parse map file as sequence of blocks
2361 st
.ReadBuffer(sign
[1], 4);
2362 if (sign
<> 'MAP'#1) then raise Exception
.Create('invalid binary map signature');
2364 while (st
.position
< st
.size
) do
2366 btype
:= readByte(st
);
2367 if (btype
= 0) then break
; // no more blocks
2368 readLongWord(st
); // reserved
2369 bsize
:= readLongInt(st
);
2370 {$IF DEFINED(D2D_XDYN_DEBUG)}writeln('btype=', btype
, '; bsize=', bsize
);{$ENDIF}
2371 if (bsize
< 0) or (bsize
> $1fffffff) then raise Exception
.Create(Format('block of type %d has invalid size %d', [btype
, bsize
]));
2372 if loaded
[btype
] then raise Exception
.Create(Format('block of type %d already loaded', [btype
]));
2373 loaded
[btype
] := true;
2374 // find record type for this block
2376 for rec
in mOwner
.recTypes
do if (rec
.mBinBlock
= btype
) then begin rect
:= rec
; break
; end;
2377 if (rect
= nil) then raise Exception
.Create(Format('block of type %d has no corresponding record', [btype
]));
2378 //writeln('found type ''', rec.mName, ''' for block type ', btype);
2379 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
]));
2381 if (rect
.mHeader
) then
2383 if (bsize
<> mSize
) then raise Exception
.Create(Format('header block of type %d has invalid number of records', [btype
]));
2385 st
.ReadBuffer(buf
^, bsize
);
2386 mst
.setup(buf
, mSize
);
2387 parseBinValue(mst
, true); // force parsing data
2391 // create list for this type
2392 fld
:= TDynField
.Create(rec
.mName
, TDynField
.TType
.TList
);
2398 st
.ReadBuffer(buf
^, bsize
);
2399 for f
:= 0 to (bsize
div rec
.mSize
)-1 do
2401 mst
.setup(buf
+f
*rec
.mSize
, rec
.mSize
);
2402 rec
:= rect
.clone(self
);
2403 rec
.mHeaderRec
:= self
;
2404 rec
.parseBinValue(mst
);
2405 rec
.mId
:= Format('%s%d', [rec
.mName
, f
]);
2406 fld
.addListItem(rec
);
2407 //writeln('parsed ''', rec.mId, '''...');
2413 //st.position := st.position+bsize;
2416 for fld
in mFields
do
2418 if (fld
.mType
<> TDynField
.TType
.TList
) then continue
;
2419 for rec
in fld
.mRVal
do linkNames(rec
);
2425 if StrEqu(mName
, 'TriggerData') then mSize
:= Integer(st
.size
-st
.position
);
2426 if (mSize
< 1) then raise Exception
.Create(Format('cannot read record of type ''%s'' with unknown size', [mName
]));
2428 st
.ReadBuffer(buf
^, mSize
);
2429 for fld
in mFields
do
2431 if fld
.mInternal
then continue
;
2432 if (fld
.mBinOfs
< 0) then continue
;
2433 if (fld
.mBinOfs
>= st
.size
) then raise Exception
.Create(Format('record of type ''%s'' has invalid field ''%s''', [fld
.mName
]));
2434 mst
.setup(buf
+fld
.mBinOfs
, mSize
-fld
.mBinOfs
);
2435 //writeln('parsing ''', mName, '.', fld.mName, '''...');
2436 fld
.parseBinValue(mst
);
2440 if (buf
<> nil) then FreeMem(buf
);
2445 procedure TDynRecord
.writeBinTo (st
: TStream
; trigbufsz
: Integer=-1; onlyFields
: Boolean=false);
2448 rec
, rv
: TDynRecord
;
2451 blk
, blkmax
: Integer;
2456 if (trigbufsz
< 0) then
2458 if (mBinBlock
< 1) then raise Exception
.Create('cannot write binary record without block number');
2459 if (mSize
< 1) then raise Exception
.Create('cannot write binary record without size');
2468 FillChar(buf
^, bufsz
, 0);
2469 ws
:= TSFSMemoryChunkStream
.Create(buf
, bufsz
);
2471 // write normal fields
2472 for fld
in mFields
do
2475 if (fld
.mType
= fld
.TType
.TList
) then continue
; // later
2476 if fld
.mInternal
then continue
;
2477 if (fld
.mBinOfs
< 0) then continue
;
2478 if (fld
.mBinOfs
>= bufsz
) then raise Exception
.Create('binary value offset is outside of the buffer');
2479 TSFSMemoryChunkStream(ws
).setup(buf
+fld
.mBinOfs
, bufsz
-fld
.mBinOfs
);
2480 //writeln('writing field <', fld.mName, '>');
2484 // write block with normal fields
2485 if mHeader
and not onlyFields
then
2487 //writeln('writing header...');
2488 // signature and version
2489 writeIntBE(st
, LongWord($4D415001));
2490 writeInt(st
, Byte(mBinBlock
)); // type
2491 writeInt(st
, LongWord(0)); // reserved
2492 writeInt(st
, LongWord(bufsz
)); // size
2494 st
.WriteBuffer(buf
^, bufsz
);
2496 ws
.Free(); ws
:= nil;
2497 FreeMem(buf
); buf
:= nil;
2499 // write other blocks, if any
2500 if mHeader
and not onlyFields
then
2504 for fld
in mFields
do
2507 if (fld
.mType
= fld
.TType
.TList
) then
2509 if (fld
.mRVal
= nil) or (fld
.mRVal
.count
= 0) then continue
;
2510 rec
:= mOwner
.findRecType(fld
.mName
);
2511 if (rec
= nil) then continue
;
2512 if (rec
.mBinBlock
<= 0) then continue
;
2513 if (blkmax
< rec
.mBinBlock
) then blkmax
:= rec
.mBinBlock
;
2517 for blk
:= 1 to blkmax
do
2519 if (blk
= mBinBlock
) then continue
;
2521 for fld
in mFields
do
2524 if (fld
.mType
= fld
.TType
.TList
) then
2526 if (fld
.mRVal
= nil) or (fld
.mRVal
.count
= 0) then continue
;
2527 rec
:= mOwner
.findRecType(fld
.mName
);
2528 if (rec
= nil) then continue
;
2529 if (rec
.mBinBlock
<> blk
) then continue
;
2530 if (ws
= nil) then ws
:= TMemoryStream
.Create();
2531 for rv
in fld
.mRVal
do rv
.writeBinTo(ws
);
2537 blksz
:= Integer(ws
.position
);
2539 writeInt(st
, Byte(blk
)); // type
2540 writeInt(st
, LongWord(0)); // reserved
2541 writeInt(st
, LongWord(blksz
)); // size
2542 st
.CopyFrom(ws
, blksz
);
2548 writeInt(st
, Byte(0));
2549 writeInt(st
, LongWord(0));
2550 writeInt(st
, LongWord(0));
2554 if (buf
<> nil) then FreeMem(buf
);
2559 procedure TDynRecord
.writeTo (wr
: TTextWriter
; putHeader
: Boolean=true);
2567 if (Length(mId
) > 0) then begin wr
.put(' '); wr
.put(mId
); end;
2573 for fld
in mFields
do
2576 if (fld
.mType
= fld
.TType
.TList
) then
2578 if not mHeader
then raise Exception
.Create('record list in non-header record');
2579 if (fld
.mRVal
<> nil) then
2581 for rec
in fld
.mRVal
do
2583 if (Length(rec
.mId
) = 0) then continue
;
2585 rec
.writeTo(wr
, true);
2590 if fld
.mInternal
then continue
;
2591 if fld
.mOmitDef
and fld
.isDefaultValue
then continue
;
2603 {$IF DEFINED(D2D_DYNREC_PROFILER)}
2605 profCloneRec
: UInt64 = 0;
2606 profFindRecType
: UInt64 = 0;
2607 profFieldSearching
: UInt64 = 0;
2608 profListDupChecking
: UInt64 = 0;
2609 profAddRecByType
: UInt64 = 0;
2610 profFieldValParsing
: UInt64 = 0;
2611 profFixDefaults
: UInt64 = 0;
2612 profRecValParse
: UInt64 = 0;
2614 procedure xdynDumpProfiles ();
2616 writeln('=== XDYNREC PROFILES ===');
2617 writeln('record cloning: ', profCloneRec
div 1000, '.', profCloneRec
mod 1000, ' milliseconds');
2618 writeln('findRecType : ', profFindRecType
div 1000, '.', profFindRecType
mod 1000, ' milliseconds');
2619 writeln('field[] : ', profFieldSearching
div 1000, '.', profFieldSearching
mod 1000, ' milliseconds');
2620 writeln('list dup check: ', profListDupChecking
div 1000, '.', profListDupChecking
mod 1000, ' milliseconds');
2621 writeln('addRecByType : ', profAddRecByType
div 1000, '.', profAddRecByType
mod 1000, ' milliseconds');
2622 writeln('field valparse: ', profFieldValParsing
div 1000, '.', profFieldValParsing
mod 1000, ' milliseconds');
2623 writeln('fix defaults : ', profFixDefaults
div 1000, '.', profFixDefaults
mod 1000, ' milliseconds');
2624 writeln('recvalparse : ', profRecValParse
div 1000, '.', profRecValParse
mod 1000, ' milliseconds');
2629 procedure TDynRecord
.parseValue (pr
: TTextParser
; beginEaten
: Boolean=false);
2632 rec
: TDynRecord
= nil;
2633 trc
{, rv}: TDynRecord
;
2634 {$IF DEFINED(D2D_DYNREC_PROFILER)}
2638 procedure linkNames (rec
: TDynRecord
);
2643 //writeln('*** rec: ', rec.mName, '.', rec.mId, ' (', rec.mFields.count, ')');
2644 for fld
in rec
.mFields
do
2646 if (fld
.mType
= TDynField
.TType
.TTrigData
) then
2648 if (fld
.mRecRef
<> nil) then linkNames(fld
.mRecRef
);
2651 if (Length(fld
.mRecRefId
) = 0) then continue
;
2652 assert(fld
.mEBSType
<> nil);
2653 rt
:= findRecordByTypeId(fld
.mEBSTypeName
, fld
.mRecRefId
);
2656 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
);
2657 //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]));
2659 //writeln(' ', rec.mName, '.', rec.mId, ':', fld.mName, ' -> ', rt.mName, '.', rt.mId, ' (', fld.mEBSTypeName, '.', fld.mRecRefId, ')');
2660 fld
.mRecRefId
:= '';
2662 fld
.mDefined
:= true;
2664 for fld
in rec
.mFields
do
2666 //writeln(' ', fld.mName);
2667 fld
.fixDefaultValue(); // just in case
2672 if (mOwner
= nil) then raise Exception
.Create(Format('can''t parse record ''%s'' value without owner', [mName
]));
2674 {$IF DEFINED(D2D_DYNREC_PROFILER)}stall
:= curTimeMicro();{$ENDIF}
2680 if (not beginEaten
) and (pr
.tokType
= pr
.TTId
) then mId
:= pr
.expectId();
2684 assert(mHeaderRec
= self
);
2687 //writeln('parsing record <', mName, '>');
2688 if not beginEaten
then pr
.expectTT(pr
.TTBegin
);
2689 while (pr
.tokType
<> pr
.TTEnd
) do
2691 if (pr
.tokType
<> pr
.TTId
) then raise Exception
.Create('identifier expected');
2692 //writeln('<', mName, '.', pr.tokStr, '>');
2697 // add records with this type (if any)
2698 {$IF DEFINED(D2D_DYNREC_PROFILER)}stt
:= curTimeMicro();{$ENDIF}
2699 trc
:= mOwner
.findRecType(pr
.tokStr
);
2700 {$IF DEFINED(D2D_DYNREC_PROFILER)}profFindRecType
:= curTimeMicro()-stt
;{$ENDIF}
2701 if (trc
<> nil) then
2703 {$IF DEFINED(D2D_DYNREC_PROFILER)}stt
:= curTimeMicro();{$ENDIF}
2704 rec
:= trc
.clone(mHeaderRec
);
2705 {$IF DEFINED(D2D_DYNREC_PROFILER)}profCloneRec
:= curTimeMicro()-stt
;{$ENDIF}
2706 rec
.mHeaderRec
:= mHeaderRec
;
2707 // on error, it will be freed be memowner
2711 if (Length(rec.mId) > 0) then
2713 {$IF DEFINED(D2D_DYNREC_PROFILER)}stt := curTimeMicro();{$ENDIF}
2714 fld := field[pr.tokStr];
2715 {$IF DEFINED(D2D_DYNREC_PROFILER)}profFieldSearching := curTimeMicro()-stt;{$ENDIF}
2717 if (fld <> nil) and (fld.mRVal <> nil) then
2719 {$IF DEFINED(D2D_DYNREC_PROFILER)}stt := curTimeMicro();{$ENDIF}
2720 //idtmp := trc.mName+':'+rec.mId;
2721 //if ids.put(idtmp, 1) then raise Exception.Create(Format('duplicate thing ''%s'' in record ''%s''', [fld.mName, mName]));
2722 if fld.mRHash.has(rec.mId) then raise Exception.Create(Format('duplicate thing ''%s'' in record ''%s''', [fld.mName, mName]));
2723 {$IF DEFINED(D2D_DYNREC_PROFILER)}profListDupChecking := curTimeMicro()-stt;{$ENDIF}
2727 {$IF DEFINED(D2D_DYNREC_PROFILER)}stt
:= curTimeMicro();{$ENDIF}
2728 addRecordByType(rec
.mName
, rec
);
2729 {$IF DEFINED(D2D_DYNREC_PROFILER)}profAddRecByType
:= curTimeMicro()-stt
;{$ENDIF}
2735 {$IF DEFINED(D2D_DYNREC_PROFILER)}stt
:= curTimeMicro();{$ENDIF}
2736 //writeln('0: <', mName, '.', pr.tokStr, '>');
2737 fld
:= field
[pr
.tokStr
];
2738 //writeln('1: <', mName, '.', pr.tokStr, '>');
2739 {$IF DEFINED(D2D_DYNREC_PROFILER)}profFieldSearching
:= curTimeMicro()-stt
;{$ENDIF}
2740 if (fld
<> nil) then
2742 //writeln('2: <', mName, '.', pr.tokStr, '>');
2743 if fld
.defined
then raise Exception
.Create(Format('duplicate field ''%s'' in record ''%s''', [fld
.mName
, mName
]));
2744 if fld
.internal
then raise Exception
.Create(Format('internal field ''%s'' in record ''%s''', [fld
.mName
, mName
]));
2745 pr
.skipToken(); // skip field name
2746 //writeln('3: <', mName, '.', pr.tokStr, '>:', pr.tokType);
2747 {$IF DEFINED(D2D_DYNREC_PROFILER)}stt
:= curTimeMicro();{$ENDIF}
2749 {$IF DEFINED(D2D_DYNREC_PROFILER)}profFieldValParsing
:= curTimeMicro()-stt
;{$ENDIF}
2753 // something is wrong
2754 raise Exception
.Create(Format('unknown field ''%s'' in record ''%s''', [pr
.tokStr
, mName
]));
2756 pr
.expectTT(pr
.TTEnd
);
2761 for fld
in mFields
do
2763 if (fld
.mType
<> TDynField
.TType
.TList
) then continue
;
2764 for rec
in fld
.mRVal
do linkNames(rec
);
2768 // fix field defaults
2769 {$IF DEFINED(D2D_DYNREC_PROFILER)}stt
:= curTimeMicro();{$ENDIF}
2770 for fld
in mFields
do fld
.fixDefaultValue();
2771 {$IF DEFINED(D2D_DYNREC_PROFILER)}profFixDefaults
:= curTimeMicro()-stt
;{$ENDIF}
2772 //writeln('done parsing record <', mName, '>');
2773 //{$IF DEFINED(D2D_DYNREC_PROFILER)}writeln('stall: ', curTimeMicro()-stall);{$ENDIF}
2774 {$IF DEFINED(D2D_DYNREC_PROFILER)}profRecValParse
:= curTimeMicro()-stall
;{$ENDIF}
2778 // ////////////////////////////////////////////////////////////////////////// //
2779 constructor TDynEBS
.Create (pr
: TTextParser
);
2786 destructor TDynEBS
.Destroy ();
2793 procedure TDynEBS
.cleanup ();
2804 function TDynEBS
.findByName (const aname
: AnsiString): Integer;
2807 while (result
< Length(mIds
)) do
2809 if StrEqu(aname
, mIds
[result
]) then exit
;
2816 function TDynEBS
.hasByName (const aname
: AnsiString): Boolean; inline;
2818 result
:= (findByName(aname
) >= 0);
2822 function TDynEBS
.getFieldByName (const aname
: AnsiString): Integer; inline;
2826 f
:= findByName(aname
);
2827 if (f
>= 0) then result
:= mVals
[f
] else result
:= 0;
2831 function TDynEBS
.definition (): AnsiString;
2835 if mIsEnum
then result
:='enum ' else result
:= 'bitset ';
2839 if mIsEnum
then cv
:= 0 else cv
:= 1;
2840 for f
:= 0 to High(mIds
) do
2842 if (mIds
[f
] = mMaxName
) then continue
;
2843 result
+= ' '+mIds
[f
];
2844 if (mVals
[f
] <> cv
) then
2846 result
+= Format(' = %d', [mVals
[f
]]);
2847 if mIsEnum
then cv
:= mVals
[f
];
2852 result
+= Format(', // %d'#10, [mVals
[f
]]);
2854 if mIsEnum
then Inc(cv
) else if (mVals
[f
] = cv
) then cv
:= cv
shl 1;
2857 if (Length(mMaxName
) > 0) then result
+= ' '+mMaxName
+' = MAX,'#10;
2862 function TDynEBS
.pasdef (): AnsiString;
2866 result
:= '// '+mName
+#10'const'#10;
2868 for f
:= 0 to High(mIds
) do
2870 result
+= formatstrf(' %s = %d;'#10, [mIds
[f
], mVals
[f
]]);
2875 function TDynEBS
.nameByValue (v
: Integer): AnsiString;
2879 for f
:= 0 to High(mVals
) do
2881 if (mVals
[f
] = v
) then begin result
:= mIds
[f
]; exit
; end;
2887 procedure TDynEBS
.parseDef (pr
: TTextParser
);
2895 if pr
.eatId('enum') then mIsEnum
:= true
2896 else if pr
.eatId('bitset') then mIsEnum
:= false
2897 else pr
.expectId('enum');
2898 mName
:= pr
.expectId();
2899 mMaxVal
:= Integer($80000000);
2900 if mIsEnum
then cv
:= 0 else cv
:= 1;
2901 pr
.expectTT(pr
.TTBegin
);
2902 while (pr
.tokType
<> pr
.TTEnd
) do
2904 idname
:= pr
.expectId();
2905 for f
:= 0 to High(mIds
) do
2907 if StrEqu(mIds
[f
], idname
) then raise Exception
.Create(Format('duplicate field ''%s'' in enum/bitset ''%s''', [idname
, mName
]));
2909 if StrEqu(mMaxName
, idname
) then raise Exception
.Create(Format('duplicate field ''%s'' in enum/bitset ''%s''', [idname
, mName
]));
2914 if pr
.eatDelim('=') then
2916 if pr
.eatId('MAX') then
2918 if (Length(mMaxName
) > 0) then raise Exception
.Create(Format('duplicate max field ''%s'' in enum/bitset ''%s''', [idname
, mName
]));
2924 v
:= pr
.expectInt();
2925 if mIsEnum
then cv
:= v
;
2933 if mIsEnum
or (not hasV
) then
2935 if (mMaxVal
< v
) then mMaxVal
:= v
;
2937 SetLength(mIds
, Length(mIds
)+1);
2938 mIds
[High(mIds
)] := idname
;
2939 SetLength(mVals
, Length(mIds
));
2940 mVals
[High(mVals
)] := v
;
2942 if mIsEnum
or (not hasV
) then
2944 if mIsEnum
then Inc(cv
) else cv
:= cv
shl 1;
2947 if (pr
.tokType
= pr
.TTEnd
) then break
;
2948 pr
.expectTT(pr
.TTComma
);
2949 while pr
.eatTT(pr
.TTComma
) do begin end;
2951 pr
.expectTT(pr
.TTEnd
);
2953 if (Length(mMaxName
) > 0) then
2955 SetLength(mIds
, Length(mIds
)+1);
2956 mIds
[High(mIds
)] := mMaxName
;
2957 SetLength(mVals
, Length(mIds
));
2958 mVals
[High(mVals
)] := mMaxVal
;
2963 // ////////////////////////////////////////////////////////////////////////// //
2964 constructor TDynMapDef
.Create (pr
: TTextParser
);
2966 recTypes
:= TDynRecList
.Create();
2967 trigTypes
:= TDynRecList
.Create();
2968 ebsTypes
:= TDynEBSList
.Create();
2973 destructor TDynMapDef
.Destroy ();
2978 //!!!FIXME!!! check who owns trigs and recs!
2979 for rec
in recTypes
do rec
.Free();
2980 for rec
in trigTypes
do rec
.Free();
2981 for ebs
in ebsTypes
do ebs
.Free();
2992 function TDynMapDef
.getHeaderRecType (): TDynRecord
; inline;
2994 if (recTypes
.count
= 0) then raise Exception
.Create('no header in empty mapdef');
2995 result
:= recTypes
[0];
2999 function TDynMapDef
.findRecType (const aname
: AnsiString): TDynRecord
;
3003 for rec
in recTypes
do
3005 if StrEqu(rec
.name
, aname
) then begin result
:= rec
; exit
; end;
3011 function TDynMapDef
.findTrigFor (const aname
: AnsiString): TDynRecord
;
3015 for rec
in trigTypes
do
3017 if (rec
.isForTrig
[aname
]) then begin result
:= rec
; exit
; end;
3023 function TDynMapDef
.findEBSType (const aname
: AnsiString): TDynEBS
;
3027 for ebs
in ebsTypes
do
3029 if StrEqu(ebs
.name
, aname
) then begin result
:= ebs
; exit
; end;
3035 procedure TDynMapDef
.parseDef (pr
: TTextParser
);
3037 rec
, hdr
: TDynRecord
;
3041 // setup header links and type links
3042 procedure linkRecord (rec
: TDynRecord
);
3046 rec
.mHeaderRec
:= recTypes
[0];
3047 for fld
in rec
.mFields
do
3049 if (fld
.mType
= fld
.TType
.TTrigData
) then continue
;
3051 TDynField
.TEBS
.TNone
: begin end;
3052 TDynField
.TEBS
.TRec
:
3054 fld
.mEBSType
:= findRecType(fld
.mEBSTypeName
);
3055 if (fld
.mEBSType
= nil) then raise Exception
.Create(Format('field ''%s'' of type ''%s'' has no correcponding record definition', [fld
.mName
, fld
.mEBSTypeName
]));
3057 TDynField
.TEBS
.TEnum
,
3058 TDynField
.TEBS
.TBitSet
:
3060 fld
.mEBSType
:= findEBSType(fld
.mEBSTypeName
);
3061 if (fld
.mEBSType
= nil) then raise Exception
.Create(Format('field ''%s'' of type ''%s'' has no correcponding enum/bitset', [fld
.mName
, fld
.mEBSTypeName
]));
3062 if ((fld
.mEBS
= TDynField
.TEBS
.TEnum
) <> (fld
.mEBSType
as TDynEBS
).mIsEnum
) then raise Exception
.Create(Format('field ''%s'' of type ''%s'' enum/bitset type conflict', [fld
.mName
, fld
.mEBSTypeName
]));
3068 // setup default values
3069 procedure fixRecordDefaults (rec
: TDynRecord
);
3073 for fld
in rec
.mFields
do if fld
.mHasDefault
then fld
.parseDefaultValue();
3080 if not pr
.skipBlanks() then break
;
3081 if (pr
.tokType
<> pr
.TTId
) then raise Exception
.Create('identifier expected');
3083 if (pr
.tokStr
= 'enum') or (pr
.tokStr
= 'bitset') then
3085 eb
:= TDynEBS
.Create(pr
);
3086 if (findEBSType(eb
.name
) <> nil) then
3089 raise Exception
.Create(Format('duplicate enum/bitset ''%s''', [eb
.name
]));
3092 ebsTypes
.append(eb
);
3093 //writeln(eb.definition); writeln;
3097 if (pr
.tokStr
= 'TriggerData') then
3099 rec
:= TDynRecord
.Create(pr
);
3100 for f
:= 0 to High(rec
.mTrigTypes
) do
3102 if (findTrigFor(rec
.mTrigTypes
[f
]) <> nil) then
3105 raise Exception
.Create(Format('duplicate trigdata ''%s''', [rec
.mTrigTypes
[f
]]));
3109 trigTypes
.append(rec
);
3110 //writeln(dr.definition); writeln;
3114 rec
:= TDynRecord
.Create(pr
);
3115 //writeln(dr.definition); writeln;
3116 if (findRecType(rec
.name
) <> nil) then begin rec
.Free(); raise Exception
.Create(Format('duplicate record ''%s''', [rec
.name
])); end;
3117 if (hdr
<> nil) and StrEqu(rec
.name
, hdr
.name
) then begin rec
.Free(); raise Exception
.Create(Format('duplicate record ''%s''', [rec
.name
])); end;
3121 if (hdr
<> nil) then begin rec
.Free(); raise Exception
.Create(Format('duplicate header record ''%s'' (previous is ''%s'')', [rec
.name
, hdr
.name
])); end;
3126 recTypes
.append(rec
);
3130 // put header record to top
3131 if (hdr
= nil) then raise Exception
.Create('header definition not found in mapdef');
3132 recTypes
.append(nil);
3133 for f
:= recTypes
.count
-1 downto 1 do recTypes
[f
] := recTypes
[f
-1];
3136 // setup header links and type links
3137 for rec
in recTypes
do linkRecord(rec
);
3138 for rec
in trigTypes
do linkRecord(rec
);
3140 // setup default values
3141 for rec
in recTypes
do fixRecordDefaults(rec
);
3142 for rec
in trigTypes
do fixRecordDefaults(rec
);
3146 // ////////////////////////////////////////////////////////////////////////// //
3147 function TDynMapDef
.parseMap (pr
: TTextParser
): TDynRecord
;
3149 res
: TDynRecord
= nil;
3154 pr
.expectId(headerType
.name
);
3155 res
:= headerType
.clone(nil);
3156 res
.mHeaderRec
:= res
;
3163 except on e: Exception do
3166 AssignFile(fo, 'z.log');
3168 DumpExceptionBackTrace(fo);
3177 function TDynMapDef
.parseBinMap (st
: TStream
): TDynRecord
;
3179 res
: TDynRecord
= nil;
3183 res
:= headerType
.clone(nil);
3184 res
.mHeaderRec
:= res
;
3185 res
.parseBinValue(st
);
3194 function TDynMapDef
.pasdef (): AnsiString;
3203 result
+= '// ////////////////////////////////////////////////////////////////////////// //'#10;
3204 result
+= '// enums and bitsets'#10;
3205 for ebs
in ebsTypes
do result
+= #10+ebs
.pasdef();
3206 result
+= #10#10'// ////////////////////////////////////////////////////////////////////////// //'#10;
3207 result
+= '// records'#10'type'#10;
3208 for rec
in recTypes
do
3210 if (rec
.mSize
< 1) then continue
;
3211 result
+= rec
.pasdef();
3214 result
+= #10#10'// ////////////////////////////////////////////////////////////////////////// //'#10;
3215 result
+= '// triggerdata'#10'type'#10;
3216 result
+= ' TTriggerData = record'#10;
3217 result
+= ' case Byte of'#10;
3218 result
+= ' 0: (Default: Byte128);'#10;
3219 for rec
in trigTypes
do
3223 for tn
in rec
.mTrigTypes
do
3225 if needComma
then result
+= ', ' else needComma
:= true;
3229 for fld
in rec
.mFields
do
3231 if fld
.mInternal
then continue
;
3232 if (fld
.mBinOfs
< 0) then continue
;
3233 result
+= ' '+fld
.pasdef
+#10;
3237 result
+= ' end;'#10;
3241 function TDynMapDef
.pasdefconst (): AnsiString;
3246 result
+= '// ////////////////////////////////////////////////////////////////////////// //'#10;
3247 result
+= '// enums and bitsets'#10;
3248 for ebs
in ebsTypes
do result
+= #10+ebs
.pasdef();
3252 function TDynMapDef
.getTrigTypeCount (): Integer; inline; begin result
:= trigTypes
.count
; end;
3253 function TDynMapDef
.getTrigTypeAt (idx
: Integer): TDynRecord
; inline; begin if (idx
>= 0) and (idx
< trigTypes
.count
) then result
:= trigTypes
[idx
] else result
:= nil; end;