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
23 SysUtils
, Variants
, Classes
,
24 {$IFDEF USE_MEMPOOL}mempool
,{$ENDIF}
25 xparser
, xstreams
, utils
, hashtable
;
28 // ////////////////////////////////////////////////////////////////////////// //
30 TDynRecException
= class(Exception
)
32 constructor Create (const amsg
: AnsiString
);
33 constructor CreateFmt (const afmt
: AnsiString
; const args
: array of const);
36 TDynParseException
= class(TDynRecException
)
38 tokLine
, tokCol
: Integer;
41 constructor Create (pr
: TTextParser
; const amsg
: AnsiString
);
42 constructor CreateFmt (pr
: TTextParser
; const afmt
: AnsiString
; const args
: array of const);
46 // ////////////////////////////////////////////////////////////////////////// //
53 TDynFieldList
= specialize TSimpleList
<TDynField
>;
54 TDynRecList
= specialize TSimpleList
<TDynRecord
>;
55 TDynEBSList
= specialize TSimpleList
<TDynEBS
>;
57 // this is base type for all scalars (and arrays)
58 TDynField
= class{$IFDEF USE_MEMPOOL}(TPoolObject
){$ENDIF}
61 TType
= (TBool
, TChar
, TByte
, TUByte
, TShort
, TUShort
, TInt
, TUInt
, TString
, TPoint
, TSize
, TColor
, TList
, TTrigData
);
62 // TPoint: pair of Integers
63 // TSize: pair of UShorts
64 // TList: actually, array of records
65 // TTrigData: array of mMaxDim bytes, but internally a record (mRecRef)
66 // in binary: arrays of chars are pascal shortstrings (with counter in the first byte)
70 TEBS
= (TNone
, TRec
, TEnum
, TBitSet
);
73 mOwner
: TDynRecord
; // owner record
74 mName
: AnsiString
; // field name
75 mTip
: AnsiString
; // short tip
76 mHelp
: AnsiString
; // long help
77 mType
: TType
; // field type
78 mIVal
: Integer; // for all integer types
79 mIVal2
: Integer; // for point and size
80 mIVal3
: Integer; // for TColor
81 mIVal4
: Integer; // for TColor
82 mSVal
: AnsiString
; // string; for byte and char arrays
83 mRVal
: TDynRecList
; // for list
84 mRHash
: THashStrInt
; // id -> index in mRVal
85 mRecRef
: TDynRecord
; // for TEBS.TRec
86 mMaxDim
: Integer; // for byte and char arrays; <0: not an array; 0: impossible value
87 mBinOfs
: Integer; // offset in binary; <0 - none
88 mSepPosSize
: Boolean; // for points and sizes, use separate fields
89 mAsT
: Boolean; // for points and sizes, use separate fields, names starts with `t`
95 mBitSetUnique
: Boolean; // bitset can contain only one value
96 mAsMonsterId
: Boolean; // special hack for triggers: monster record number+1 in binary (so 0 means "none")
98 mDefUnparsed
: AnsiString
;
99 mDefSVal
: AnsiString
; // default string value
100 mDefIVal
, mDefIVal2
, mDefIVal3
, mDefIVal4
: Integer; // default integer values
101 mDefRecRef
: TDynRecord
;
102 mEBS
: TEBS
; // complex type type
103 mEBSTypeName
: AnsiString
; // name of enum, bitset or record
104 mEBSType
: TObject
; // either TDynRecord or TDynEBS; nil means "simple type"; nil for `TTrigData` too
107 mRecRefId
: AnsiString
;
117 procedure cleanup ();
119 procedure parseDefaultValue (); // parse `mDefUnparsed` to `mDefSVal`, `mDefIVal`, `mDefIVal2`, `mDefRecRef`
120 procedure fixDefaultValue (); // this will NOT clone `mDefRecRef`
121 function isDefaultValue (): Boolean;
123 function getListCount (): Integer; inline;
124 function getListItem (idx
: Integer): TDynRecord
; inline; overload
;
125 function getListItem (const aname
: AnsiString
): TDynRecord
; inline; overload
;
127 function getRecRefIndex (): Integer;
129 function getVar (): Variant
;
130 procedure setVar (val
: Variant
);
132 procedure setRecRef (arec
: TDynRecord
);
134 procedure parseDef (pr
: TTextParser
); // parse mapdef definition
135 function definition (): AnsiString
; // generate mapdef definition
138 // returns `true` for duplicate record id
139 function addListItem (rec
: TDynRecord
): Boolean; inline;
140 function removeListItem (const aid
: AnsiString
): TDynRecord
; // returns nil or removed record
143 // get string name for the given type
144 class function getTypeName (t
: TType
): AnsiString
;
147 constructor Create (const aname
: AnsiString
; atype
: TType
);
148 constructor Create (const aname
: AnsiString
; val
: Variant
);
149 constructor Create (pr
: TTextParser
);
150 destructor Destroy (); override;
152 // clone this field; register all list records in `registerIn`
153 // "registration" is required to manage record lifetime; use header record if in doubt
154 // owner will be set to `newOwner`, if it is not `nil`, or to `owner`
155 // for lists, cloning will clone all list members
156 function clone (newOwner
: TDynRecord
=nil; registerIn
: TDynRecord
=nil): TDynField
;
158 // compare field values (including trigdata)
159 // WARNING: won't work for lists
160 function isSimpleEqu (fld
: TDynField
): Boolean;
162 // parse string value to appropriate type and set new field value
163 procedure setValue (const s
: AnsiString
);
165 // supports `for rec in field do` (for lists)
166 function GetEnumerator (): TDynRecList
.TEnumerator
; inline;
168 function getRed (): Integer; inline;
169 procedure setRed (v
: Integer); inline;
171 function getGreen (): Integer; inline;
172 procedure setGreen (v
: Integer); inline;
174 function getBlue (): Integer; inline;
175 procedure setBlue (v
: Integer); inline;
177 function getAlpha (): Integer; inline;
178 procedure setAlpha (v
: Integer); inline;
181 // text parser and writer
182 procedure parseValue (pr
: TTextParser
);
183 procedure writeTo (wr
: TTextWriter
);
185 // binary parser and writer (DO NOT USE!)
186 procedure parseBinValue (st
: TStream
);
187 procedure writeBinTo (var hasLostData
: Boolean; st
: TStream
);
190 // the following functions are here only for 'mapgen'! DO NOT USE!
191 // build "alias name" for pascal code
192 function palias (firstUp
: Boolean=false): AnsiString
;
195 property owner
: TDynRecord read mOwner
;
196 property name
: AnsiString read mName
; // field name
197 property baseType
: TType read mType
; // field type (base for arrays)
198 property defined
: Boolean read mDefined
; // was field value set to something by external code?
199 property internal
: Boolean read mInternal write mInternal
; // internal field?
200 property ival
: Integer read mIVal
; // integer value for int field (for speed), first field (x/w) for `TPoint` and `TSize`
201 property ival2
: Integer read mIVal2
; // for `TPoint` and `TSize`, this is second field (y/h)
202 property ival3
: Integer read mIVal3
; // for `TColor`: blue
203 property ival4
: Integer read mIVal4
; // for `TColor`: alpha
204 property red
: Integer read getRed write setRed
; // for `TColor`: red
205 property green
: Integer read getGreen write setGreen
; // for `TColor`: green
206 property blue
: Integer read getBlue write setBlue
; // for `TColor`: blue
207 property alpha
: Integer read getAlpha write setAlpha
; // for `TColor`: alpha
208 property sval
: AnsiString read mSVal
; // string value for string field (for speed)
209 property hasDefault
: Boolean read mHasDefault
; // `true` if this field has default value in mapdef
210 property defsval
: AnsiString read mDefSVal
; // string representation of default value
211 property ebs
: TEBS read mEBS
; // what kind of reference is this? none, enum, bitset, record
212 property ebstype
: TObject read mEBSType
; // reference type (nil, TDynRecord, TDynEBS); WARNING: don't modify type!
213 property ebstypename
: AnsiString read mEBSTypeName
; // enum/bitset name
214 property recref
: TDynRecord read mRecRef write setRecRef
; // referenced record (actual one, you can modify it)
215 property recrefIndex
: Integer read getRecRefIndex
; // index of referenced record in header; -1: not found
217 property count
: Integer read getListCount
;
218 property itemAt
[idx
: Integer]: TDynRecord read getListItem
;
219 property item
[const aname
: AnsiString
]: TDynRecord read getListItem
; default
; // alas, FPC 3+ lost property overloading feature
220 // field value as Variant
221 property value
: Variant read getVar write setVar
;
223 property tip
: AnsiString read mTip
;
224 property help
: AnsiString read mHelp
;
227 // userdata (you can use these properties as you want to; they won't be written or read to files)
228 property tagInt
: Integer read mTagInt write mTagInt
;
229 property tagPtr
: Pointer read mTagPtr write mTagPtr
;
232 // the following properties are here only for 'mapgen'! DO NOT USE!
233 property negbool
: Boolean read mNegBool
;
234 property hasTPrefix
: Boolean read mAsT
;
235 property separatePasFields
: Boolean read mSepPosSize
;
236 property binOfs
: Integer read mBinOfs
;
237 property equToDefault
: Boolean read isDefaultValue
;
241 // record, either with actual values, or with type definitions
242 TDynRecord
= class{$IFDEF USE_MEMPOOL}(TPoolObject
){$ENDIF}
246 mTypeName
: AnsiString
;
247 mTip
: AnsiString
; // short tip
248 mHelp
: AnsiString
; // long help
250 mFields
: TDynFieldList
;
251 {$IF DEFINED(XDYNREC_USE_FIELDHASH)}
252 mFieldsHash
: THashStrInt
; // id -> index in mRVal
254 mTrigTypes
: array of AnsiString
; // if this is triggerdata, we'll hold list of triggers here
255 mHeader
: Boolean; // true for header record
256 mBinBlock
: Integer; // -1: none
257 mHeaderRec
: TDynRecord
; // for "value" records this is header record with data, for "type" records this is header type record
263 mRec2Free
: TDynRecList
;
266 procedure parseDef (pr
: TTextParser
); // parse definition
267 function definition (): AnsiString
;
269 function findByName (const aname
: AnsiString
): Integer; inline;
270 function hasByName (const aname
: AnsiString
): Boolean; inline;
271 function getFieldByName (const aname
: AnsiString
): TDynField
; inline;
272 function getFieldAt (idx
: Integer): TDynField
; inline;
273 function getCount (): Integer; inline;
275 function getIsTrigData (): Boolean; inline;
276 function getIsForTrig (const aname
: AnsiString
): Boolean; inline;
278 function getForTrigCount (): Integer; inline;
279 function getForTrigAt (idx
: Integer): AnsiString
; inline;
281 procedure regrec (rec
: TDynRecord
);
283 function getUserVar (const aname
: AnsiString
): Variant
;
284 procedure setUserVar (const aname
: AnsiString
; val
: Variant
);
286 procedure clearRefRecs (rec
: TDynRecord
);
289 function findRecordByTypeId (const atypename
, aid
: AnsiString
): TDynRecord
;
290 function findRecordNumByType (const atypename
: AnsiString
; rc
: TDynRecord
): Integer;
291 function addRecordByType (const atypename
: AnsiString
; rc
: TDynRecord
): Boolean; // `true`: duplicate record id
293 procedure addField (fld
: TDynField
); inline;
294 function addFieldChecked (fld
: TDynField
): Boolean; inline; // `true`: duplicate name
297 constructor Create ();
298 constructor Create (pr
: TTextParser
); // parse definition
299 destructor Destroy (); override;
301 // clone this record; register all list records in `registerIn`
302 // "registration" is required to manage record lifetime; use header record if in doubt
303 // all fields are cloned too
304 function clone (registerIn
: TDynRecord
): TDynRecord
;
306 // compare records (values of all fields, including trigdata)
307 // WARNING: won't work for records with list fields
308 function isSimpleEqu (rec
: TDynRecord
): Boolean;
310 // find field with `TriggerType` type
311 function trigTypeField (): TDynField
;
313 // number of records of the given instance
314 function instanceCount (const atypename
: AnsiString
): Integer;
316 // only for headers: create new record with the given type
317 // will return cloned record ready for use, or `nil` on unknown type name
318 // `aid` must not be empty, and must be unique
319 function newTypedRecord (const atypename
, aid
: AnsiString
): TDynRecord
;
321 // remove record with the given type and id
322 // return `true` if record was successfully found and removed
323 // this will do all necessary recref cleanup too
324 // WARNING: not tested yet
325 function removeTypedRecord (const atypename
, aid
: AnsiString
): Boolean;
328 // [.] API to create triggers
329 // [.] API to properly remove triggers (remove trigdata)
330 // [.] check if `removeTypedRecord()` does the right thing with inline records
331 // [.] for fields: assigning `recref` should remove previously assigned inline record (record without id)
332 // [.] other API i forgot
336 // `beginEaten`: `true` if "{" was eaten
337 procedure parseValue (pr
: TTextParser
; beginEaten
: Boolean=false);
340 // `putHeader`: `true` to write complete header, otherwise only "{...}"
341 procedure writeTo (wr
: TTextWriter
; putHeader
: Boolean=true);
343 // binary parser and writer (DO NOT USE!)
344 procedure parseBinValue (st
: TStream
; forceData
: Boolean=false);
345 procedure writeBinTo (var hasLostData
: Boolean; st
: TStream
; trigbufsz
: Integer=-1; onlyFields
: Boolean=false);
348 property mapdef
: TDynMapDef read mOwner
;
349 property id
: AnsiString read mId
; // record id in text map
350 property typeName
: AnsiString read mTypeName
; // record type name (like "panel", or "trigger")
351 property has
[const aname
: AnsiString
]: Boolean read hasByName
; // do we have field with the given name?
352 property count
: Integer read getCount
; // number of fields in this record
353 property field
[const aname
: AnsiString
]: TDynField read getFieldByName
; default
; // get field by name
354 property fieldAt
[idx
: Integer]: TDynField read getFieldAt
; // get field at the given index
355 property isTrigData
: Boolean read getIsTrigData
; // is this special "TriggerData" record?
356 property isForTrig
[const aname
: AnsiString
]: Boolean read getIsForTrig
; // can this "TriggerData" be used for the trigger with the given type?
357 property forTrigCount
: Integer read getForTrigCount
; // number of trigger type names for "TriggerData"
358 property forTrigAt
[idx
: Integer]: AnsiString read getForTrigAt
; // trigger type name at the given index for "TriggerData"
359 property headerRec
: TDynRecord read mHeaderRec
; // get header record for this one (header contains all other records, enums, bitsets, etc.)
360 property isHeader
: Boolean read mHeader
; // is this a header record?
362 property tip
: AnsiString read mTip
;
363 property help
: AnsiString read mHelp
;
366 // user fields; user can add arbitrary custom fields
367 // by default, any user field will be marked as "internal"
368 // note: you can use this to manipulate non-user fields too
369 property user
[const aname
: AnsiString
]: Variant read getUserVar write setUserVar
;
372 // userdata (you can use these properties as you want to; they won't be written or read to files)
373 property tagInt
: Integer read mTagInt write mTagInt
;
374 property tagPtr
: Pointer read mTagPtr write mTagPtr
;
378 // bitset/enum definition
379 TDynEBS
= class{$IFDEF USE_MEMPOOL}(TPoolObject
){$ENDIF}
383 mTypeName
: AnsiString
;
384 mTip
: AnsiString
; // short tip
385 mHelp
: AnsiString
; // long help
386 mIds
: array of AnsiString
;
387 mVals
: array of Integer;
388 mMaxName
: AnsiString
; // MAX field
389 mMaxVal
: Integer; // max value
392 procedure cleanup ();
394 procedure parseDef (pr
: TTextParser
); // parse definition
396 function findByName (const aname
: AnsiString
): Integer; inline;
397 function hasByName (const aname
: AnsiString
): Boolean; inline;
398 function getFieldByName (const aname
: AnsiString
): Integer; inline;
400 function definition (): AnsiString
;
401 function pasdef (): AnsiString
;
404 constructor Create (pr
: TTextParser
); // parse definition
405 destructor Destroy (); override;
407 // find name for the given value
408 // return empty string if not found
409 function nameByValue (v
: Integer): AnsiString
;
412 property mapdef
: TDynMapDef read mOwner
;
413 property typeName
: AnsiString read mTypeName
; // enum/bitset type name
414 property isEnum
: Boolean read mIsEnum
; // is this enum? `false` means "bitset"
415 property has
[const aname
: AnsiString
]: Boolean read hasByName
;
416 property field
[const aname
: AnsiString
]: Integer read getFieldByName
; default
;
418 property tip
: AnsiString read mTip
;
419 property help
: AnsiString read mHelp
;
423 // parsed "mapdef.txt"
424 TDynMapDef
= class{$IFDEF USE_MEMPOOL}(TPoolObject
){$ENDIF}
426 recTypes
: TDynRecList
; // [0] is always header
427 trigTypes
: TDynRecList
; // trigdata
428 ebsTypes
: TDynEBSList
; // enums, bitsets
431 procedure parseDef (pr
: TTextParser
);
433 function getHeaderRecType (): TDynRecord
; inline;
435 function getRecTypeCount (): Integer; inline;
436 function getRecTypeAt (idx
: Integer): TDynRecord
; inline;
438 function getEBSTypeCount (): Integer; inline;
439 function getEBSTypeAt (idx
: Integer): TDynEBS
; inline;
441 function getTrigTypeCount (): Integer; inline;
442 function getTrigTypeAt (idx
: Integer): TDynRecord
; inline;
444 // creates new header record
445 function parseTextMap (pr
: TTextParser
): TDynRecord
;
447 // creates new header record
448 function parseBinMap (st
: TStream
): TDynRecord
;
451 constructor Create (pr
: TTextParser
); // parses data definition
452 destructor Destroy (); override;
454 function findRecType (const aname
: AnsiString
): TDynRecord
;
455 function findTrigFor (const aname
: AnsiString
): TDynRecord
;
456 function findEBSType (const aname
: AnsiString
): TDynEBS
;
459 // parse text or binary map, return new header record
460 // WARNING! stream must be seekable
461 function parseMap (st
: TStream
; wasBinary
: PBoolean
=nil): TDynRecord
;
463 // returns `true` if the given stream can be a map file
464 // stream position is 0 on return
465 // WARNING! stream must be seekable
466 class function canBeMap (st
: TStream
): Boolean;
469 // the following functions are here only for 'mapgen'! DO NOT USE!
470 function pasdefconst (): AnsiString
;
473 property headerType
: TDynRecord read getHeaderRecType
;
475 property recTypeCount
: Integer read getRecTypeCount
;
476 property recTypeAt
[idx
: Integer]: TDynRecord read getRecTypeAt
;
477 property recType
[const aname
: AnsiString
]: TDynRecord read findRecType
;
478 // for enum/bitset types
479 property ebsTypeCount
: Integer read getEBSTypeCount
;
480 property ebsTypeAt
[idx
: Integer]: TDynEBS read getEBSTypeAt
;
481 property ebsType
[const aname
: AnsiString
]: TDynEBS read findEBSType
;
483 property trigTypeCount
: Integer read getTrigTypeCount
;
484 property trigTypeAt
[idx
: Integer]: TDynRecord read getTrigTypeAt
;
485 property trigTypeFor
[const aname
: AnsiString
]: TDynRecord read findTrigFor
;
489 {$IF DEFINED(D2D_DYNREC_PROFILER)}
490 procedure xdynDumpProfiles ();
494 DynWarningCB
: procedure (const msg
: AnsiString
; line
, col
: Integer) = nil;
498 {$IF DEFINED(D2D_DYNREC_PROFILER)}
504 // ////////////////////////////////////////////////////////////////////////// //
505 function StrEqu (const a
, b
: AnsiString
): Boolean; inline; begin result
:= (a
= b
); end;
508 // ////////////////////////////////////////////////////////////////////////// //
509 constructor TDynRecException
.Create (const amsg
: AnsiString
);
511 inherited Create(amsg
);
514 constructor TDynRecException
.CreateFmt (const afmt
: AnsiString
; const args
: array of const);
516 inherited Create(formatstrf(afmt
, args
));
520 // ////////////////////////////////////////////////////////////////////////// //
521 constructor TDynParseException
.Create (pr
: TTextParser
; const amsg
: AnsiString
);
523 if (pr
<> nil) then begin tokLine
:= pr
.tokLine
; tokCol
:= pr
.tokCol
; end else begin tokLine
:= 0; tokCol
:= 0; end;
524 inherited Create(amsg
);
527 constructor TDynParseException
.CreateFmt (pr
: TTextParser
; const afmt
: AnsiString
; const args
: array of const);
529 if (pr
<> nil) then begin tokLine
:= pr
.tokLine
; tokCol
:= pr
.tokCol
; end else begin tokLine
:= 0; tokCol
:= 0; end;
530 inherited Create(formatstrf(afmt
, args
));
534 // ////////////////////////////////////////////////////////////////////////// //
535 function TDynField
.GetEnumerator (): TDynRecList
.TEnumerator
; inline;
537 //result := TListEnumerator.Create(mRVal);
538 if (mRVal
<> nil) then result
:= mRVal
.GetEnumerator
else result
:= TDynRecList
.TEnumerator
.Create(nil, 0);
542 // ////////////////////////////////////////////////////////////////////////// //
543 constructor TDynField
.Create (const aname
: AnsiString
; atype
: TType
);
551 if (mType
= TType
.TList
) then
553 mRVal
:= TDynRecList
.Create();
554 mRHash
:= THashStrInt
.Create();
559 constructor TDynField
.Create (pr
: TTextParser
);
566 constructor TDynField
.Create (const aname
: AnsiString
; val
: Variant
);
567 procedure setInt32 (v
: LongInt);
571 if (v
= 0) then mIVal
:= 0
572 else if (v
= 1) then mIVal
:= 1
573 else raise TDynRecException
.Create('cannot convert shortint variant to field value');
575 if (v
>= -128) and (v
<= 127) then mIVal
:= v
576 else raise TDynRecException
.Create('cannot convert shortint variant to field value');
578 if (v
>= 0) and (v
<= 255) then mIVal
:= v
579 else raise TDynRecException
.Create('cannot convert shortint variant to field value');
581 if (v
>= -32768) and (v
<= 32767) then mIVal
:= v
582 else raise TDynRecException
.Create('cannot convert shortint variant to field value');
584 if (v
>= 0) and (v
<= 65535) then mIVal
:= v
585 else raise TDynRecException
.Create('cannot convert shortint variant to field value');
591 mSVal
:= formatstrf('%s', [v
]);
593 raise TDynRecException
.Create('cannot convert integral variant to field value');
603 varEmpty
: raise TDynRecException
.Create('cannot convert empty variant to field value');
604 varNull
: raise TDynRecException
.Create('cannot convert null variant to field value');
605 varSingle
: raise TDynRecException
.Create('cannot convert single variant to field value');
606 varDouble
: raise TDynRecException
.Create('cannot convert double variant to field value');
607 varDecimal
: raise TDynRecException
.Create('cannot convert decimal variant to field value');
608 varCurrency
: raise TDynRecException
.Create('cannot convert currency variant to field value');
609 varDate
: raise TDynRecException
.Create('cannot convert date variant to field value');
610 varOleStr
: raise TDynRecException
.Create('cannot convert olestr variant to field value');
611 varStrArg
: raise TDynRecException
.Create('cannot convert stdarg variant to field value');
612 varString
: mType
:= TType
.TString
;
613 varDispatch
: raise TDynRecException
.Create('cannot convert dispatch variant to field value');
614 varBoolean
: mType
:= TType
.TBool
;
615 varVariant
: raise TDynRecException
.Create('cannot convert variant variant to field value');
616 varUnknown
: raise TDynRecException
.Create('cannot convert unknown variant to field value');
617 varByte
: mType
:= TType
.TUByte
;
618 varWord
: mType
:= TType
.TUShort
;
619 varShortInt
: mType
:= TType
.TByte
;
620 varSmallint
: mType
:= TType
.TShort
;
621 varInteger
: mType
:= TType
.TInt
;
622 varInt64
: raise TDynRecException
.Create('cannot convert int64 variant to field value');
623 varLongWord
: raise TDynRecException
.Create('cannot convert longword variant to field value');
624 varQWord
: raise TDynRecException
.Create('cannot convert uint64 variant to field value');
625 varError
: raise TDynRecException
.Create('cannot convert error variant to field value');
626 else raise TDynRecException
.Create('cannot convert undetermined variant to field value');
632 destructor TDynField
.Destroy ();
639 procedure TDynField
.cleanup ();
648 mIVal4
:= 0; // default alpha value
657 mSepPosSize
:= false;
659 mHasDefault
:= false;
668 mDefIVal4
:= 0; // default value for alpha
673 mBitSetUnique
:= false;
674 mAsMonsterId
:= false;
683 function TDynField
.clone (newOwner
: TDynRecord
=nil; registerIn
: TDynRecord
=nil): TDynField
;
687 result
:= TDynField
.Create(mName
, mType
);
688 result
.mOwner
:= mOwner
;
689 if (newOwner
<> nil) then result
.mOwner
:= newOwner
else result
.mOwner
:= mOwner
;
690 result
.mName
:= mName
;
692 result
.mHelp
:= mHelp
;
693 result
.mType
:= mType
;
694 result
.mIVal
:= mIVal
;
695 result
.mIVal2
:= mIVal2
;
696 result
.mIVal3
:= mIVal3
;
697 result
.mIVal4
:= mIVal4
;
698 result
.mSVal
:= mSVal
;
699 if (mRVal
<> nil) then
701 if (result
.mRVal
= nil) then result
.mRVal
:= TDynRecList
.Create(mRVal
.count
);
702 if (result
.mRHash
= nil) then result
.mRHash
:= THashStrInt
.Create();
703 for rec
in mRVal
do result
.addListItem(rec
.clone(registerIn
));
705 result
.mRecRef
:= mRecRef
;
706 result
.mMaxDim
:= mMaxDim
;
707 result
.mBinOfs
:= mBinOfs
;
708 result
.mSepPosSize
:= mSepPosSize
;
710 result
.mDefined
:= mDefined
;
711 result
.mHasDefault
:= mHasDefault
;
712 result
.mWriteDef
:= mWriteDef
;
713 result
.mInternal
:= mInternal
;
714 result
.mNegBool
:= mNegBool
;
715 result
.mBitSetUnique
:= mBitSetUnique
;
716 result
.mAsMonsterId
:= mAsMonsterId
;
717 result
.mDefUnparsed
:= mDefUnparsed
;
718 result
.mDefSVal
:= mDefSVal
;
719 result
.mDefIVal
:= mDefIVal
;
720 result
.mDefIVal2
:= mDefIVal2
;
721 result
.mDefIVal3
:= mDefIVal3
;
722 result
.mDefIVal4
:= mDefIVal4
;
723 result
.mDefRecRef
:= mDefRecRef
;
725 result
.mEBSTypeName
:= mEBSTypeName
;
726 result
.mEBSType
:= mEBSType
;
727 result
.mRecRefId
:= mRecRefId
;
728 result
.mTagInt
:= mTagInt
;
729 result
.mTagPtr
:= mTagPtr
;
730 result
.mAlias
:= mAlias
;
734 function TDynField
.palias (firstUp
: Boolean=false): AnsiString
;
739 if (Length(mAlias
) > 0) then
741 if firstUp
then result
:= UpCase1251(mAlias
[1])+Copy(mAlias
, 2, Length(mAlias
)-1) else result
:= mAlias
;
749 if (ch
= '_') then begin nextUp
:= true; continue
; end;
750 if nextUp
then result
+= UpCase1251(ch
) else result
+= ch
;
757 procedure TDynField
.setRecRef (arec
: TDynRecord
);
759 trc
: TDynRecord
= nil;
762 TEBS
.TNone
: raise TDynRecException
.CreateFmt('cannot set refrec for non-reference field ''%s''', [mName
]);
765 if (arec
<> nil) then
767 if (mEBSType
<> nil) and (mEBSType
is TDynRecord
) then trc
:= (mEBSType
as TDynRecord
);
768 if (trc
= nil) then raise TDynRecException
.CreateFmt('cannot set refrec for field ''%s'' (type conflict: improperly initialized field)', [mName
]);
769 if (trc
.typeName
<> arec
.typeName
) then raise TDynRecException
.CreateFmt('cannot set refrec for field ''%s'' (type conflict: expected ''%s'' got ''%s'')', [mName
, trc
.typeName
, arec
.typeName
]);
775 TEBS
.TEnum
: raise TDynRecException
.CreateFmt('cannot set refrec for enum field ''%s''', [mName
]);
776 TEBS
.TBitSet
: raise TDynRecException
.CreateFmt('cannot set refrec for bitset field ''%s''', [mName
]);
777 else raise TDynRecException
.Create('ketmar forgot to process some reftypes');
782 function TDynField
.getVar (): Variant
;
784 if (mEBS
= TEBS
.TRec
) then begin result
:= LongInt(getRecRefIndex
); exit
; end;
786 TType
.TBool
: result
:= (mIVal
<> 0);
787 TType
.TChar
: result
:= mSVal
;
788 TType
.TByte
: result
:= ShortInt(mIVal
);
789 TType
.TUByte
: result
:= Byte(mIVal
);
790 TType
.TShort
: result
:= SmallInt(mIVal
);
791 TType
.TUShort
: result
:= Word(mIVal
);
792 TType
.TInt
: result
:= LongInt(mIVal
);
793 TType
.TUInt
: result
:= LongWord(mIVal
);
794 TType
.TString
: result
:= mSVal
;
795 TType
.TPoint
: raise TDynRecException
.Create('cannot convert point field to variant');
796 TType
.TSize
: raise TDynRecException
.Create('cannot convert size field to variant');
797 TType
.TColor
: raise TDynRecException
.Create('cannot convert color field to variant');
798 TType
.TList
: raise TDynRecException
.Create('cannot convert list field to variant');
799 TType
.TTrigData
: raise TDynRecException
.Create('cannot convert trigdata field to variant');
800 else result
:= Unassigned
; raise TDynRecException
.Create('ketmar forgot to handle some field type');
805 procedure TDynField
.setVar (val
: Variant
);
806 procedure setInt32 (v
: LongInt);
810 if (v
= 0) then mIVal
:= 0
811 else if (v
= 1) then mIVal
:= 1
812 else raise TDynRecException
.Create('cannot convert shortint variant to field value');
814 if (v
>= -128) and (v
<= 127) then mIVal
:= v
815 else raise TDynRecException
.Create('cannot convert shortint variant to field value');
817 if (v
>= 0) and (v
<= 255) then mIVal
:= v
818 else raise TDynRecException
.Create('cannot convert shortint variant to field value');
820 if (v
>= -32768) and (v
<= 32767) then mIVal
:= v
821 else raise TDynRecException
.Create('cannot convert shortint variant to field value');
823 if (v
>= 0) and (v
<= 65535) then mIVal
:= v
824 else raise TDynRecException
.Create('cannot convert shortint variant to field value');
830 mSVal
:= formatstrf('%s', [v
]);
832 raise TDynRecException
.Create('cannot convert integral variant to field value');
837 varEmpty
: raise TDynRecException
.Create('cannot convert empty variant to field value');
838 varNull
: raise TDynRecException
.Create('cannot convert null variant to field value');
839 varSingle
: raise TDynRecException
.Create('cannot convert single variant to field value');
840 varDouble
: raise TDynRecException
.Create('cannot convert double variant to field value');
841 varDecimal
: raise TDynRecException
.Create('cannot convert decimal variant to field value');
842 varCurrency
: raise TDynRecException
.Create('cannot convert currency variant to field value');
843 varDate
: raise TDynRecException
.Create('cannot convert date variant to field value');
844 varOleStr
: raise TDynRecException
.Create('cannot convert olestr variant to field value');
845 varStrArg
: raise TDynRecException
.Create('cannot convert stdarg variant to field value');
847 if (mType
= TType
.TChar
) or (mType
= TType
.TString
) then
853 raise TDynRecException
.Create('cannot convert string variant to field value');
855 varDispatch
: raise TDynRecException
.Create('cannot convert dispatch variant to field value');
865 if val
then mIVal
:= 1 else mIVal
:= 0;
867 if val
then mSVal
:= 'true' else mSVal
:= 'false';
869 raise TDynRecException
.Create('cannot convert boolean variant to field value');
871 varVariant
: raise TDynRecException
.Create('cannot convert variant variant to field value');
872 varUnknown
: raise TDynRecException
.Create('cannot convert unknown variant to field value');
880 if (val
< Int64(LongInt($80000000))) or (val
> LongInt($7FFFFFFF)) then
881 raise TDynRecException
.Create('cannot convert boolean variant to field value')
883 mIVal
:= LongInt(val
);
885 if (val
> LongWord($7FFFFFFF)) then raise TDynRecException
.Create('cannot convert longword variant to field value')
886 else setInt32(Integer(val
));
887 varQWord
: raise TDynRecException
.Create('cannot convert uint64 variant to field value');
888 varError
: raise TDynRecException
.Create('cannot convert error variant to field value');
889 else raise TDynRecException
.Create('cannot convert undetermined variant to field value');
895 // won't work for lists
896 function TDynField
.isSimpleEqu (fld
: TDynField
): Boolean;
898 if (fld
= nil) or (mType
<> fld
.mType
) then begin result
:= false; exit
; end;
900 TType
.TBool
: result
:= ((mIVal
<> 0) = (fld
.mIVal
<> 0));
901 TType
.TChar
: result
:= (mSVal
= fld
.mSVal
);
908 result
:= (mIVal
= fld
.mIVal
);
909 TType
.TString
: result
:= (mSVal
= fld
.mSVal
);
912 result
:= ((mIVal
= fld
.mIVal
) and (mIVal2
= fld
.mIVal2
));
914 result
:= ((mIVal
= fld
.mIVal
) and (mIVal2
= fld
.mIVal2
) and (mIVal3
= fld
.mIVal3
) and (mIVal4
= fld
.mIVal4
));
915 TType
.TList
: result
:= false;
918 if (mRecRef
= nil) then begin result
:= (fld
.mRecRef
= nil); exit
; end;
919 result
:= mRecRef
.isSimpleEqu(fld
.mRecRef
);
921 else raise TDynRecException
.Create('ketmar forgot to handle some field type');
926 procedure TDynField
.setValue (const s
: AnsiString
);
930 stp
:= TStrTextParser
.Create(s
+';');
939 function TDynField
.getRed (): Integer; inline; begin result
:= mIVal
; if (result
< 0) then result
:= 0 else if (result
> 255) then result
:= 255; end;
940 procedure TDynField
.setRed (v
: Integer); inline; begin if (v
< 0) then v
:= 0 else if (v
> 255) then v
:= 255; mIVal
:= v
; end;
942 function TDynField
.getGreen (): Integer; inline; begin result
:= mIVal2
; if (result
< 0) then result
:= 0 else if (result
> 255) then result
:= 255; end;
943 procedure TDynField
.setGreen (v
: Integer); inline; begin if (v
< 0) then v
:= 0 else if (v
> 255) then v
:= 255; mIVal2
:= v
; end;
945 function TDynField
.getBlue (): Integer; inline; begin result
:= mIVal3
; if (result
< 0) then result
:= 0 else if (result
> 255) then result
:= 255; end;
946 procedure TDynField
.setBlue (v
: Integer); inline; begin if (v
< 0) then v
:= 0 else if (v
> 255) then v
:= 255; mIVal3
:= v
; end;
948 function TDynField
.getAlpha (): Integer; inline; begin result
:= mIVal4
; if (result
< 0) then result
:= 0 else if (result
> 255) then result
:= 255; end;
949 procedure TDynField
.setAlpha (v
: Integer); inline; begin if (v
< 0) then v
:= 0 else if (v
> 255) then v
:= 255; mIVal4
:= v
; end;
952 procedure TDynField
.parseDefaultValue ();
954 stp
: TTextParser
= nil;
956 oIVal
, oIVal2
, oIVal3
, oIVal4
: Integer;
960 if not mHasDefault
then
966 mDefIVal4
:= 0; // default value for alpha
979 stp
:= TStrTextParser
.Create(mDefUnparsed
+';');
981 //if (mType = TType.TColor) then writeln('4=[', mIVal4, ']');
987 mDefRecRef
:= mRecRef
;
1002 // default value should be parsed
1003 procedure TDynField
.fixDefaultValue ();
1005 if mDefined
then exit
;
1006 if not mHasDefault
then
1008 if mInternal
then exit
;
1009 raise TDynRecException
.CreateFmt('field ''%s'' in record ''%s'' of record type ''%s'' is not set', [mName
, mOwner
.mId
, mOwner
.mTypeName
]);
1011 if (mEBS
= TEBS
.TRec
) then mRecRef
:= mDefRecRef
;
1014 mIVal2
:= mDefIVal2
;
1015 mIVal3
:= mDefIVal3
;
1016 mIVal4
:= mDefIVal4
;
1017 //if (mType = TType.TColor) then writeln('4=[', mDefIVal4, ']');
1022 // default value should be parsed
1023 function TDynField
.isDefaultValue (): Boolean;
1025 if not mHasDefault
then begin result
:= false; exit
; end;
1026 if (mEBS
= TEBS
.TRec
) then begin result
:= (mRecRef
= mDefRecRef
); exit
; end;
1028 TType
.TChar
, TType
.TString
: result
:= (mSVal
= mDefSVal
);
1029 TType
.TPoint
, TType
.TSize
: result
:= (mIVal
= mDefIVal2
) and (mIVal2
= mDefIVal2
);
1030 TType
.TColor
: result
:= (mIVal
= mDefIVal2
) and (mIVal2
= mDefIVal2
) and (mIVal3
= mDefIVal3
) and (mIVal4
= mDefIVal4
);
1031 TType
.TList
, TType
.TTrigData
: result
:= false; // no default values for those types
1032 else result
:= (mIVal
= mDefIVal
);
1037 function TDynField
.getListCount (): Integer; inline;
1039 if (mRVal
<> nil) then result
:= mRVal
.count
else result
:= 0;
1043 function TDynField
.getListItem (idx
: Integer): TDynRecord
; inline; overload
;
1045 if (mRVal
<> nil) and (idx
>= 0) and (idx
< mRVal
.count
) then result
:= mRVal
[idx
] else result
:= nil;
1049 function TDynField
.getListItem (const aname
: AnsiString
): TDynRecord
; inline; overload
;
1053 if (mRVal
<> nil) and mRHash
.get(aname
, idx
) then result
:= mRVal
[idx
] else result
:= nil;
1057 function TDynField
.addListItem (rec
: TDynRecord
): Boolean; inline;
1060 if (mRVal
<> nil) then
1063 if (Length(rec
.mId
) > 0) then result
:= mRHash
.put(rec
.mId
, mRVal
.count
-1);
1068 function TDynField
.removeListItem (const aid
: AnsiString
): TDynRecord
;
1073 if mRHash
.get(aid
, idx
) then
1075 assert((idx
>= 0) and (idx
< mRVal
.count
));
1076 result
:= mRVal
[idx
];
1077 // fix hash and list
1078 for f
:= idx
+1 to mRVal
.count
-1 do
1080 if (Length(mRVal
[f
].mId
) > 0) then mRHash
.put(mRVal
[f
].mId
, f
-1);
1088 class function TDynField
.getTypeName (t
: TType
): AnsiString
;
1091 TType
.TBool
: result
:= 'bool';
1092 TType
.TChar
: result
:= 'char';
1093 TType
.TByte
: result
:= 'byte';
1094 TType
.TUByte
: result
:= 'ubyte';
1095 TType
.TShort
: result
:= 'short';
1096 TType
.TUShort
: result
:= 'ushort';
1097 TType
.TInt
: result
:= 'int';
1098 TType
.TUInt
: result
:= 'uint';
1099 TType
.TString
: result
:= 'string';
1100 TType
.TPoint
: result
:= 'point';
1101 TType
.TSize
: result
:= 'size';
1102 TType
.TColor
: result
:= 'color';
1103 TType
.TList
: result
:= 'array';
1104 TType
.TTrigData
: result
:= 'trigdata';
1105 else raise TDynRecException
.Create('ketmar forgot to handle some field type');
1110 function TDynField
.definition (): AnsiString
;
1112 result
:= quoteStr(mName
)+' type ';
1113 result
+= getTypeName(mType
);
1114 if (Length(mAlias
) > 0) then result
+= ' alias '+mAlias
;
1115 if (mMaxDim
>= 0) then result
+= Format('[%d]', [mMaxDim
]);
1116 if (mBinOfs
>= 0) then result
+= Format(' offset %d', [mBinOfs
]);
1118 TEBS
.TNone
: begin end;
1119 TEBS
.TRec
: result
+= ' '+mEBSTypeName
;
1120 TEBS
.TEnum
: result
+= ' enum '+mEBSTypeName
;
1121 TEBS
.TBitSet
: begin result
+= ' bitset '; if mBitSetUnique
then result
+= 'unique '; result
+= mEBSTypeName
; end;
1123 if mAsMonsterId
then result
+= ' as monsterid';
1124 if mHasDefault
and (Length(mDefUnparsed
) > 0) then result
+= ' default '+mDefUnparsed
;
1127 if (mType
= TType
.TPoint
) then begin if (mAsT
) then result
+= ' as txy' else result
+= ' as xy'; end
1128 else if (mType
= TType
.TSize
) then begin if (mAsT
) then result
+= ' as twh' else result
+= ' as wh'; end;
1130 if mWriteDef
then result
+= ' writedefault';
1131 if mInternal
then result
+= ' internal';
1135 procedure TDynField
.parseDef (pr
: TTextParser
);
1137 fldname
: AnsiString
;
1138 fldtype
: AnsiString
;
1140 fldrecname
: AnsiString
;
1141 asxy
, aswh
, ast
: Boolean;
1145 defint
, defint2
, defint3
, defint4
: Integer;
1150 lebs
: TDynField
.TEBS
;
1155 atip
, ahelp: AnsiString
;
1177 lebs
:= TDynField.TEBS.TNone
;
1183 fldname
:= pr.expectStrOrId
();
1185 while
(not pr.isDelim
(';')) do
1187 if pr.eatId
('type') then
1189 if
(Length(fldtype
) > 0) then raise TDynParseException.CreateFmt
(pr
, 'duplicate type definition for field ''%s''', [fldname
]);
1191 fldtype
:= pr.expectId
();
1192 // fixed
-size array
?
1193 if pr.eatDelim
('[') then
1195 lmaxdim
:= pr.expectInt
();
1197 if
(lmaxdim
< 1) or (lmaxdim
> 32768) then raise TDynParseException.CreateFmt
(pr
, 'invalid field ''%s'' array size', [fldname
]);
1198 pr.expectDelim
(']');
1203 if pr
.eatId('alias') then
1205 if (Length(xalias
) > 0) then raise TDynParseException
.CreateFmt(pr
, 'duplicate alias definition for field ''%s''', [fldname
]);
1206 xalias
:= pr
.expectId();
1210 if pr
.eatId('tip') then
1212 if (Length(atip
) > 0) then raise TDynParseException
.CreateFmt(pr
, 'duplicate tip definition for field ''%s''', [fldname
]);
1213 atip
:= pr
.expectStr(false);
1217 if pr
.eatId('help') then
1219 if (Length(ahelp
) > 0) then raise TDynParseException
.CreateFmt(pr
, 'duplicate tip definition for field ''%s''', [fldname
]);
1220 ahelp
:= pr
.expectStr(false);
1224 if pr
.eatId('offset') then
1226 if (fldofs
>= 0) then raise TDynParseException
.CreateFmt(pr
, 'duplicate field ''%s'' offset', [fldname
]);
1227 fldofs
:= pr
.expectInt();
1228 if (fldofs
< 0) then raise TDynParseException
.CreateFmt(pr
, 'invalid field ''%s'' offset', [fldname
]);
1232 if pr
.eatId('as') then
1234 if pr
.eatId('xy') then asxy
:= true
1235 else if pr
.eatId('wh') then aswh
:= true
1236 else if pr
.eatId('txy') then begin asxy
:= true; ast
:= true; end
1237 else if pr
.eatId('twh') then begin aswh
:= true; ast
:= true; end
1238 else if pr
.eatId('monsterid') then begin asmonid
:= true
; end
1239 else raise TDynParseException.CreateFmt
(pr
, 'invalid field ''%s'' as what?', [fldname
]);
1243 if pr
.eatId('enum') then
1245 lebs
:= TDynField
.TEBS
.TEnum
;
1246 if (Length(fldrecname
) <> 0) then raise TDynParseException
.CreateFmt(pr
, 'field ''%s'' already typed as ''%s''', [fldname
, fldrecname
]);
1247 fldrecname
:= pr
.expectId();
1251 if pr
.eatId('bitset') then
1253 lebs
:= TDynField
.TEBS
.TBitSet
;
1254 if (Length(fldrecname
) <> 0) then raise TDynParseException
.CreateFmt(pr
, 'field ''%s'' already typed as ''%s''', [fldname
, fldrecname
]);
1255 unique
:= pr
.eatId('unique');
1256 fldrecname
:= pr
.expectId();
1260 if pr
.eatId('default') then
1262 if hasdefStr
or hasdefInt
or hasdefId
then raise TDynParseException
.CreateFmt(pr
, 'field ''%s'' has duplicate default', [fldname
]);
1267 defstr
:= pr
.expectStr(true); // allow empty strings
1272 defstr
:= pr
.expectId();
1277 defint
:= pr
.expectInt();
1282 if pr
.eatDelim('[') then defech
:= ']' else begin pr
.expectDelim('('); defech
:= ')'; end;
1283 defint
:= pr
.expectInt();
1284 defint2
:= pr
.expectInt();
1285 if (pr
.tokType
= pr
.TTInt
) then
1287 defint3
:= pr
.expectInt();
1288 if (pr
.tokType
= pr
.TTInt
) then defint4
:= pr
.expectInt();
1290 pr
.expectDelim(defech
);
1293 raise TDynParseException
.CreateFmt(pr
, 'field ''%s'' has invalid default', [fldname
]);
1298 if pr
.eatId('writedefault') then
1304 if pr
.eatId('internal') then
1310 // record type, no special modifiers
1311 if (pr
.tokType
<> pr
.TTId
) then raise TDynParseException
.CreateFmt(pr
, 'field ''%s'' has something unexpected in definition', [fldname
]);
1313 if (Length(fldrecname
) <> 0) then raise TDynParseException
.CreateFmt(pr
, 'field ''%s'' already typed as ''%s''', [fldname
, fldrecname
]);
1314 fldrecname
:= pr
.expectId();
1315 lebs
:= TDynField
.TEBS
.TRec
;
1318 pr
.expectDelim(';');
1322 if (fldtype
= 'bool') then mType
:= TType
.TBool
1323 else if (fldtype
= 'negbool') then begin mType
:= TType
.TBool
; mNegBool
:= true; end
1324 else if (fldtype
= 'char') then mType
:= TType
.TChar
1325 else if (fldtype
= 'byte') then mType
:= TType
.TByte
1326 else if (fldtype
= 'ubyte') then mType
:= TType
.TUByte
1327 else if (fldtype
= 'short') then mType
:= TType
.TShort
1328 else if (fldtype
= 'ushort') then mType
:= TType
.TUShort
1329 else if (fldtype
= 'int') then mType
:= TType
.TInt
1330 else if (fldtype
= 'uint') then mType
:= TType
.TUInt
1331 else if (fldtype
= 'string') then mType
:= TType
.TString
1332 else if (fldtype
= 'point') then mType
:= TType
.TPoint
1333 else if (fldtype
= 'size') then mType
:= TType
.TSize
1334 else if (fldtype
= 'color') then mType
:= TType
.TColor
1335 else if (fldtype
= 'trigdata') then mType
:= TType
.TTrigData
1338 // record types defaults to int
1339 if (Length(fldrecname
) > 0) then
1341 mType
:= TType
.TInt
;
1345 if (Length(fldtype
) = 0) then raise TDynParseException
.CreateFmt(pr
, 'field ''%s'' has no type', [fldname
])
1346 else raise TDynParseException
.CreateFmt(pr
, 'field ''%s'' has invalid type ''%s''', [fldname
, fldtype
]);
1350 // check for valid arrays
1351 if (lmaxdim
> 0) and (mType
<> TType
.TChar
) and (mType
<> TType
.TTrigData
) then raise TDynParseException
.CreateFmt(pr
, 'field ''%s'' of type ''%s'' cannot be array', [fldname
, fldtype
]);
1353 // check for valid trigdata or record type
1354 if (mType
= TType
.TTrigData
) then
1357 if (lmaxdim
< 1) then raise TDynParseException
.CreateFmt(pr
, 'field ''%s'' of type ''%s'' cannot be non-array', [fldname
, 'trigdata']);
1358 if (Length(fldrecname
) > 0) then raise TDynParseException
.CreateFmt(pr
, 'field ''%s'' of type ''%s'' cannot have another type', [fldname
, 'trigdata']);
1359 lebs
:= TDynField
.TEBS
.TRec
;
1361 else if (Length(fldrecname
) > 0) then
1364 if not (mType
in [TType
.TByte
, TType
.TUByte
, TType
.TShort
, TType
.TUShort
, TType
.TInt
, TType
.TUInt
]) then
1366 raise TDynParseException
.CreateFmt(pr
, 'field ''%s'' of record type ''%s'' cannot have type ''%s''', [fldname
, fldrecname
, fldtype
]);
1370 // setup default value
1371 if hasdefStr
then self
.mDefUnparsed
:= quoteStr(defstr
)
1372 else if hasdefId
then self
.mDefUnparsed
:= defstr
1373 else if hasdefInt
then
1375 if (mType
= TType
.TPoint
) then self
.mDefUnparsed
:= Format('(%d %d)', [defint
, defint2
])
1376 else if (mType
= TType
.TSize
) then self
.mDefUnparsed
:= Format('[%d %d]', [defint
, defint2
])
1377 else if (mType
= TType
.TColor
) then self
.mDefUnparsed
:= Format('(%d %d %d %d)', [defint
, defint2
, defint3
, defint4
])
1378 else self
.mDefUnparsed
:= Format('%d', [defint
]);
1381 self
.mHasDefault
:= (hasdefStr
or hasdefId
or hasdefInt
);
1383 self
.mEBSTypeName
:= fldrecname
;
1384 self
.mBitSetUnique
:= unique
;
1385 self
.mAsMonsterId
:= asmonid
;
1386 self.mMaxDim
:= lmaxdim
;
1387 self.mBinOfs
:= fldofs
;
1388 self.mSepPosSize
:= (asxy
or aswh
);
1390 self.mWriteDef
:= writedef
;
1391 self.mInternal
:= ainternal
;
1392 self.mAlias
:= xalias
;
1394 self.mHelp
:= ahelp
;
1398 function TDynField
.getRecRefIndex (): Integer;
1400 if (mRecRef
= nil) then begin result
:= -1; exit
; end;
1401 result
:= mOwner
.findRecordNumByType(mEBSTypeName
, mRecRef
);
1405 procedure TDynField
.writeBinTo (var hasLostData
: Boolean; st
: TStream
);
1414 TEBS
.TNone
: begin end;
1417 if (mMaxDim
>= 0) then
1419 // this must be triggerdata
1420 if (mType
<> TType
.TTrigData
) then
1422 raise TDynRecException
.CreateFmt('record reference type ''%s'' in field ''%s'' cannot be written', [mEBSTypeName
, mName
]);
1424 // write triggerdata
1425 GetMem(buf
, mMaxDim
);
1426 if (buf
= nil) then raise TDynRecException
.CreateFmt('record reference type ''%s'' in field ''%s'' cannot be written', [mEBSTypeName
, mName
]);
1428 FillChar(buf
^, mMaxDim
, 0);
1429 if (mRecRef
<> nil) then
1431 ws
:= TSFSMemoryChunkStream
.Create(buf
, mMaxDim
);
1432 mRecRef
.writeBinTo(hasLostData
, ws
, mMaxDim
); // as trigdata
1434 st
.WriteBuffer(buf
^, mMaxDim
);
1437 if (buf
<> nil) then FreeMem(buf
);
1443 TType
.TByte
: maxv
:= 127;
1444 TType
.TUByte
: maxv
:= 254;
1445 TType
.TShort
: maxv
:= 32767;
1446 TType
.TUShort
: maxv
:= 65534;
1447 TType
.TInt
: maxv
:= $7fffffff;
1448 TType
.TUInt
: maxv
:= $7fffffff;
1449 else raise TDynRecException
.CreateFmt('record reference type ''%s'' in field ''%s'' cannot be written', [mEBSTypeName
, mName
]);
1451 // find record number
1452 if (mRecRef
<> nil) then
1454 f
:= mOwner
.findRecordNumByType(mEBSTypeName
, mRecRef
);
1455 if (f
< 0) then raise TDynRecException
.CreateFmt('record reference type ''%s'' in field ''%s'' not found in record list', [mEBSTypeName
, mName
]);
1456 if mAsMonsterId
then Inc(f
);
1457 if (f
> maxv
) then raise TDynRecException
.CreateFmt('record reference type ''%s'' in field ''%s'' has too big index', [mEBSTypeName
, mName
]);
1461 if mAsMonsterId
then f
:= 0 else f
:= -1;
1464 TType
.TByte
, TType
.TUByte
: writeInt(st
, Byte(f
));
1465 TType
.TShort
, TType
.TUShort
: writeInt(st
, SmallInt(f
));
1466 TType
.TInt
, TType
.TUInt
: writeInt(st
, LongWord(f
));
1467 else raise TDynRecException
.CreateFmt('record reference type ''%s'' in field ''%s'' cannot be written', [mEBSTypeName
, mName
]);
1471 TEBS
.TEnum
: begin end;
1472 TEBS
.TBitSet
: begin end;
1473 else raise TDynRecException
.Create('ketmar forgot to handle some EBS type');
1479 if not mNegBool
then
1481 if (mIVal
<> 0) then writeInt(st
, Byte(1)) else writeInt(st
, Byte(0));
1485 if (mIVal
= 0) then writeInt(st
, Byte(1)) else writeInt(st
, Byte(0));
1491 if (mMaxDim
= 0) then raise TDynRecException
.CreateFmt('invalid string size definition for field ''%s''', [mName
]);
1492 if (mMaxDim
< 0) then
1494 if (Length(mSVal
) <> 1) then raise TDynRecException
.CreateFmt('invalid string size definition for field ''%s''', [mName
]);
1495 writeInt(st
, Byte(mSVal
[1]));
1499 if (Length(mSVal
) > mMaxDim
) then raise TDynRecException
.CreateFmt('invalid string size definition for field ''%s''', [mName
]);
1500 s
:= utf2win(mSVal
);
1501 if (Length(s
) > 0) then st
.WriteBuffer(PChar(s
)^, Length(s
));
1502 for f
:= Length(s
) to mMaxDim
do writeInt(st
, Byte(0));
1509 // triggerdata array was processed earlier
1510 if (mMaxDim
>= 0) then TDynRecException
.CreateFmt('byte array in field ''%s'' cannot be written', [mName
]);
1511 writeInt(st
, Byte(mIVal
));
1517 if (mMaxDim
>= 0) then raise TDynRecException
.CreateFmt('short array in field ''%s'' cannot be written', [mName
]);
1518 writeInt(st
, Word(mIVal
));
1524 if (mMaxDim
>= 0) then raise TDynRecException
.CreateFmt('int array in field ''%s'' cannot be written', [mName
]);
1525 writeInt(st
, LongWord(mIVal
));
1530 raise TDynRecException
.CreateFmt('cannot write string field ''%s''', [mName
]);
1534 if (mMaxDim
>= 0) then raise TDynRecException
.CreateFmt('pos/size array in field ''%s'' cannot be written', [mName
]);
1535 writeInt(st
, LongInt(mIVal
));
1536 writeInt(st
, LongInt(mIVal2
));
1541 if (mMaxDim
>= 0) then raise TDynRecException
.CreateFmt('pos/size array in field ''%s'' cannot be written', [mName
]);
1542 writeInt(st
, Word(mIVal
));
1543 writeInt(st
, Word(mIVal2
));
1548 if (mMaxDim
>= 0) then raise TDynRecException
.CreateFmt('color array in field ''%s'' cannot be written', [mName
]);
1549 writeInt(st
, Byte(mIVal
));
1550 writeInt(st
, Byte(mIVal2
));
1551 writeInt(st
, Byte(mIVal3
));
1552 //writeInt(st, Byte(mIVal4)); // the only place we have RGB in binary map is effect trigger, and it has no alpha
1553 if (mIVal4
<> 255) then hasLostData
:= true;
1557 raise TDynRecException
.Create('cannot write lists to binary format');
1559 raise TDynRecException
.Create('cannot write triggers to binary format (internal error)');
1560 else raise TDynRecException
.Create('ketmar forgot to handle some field type');
1565 procedure TDynField
.writeTo (wr
: TTextWriter
);
1569 first
, found
: Boolean;
1574 TEBS
.TNone
: begin end;
1577 if (mRecRef
= nil) then
1579 if (mType
= TType
.TTrigData
) then wr
.put('{}'#10) else wr
.put('null;'#10);
1581 else if (Length(mRecRef
.mId
) = 0) then
1583 mRecRef
.writeTo(wr
, false); // only data, no header
1587 wr
.put(mRecRef
.mId
);
1594 //def := mOwner.mOwner;
1595 //es := def.ebsType[mEBSTypeName];
1597 if (mEBSType
<> nil) and (mEBSType
is TDynEBS
) then es
:= (mEBSType
as TDynEBS
);
1598 if (es
= nil) or (not es
.mIsEnum
) then raise TDynRecException
.CreateFmt('record enum type ''%s'' for field ''%s'' not found', [mEBSTypeName
, mName
]);
1599 for f
:= 0 to High(es
.mVals
) do
1601 if (es
.mVals
[f
] = mIVal
) then
1608 raise TDynRecException
.CreateFmt('value %d in record enum type ''%s'' for field ''%s'' not found', [mIVal
, mEBSTypeName
, mName
]);
1612 //def := mOwner.mOwner;
1613 //es := def.ebsType[mEBSTypeName];
1615 if (mEBSType
<> nil) and (mEBSType
is TDynEBS
) then es
:= (mEBSType
as TDynEBS
);
1616 if (es
= nil) or es
.mIsEnum
then raise TDynRecException
.CreateFmt('record bitset type ''%s'' for field ''%s'' not found', [mEBSTypeName
, mName
]);
1620 for f
:= 0 to High(es
.mVals
) do
1622 if (es
.mVals
[f
] = 0) then
1629 raise TDynRecException
.CreateFmt('value %d in record bitset type ''%s'' for field ''%s'' not found', [0, mEBSTypeName
, mName
]);
1634 while (mask
<> 0) do
1636 if ((mIVal
and mask
) <> 0) then
1639 for f
:= 0 to High(es
.mVals
) do
1641 if (es
.mVals
[f
] = mask
) then
1643 if not first
then wr
.put(' | ') else first
:= false;
1649 if not found
then raise TDynRecException
.CreateFmt('value %d in record bitset type ''%s'' for field ''%s'' not found', [mask
, mEBSTypeName
, mName
]);
1656 else raise TDynRecException
.Create('ketmar forgot to handle some EBS type');
1662 if (mIVal
= 0) then wr
.put('false;'#10) else wr
.put('true;'#10);
1667 if (mMaxDim
= 0) then raise TDynRecException
.CreateFmt('invalid string size definition for field ''%s''', [mName
]);
1668 wr
.put(quoteStr(mSVal
));
1679 wr
.put('%d;'#10, [mIVal
]);
1684 wr
.put(quoteStr(mSVal
));
1691 wr
.put('(%d %d);'#10, [mIVal
, mIVal2
]);
1696 if (mIVal3
= 255) then wr
.put('(%d %d %d);'#10, [mIVal
, mIVal2
, mIVal3
])
1697 else wr
.put('(%d %d %d %d);'#10, [mIVal
, mIVal2
, mIVal3
, mIVal4
]);
1710 else raise TDynRecException
.Create('ketmar forgot to handle some field type');
1712 raise TDynRecException
.CreateFmt('cannot parse field ''%s'' yet', [mName
]);
1716 procedure TDynField
.parseBinValue (st
: TStream
);
1718 rec
, rc
: TDynRecord
;
1726 TEBS
.TNone
: begin end;
1729 // this must be triggerdata
1730 if (mType
= TType
.TTrigData
) then
1732 assert(mMaxDim
> 0);
1734 // find trigger definition
1735 tfld
:= rec
.trigTypeField();
1736 if (tfld
= nil) then raise TDynRecException
.CreateFmt('triggerdata value for field ''%s'' in record ''%s'' without TriggerType field', [mName
, rec
.mTypeName
]);
1737 rc
:= mOwner
.mOwner
.trigTypeFor
[tfld
.mSVal
]; // find in mapdef
1738 if (rc
= nil) then raise TDynRecException
.CreateFmt('triggerdata definition for field ''%s'' in record ''%s'' with type ''%s'' not found', [mName
, rec
.mTypeName
, tfld
.mSVal
]);
1739 rc
:= rc
.clone(mOwner
.mHeaderRec
);
1740 rc
.mHeaderRec
:= mOwner
.mHeaderRec
;
1741 // on error, it will be freed by memowner
1742 rc
.parseBinValue(st
, true);
1749 // not a trigger data
1751 TType
.TByte
: f
:= readShortInt(st
);
1752 TType
.TUByte
: f
:= readByte(st
);
1753 TType
.TShort
: f
:= readSmallInt(st
);
1754 TType
.TUShort
: f
:= readWord(st
);
1755 TType
.TInt
: f
:= readLongInt(st
);
1756 TType
.TUInt
: f
:= readLongWord(st
);
1757 else raise TDynRecException
.CreateFmt('invalid non-numeric type ''%s'' for field ''%s'' of record ''%s''', [getTypeName(mType
), mName
, mEBSTypeName
]);
1759 if mAsMonsterId
then Dec(f
);
1760 if (f
< 0) then mRecRefId
:= '' else mRecRefId
:= Format('%s%d', [mEBSTypeName
, f
]);
1768 assert(mMaxDim
< 0);
1770 TType
.TByte
: f
:= readShortInt(st
);
1771 TType
.TUByte
: f
:= readByte(st
);
1772 TType
.TShort
: f
:= readSmallInt(st
);
1773 TType
.TUShort
: f
:= readWord(st
);
1774 TType
.TInt
: f
:= readLongInt(st
);
1775 TType
.TUInt
: f
:= readLongWord(st
);
1776 else raise TDynRecException
.CreateFmt('invalid non-numeric type ''%s'' for field ''%s'' of record ''%s''', [getTypeName(mType
), mName
, mEBSTypeName
]);
1779 if (mEBSType
<> nil) and (mEBSType
is TDynEBS
) then es
:= (mEBSType
as TDynEBS
);
1780 if (es
= nil) or (es
.mIsEnum
<> (mEBS
= TEBS
.TEnum
)) then raise TDynRecException
.CreateFmt('record enum type ''%s'' for field ''%s'' not found', [mEBSTypeName
, mName
]);
1782 // build enum/bitfield values
1783 if (mEBS
= TEBS
.TEnum
) then
1785 mSVal
:= es
.nameByValue(mIVal
);
1786 if (Length(mSVal
) = 0) then raise TDynRecException
.CreateFmt('record enum type ''%s'' for field ''%s'' has invalid value %d', [mEBSTypeName
, mName
, mIVal
]);
1790 // special for 'none'
1793 mSVal
:= es
.nameByValue(mIVal
);
1794 if (Length(mSVal
) = 0) then raise TDynRecException
.CreateFmt('record bitset type ''%s'' for field ''%s'' has invalid value %d', [mEBSTypeName
, mName
, mIVal
]);
1800 while (mask
<> 0) do
1802 if ((mIVal
and mask
) <> 0) then
1804 s
:= es
.nameByValue(mask
);
1805 if (Length(s
) = 0) then raise TDynRecException
.CreateFmt('record bitset type ''%s'' for field ''%s'' has invalid value %d', [mEBSTypeName
, mName
, mask
]);
1806 if (Length(mSVal
) <> 0) then mSVal
+= '+';
1813 //writeln('ebs <', es.mName, '>: ', mSVal);
1817 else raise TDynRecException
.Create('ketmar forgot to handle some EBS type');
1824 if (f
<> 0) then f
:= 1;
1825 if mNegBool
then f
:= 1-f
;
1832 if (mMaxDim
< 0) then
1834 mIVal
:= readByte(st
);
1839 GetMem(tdata
, mMaxDim
);
1841 st
.ReadBuffer(tdata
^, mMaxDim
);
1843 while (f
< mMaxDim
) and (tdata
[f
] <> 0) do Inc(f
);
1846 SetLength(mSVal
, f
);
1847 Move(tdata
^, PChar(mSVal
)^, f
);
1848 mSVal
:= win2utf(mSVal
);
1857 TType
.TByte
: begin mIVal
:= readShortInt(st
); mDefined
:= true; exit
; end;
1858 TType
.TUByte
: begin mIVal
:= readByte(st
); mDefined
:= true; exit
; end;
1859 TType
.TShort
: begin mIVal
:= readSmallInt(st
); mDefined
:= true; exit
; end;
1860 TType
.TUShort
: begin mIVal
:= readWord(st
); mDefined
:= true; exit
; end;
1861 TType
.TInt
: begin mIVal
:= readLongInt(st
); mDefined
:= true; exit
; end;
1862 TType
.TUInt
: begin mIVal
:= readLongWord(st
); mDefined
:= true; exit
; end;
1865 raise TDynRecException
.Create('cannot read strings from binaries yet');
1870 mIVal
:= readLongInt(st
);
1871 mIVal2
:= readLongInt(st
);
1877 mIVal
:= readWord(st
);
1878 mIVal2
:= readWord(st
);
1884 mIVal
:= readByte(st
);
1885 mIVal2
:= readByte(st
);
1886 mIVal3
:= readByte(st
);
1887 //mIVal4 := readByte(st); // the only place we have RGB in binary map is effect trigger, and it has no alpha
1902 else raise TDynRecException
.Create('ketmar forgot to handle some field type');
1904 raise TDynRecException
.CreateFmt('cannot parse field ''%s'' yet', [mName
]);
1908 procedure TDynField
.parseValue (pr
: TTextParser
);
1910 procedure parseInt (min
, max
: Integer);
1912 mIVal
:= pr
.expectInt();
1913 if (mIVal
< min
) or (mIVal
> max
) then raise TDynParseException
.CreateFmt(pr
, 'invalid %s value for field ''%s''', [getTypeName(mType
), mName
]);
1918 rec
, rc
: TDynRecord
;
1924 if (pr
.tokType
= pr
.TTEOF
) then raise TDynParseException
.Create(pr
, 'field value expected');
1925 if (pr
.isDelim(';')) then raise TDynParseException
.Create(pr
, 'extra semicolon');
1926 // if this field should contain struct, convert type and parse struct
1928 TEBS
.TNone
: begin end;
1931 // ugly hack. sorry.
1932 if (mType
= TType
.TTrigData
) then
1934 pr
.expectDelim('{');
1935 if (pr
.eatDelim('}')) then
1943 // find trigger definition
1944 tfld
:= rec
.trigTypeField();
1945 if (tfld
= nil) then raise TDynParseException
.CreateFmt(pr
, 'triggerdata value for field ''%s'' in record ''%s'' without ''type'' field', [mName
, rec
.mTypeName
]);
1946 rc
:= mOwner
.mOwner
.trigTypeFor
[tfld
.mSVal
]; // find in mapdef
1947 if (rc
= nil) then raise TDynParseException
.CreateFmt(pr
, 'triggerdata definition for field ''%s'' in record ''%s'' with type ''%s'' not found', [mName
, rec
.mTypeName
, tfld
.mSVal
]);
1948 rc
:= rc
.clone(mOwner
.mHeaderRec
);
1949 rc
.mHeaderRec
:= mOwner
.mHeaderRec
;
1950 //writeln(rc.definition);
1951 // on error, it will be freed by memowner
1952 rc
.parseValue(pr
, true);
1956 pr
.eatDelim(';'); // hack: allow (but don't require) semicolon after inline records
1959 // other record types
1960 if (pr
.tokType
= pr
.TTId
) then
1962 if pr
.eatId('null') then
1968 rec
:= mOwner
.findRecordByTypeId(mEBSTypeName
, pr
.tokStr
);
1971 mRecRefId
:= pr
.tokStr
;
1981 pr
.expectDelim(';');
1984 else if (pr
.isDelim('{')) then
1986 //rec := mOwner.mOwner.recType[mEBSTypeName]; // find in mapdef
1988 if (mEBSType
<> nil) and (mEBSType
is TDynRecord
) then rec
:= (mEBSType
as TDynRecord
);
1989 if (rec
= nil) then raise TDynParseException
.CreateFmt(pr
, 'record type ''%s'' for field ''%s'' not found', [mEBSTypeName
, mName
]);
1990 rc
:= rec
.clone(mOwner
.mHeaderRec
);
1991 rc
.mHeaderRec
:= mOwner
.mHeaderRec
;
1995 if mOwner
.addRecordByType(mEBSTypeName
, rc
) then
1997 raise TDynParseException
.CreateFmt(pr
, 'duplicate record with id ''%s'' for field ''%s'' in record ''%s''', [rc
.mId
, mName
, mOwner
.mTypeName
]);
1999 pr
.eatDelim(';'); // hack: allow (but don't require) semicolon after inline records
2002 pr
.expectDelim('{');
2006 //es := mOwner.mOwner.ebsType[mEBSTypeName]; // find in mapdef
2008 if (mEBSType
<> nil) and (mEBSType
is TDynEBS
) then es
:= (mEBSType
as TDynEBS
);
2009 if (es
= nil) or (not es
.mIsEnum
) then raise TDynParseException
.CreateFmt(pr
, 'record enum type ''%s'' for field ''%s'' not found', [mEBSTypeName
, mName
]);
2010 tk
:= pr
.expectId();
2011 if not es
.has
[tk
] then raise TDynParseException
.CreateFmt(pr
, 'record enum value ''%s'' of type ''%s'' for field ''%s'' not found', [tk
, mEBSTypeName
, mName
]);
2012 mIVal
:= es
.field
[tk
];
2014 //writeln('ENUM ', mEBSName, '; element <', mSVal, '> with value ', mIVal);
2016 pr
.expectDelim(';');
2021 //es := mOwner.mOwner.ebsType[mEBSTypeName]; // find in mapdef
2023 if (mEBSType
<> nil) and (mEBSType
is TDynEBS
) then es
:= (mEBSType
as TDynEBS
);
2024 if (es
= nil) or es
.mIsEnum
then raise TDynParseException
.CreateFmt(pr
, 'record bitset type ''%s'' for field ''%s'' not found', [mEBSTypeName
, mName
]);
2028 tk
:= pr
.expectId();
2029 if not es
.has
[tk
] then raise TDynParseException
.CreateFmt(pr
, 'record bitset value ''%s'' of type ''%s'' for field ''%s'' not found', [tk
, mEBSTypeName
, mName
]);
2030 mIVal
:= mIVal
or es
.field
[tk
];
2032 if (pr
.tokType
<> pr
.TTDelim
) or ((pr
.tokChar
<> '|') and (pr
.tokChar
<> '+')) then break
;
2033 if mBitSetUnique
then raise TDynParseException
.CreateFmt(pr
, 'record bitset of type ''%s'' for field ''%s'' expects only one value', [tk
, mEBSTypeName
, mName
]);
2034 pr
.skipToken(); // plus or pipe
2037 pr
.expectDelim(';');
2040 else raise TDynParseException
.Create(pr
, 'ketmar forgot to handle some EBS type');
2046 if pr
.eatId('true') or pr
.eatId('tan') or pr
.eatId('yes') then mIVal
:= 1
2047 else if pr
.eatId('false') or pr
.eatId('ona') or pr
.eatId('no') then mIVal
:= 0
2048 else raise TDynParseException
.CreateFmt(pr
, 'invalid bool value for field ''%s''', [mName
]);
2050 pr
.expectDelim(';');
2055 if (mMaxDim
= 0) then raise TDynParseException
.CreateFmt(pr
, 'invalid string size definition for field ''%s''', [mName
]);
2056 mSVal
:= pr
.expectStr(true);
2057 if (mMaxDim
< 0) then
2060 if (Length(mSVal
) <> 1) then raise TDynParseException
.CreateFmt(pr
, 'invalid string size for field ''%s''', [mName
]);
2061 mIVal
:= Integer(mSVal
[1]);
2067 if (Length(mSVal
) > mMaxDim
) then raise TDynParseException
.CreateFmt(pr
, 'invalid string size for field ''%s''', [mName
]);
2070 pr
.expectDelim(';');
2075 parseInt(-128, 127);
2076 pr
.expectDelim(';');
2082 pr
.expectDelim(';');
2087 parseInt(-32768, 32768);
2088 pr
.expectDelim(';');
2094 pr
.expectDelim(';');
2099 parseInt(Integer($80000000), $7fffffff);
2100 pr
.expectDelim(';');
2105 parseInt(0, $7fffffff); //FIXME
2106 pr
.expectDelim(';');
2111 mSVal
:= pr
.expectStr(true);
2113 pr
.expectDelim(';');
2119 if pr
.eatDelim('[') then edim
:= ']' else begin pr
.expectDelim('('); edim
:= ')'; end;
2120 mIVal
:= pr
.expectInt();
2121 if (mType
= TType
.TSize
) then
2123 if (mIVal
< 0) or (mIVal
> 65535) then raise TDynParseException
.CreateFmt(pr
, 'invalid %s value for field ''%s''', [getTypeName(mType
), mName
]);
2125 mIVal2
:= pr
.expectInt();
2126 if (mType
= TType
.TSize
) then
2128 if (mIVal2
< 0) or (mIVal2
> 65535) then raise TDynParseException
.CreateFmt(pr
, 'invalid %s value for field ''%s''', [getTypeName(mType
), mName
]);
2131 pr
.expectDelim(edim
);
2132 pr
.expectDelim(';');
2137 if pr
.eatDelim('[') then edim
:= ']' else begin pr
.expectDelim('('); edim
:= ')'; end;
2138 mIVal
:= pr
.expectInt();
2139 if (mIVal
< 0) or (mIVal
> 255) then raise TDynParseException
.CreateFmt(pr
, 'invalid %s value for field ''%s''', [getTypeName(mType
), mName
]);
2140 mIVal2
:= pr
.expectInt();
2141 if (mIVal2
< 0) or (mIVal2
> 255) then raise TDynParseException
.CreateFmt(pr
, 'invalid %s value for field ''%s''', [getTypeName(mType
), mName
]);
2142 mIVal3
:= pr
.expectInt();
2143 if (mIVal3
< 0) or (mIVal3
> 255) then raise TDynParseException
.CreateFmt(pr
, 'invalid %s value for field ''%s''', [getTypeName(mType
), mName
]);
2144 if (pr
.tokType
= pr
.TTInt
) then
2146 mIVal4
:= pr
.expectInt();
2147 if (mIVal4
< 0) or (mIVal4
> 255) then raise TDynParseException
.CreateFmt(pr
, 'invalid %s value for field ''%s''', [getTypeName(mType
), mName
]);
2154 pr
.expectDelim(edim
);
2155 pr
.expectDelim(';');
2168 else raise TDynParseException
.Create(pr
, 'ketmar forgot to handle some field type');
2170 raise TDynParseException
.CreateFmt(pr
, 'cannot parse field ''%s'' yet', [mName
]);
2174 // ////////////////////////////////////////////////////////////////////////// //
2175 constructor TDynRecord
.Create (pr
: TTextParser
);
2177 if (pr
= nil) then raise TDynParseException
.Create(pr
, 'cannot create record type without type definition');
2181 mFields
:= TDynFieldList
.Create();
2182 {$IF DEFINED(XDYNREC_USE_FIELDHASH)}
2183 mFieldsHash
:= hashNewStrInt();
2195 constructor TDynRecord
.Create ();
2199 mFields
:= TDynFieldList
.Create();
2200 {$IF DEFINED(XDYNREC_USE_FIELDHASH)}
2201 mFieldsHash
:= hashNewStrInt();
2212 destructor TDynRecord
.Destroy ();
2217 if (mRec2Free
<> nil) then
2219 for rec
in mRec2Free
do
2221 if (rec
<> self
) then
2223 //writeln(formatstrf('freeing: 0x%08x; name=%s; id=%s', [Pointer(rec), rec.mName, rec.mId]));
2231 for fld
in mFields
do fld
.Free();
2234 {$IF DEFINED(XDYNREC_USE_FIELDHASH)}
2246 procedure TDynRecord
.regrec (rec
: TDynRecord
);
2248 if (rec
<> nil) and (rec
<> self
) then
2250 if (mRec2Free
= nil) then mRec2Free
:= TDynRecList
.Create();
2251 mRec2Free
.append(rec
);
2256 procedure TDynRecord
.addField (fld
: TDynField
); inline;
2258 if (fld
= nil) then raise TDynRecException
.Create('cannot append nil field to record');
2259 mFields
.append(fld
);
2260 {$IF DEFINED(XDYNREC_USE_FIELDHASH)}
2261 if (Length(fld
.mName
) > 0) then mFieldsHash
.put(fld
.mName
, mFields
.count
-1);
2266 function TDynRecord
.addFieldChecked (fld
: TDynField
): Boolean; inline; // `true`: duplicate name
2269 if (fld
= nil) then raise TDynRecException
.Create('cannot append nil field to record');
2270 {$IF not DEFINED(XDYNREC_USE_FIELDHASH)}
2271 if (Length(fld
.mName
) > 0) then result
:= hasByName(fld
.mName
);
2273 mFields
.append(fld
);
2274 {$IF DEFINED(XDYNREC_USE_FIELDHASH)}
2275 if (Length(fld
.mName
) > 0) then result
:= mFieldsHash
.put(fld
.mName
, mFields
.count
-1);
2280 function TDynRecord
.findByName (const aname
: AnsiString
): Integer; inline;
2282 {$IF DEFINED(XDYNREC_USE_FIELDHASH)}
2283 if not mFieldsHash
.get(aname
, result
) then result
:= -1;
2286 while (result
< mFields
.count
) do
2288 if StrEqu(aname
, mFields
[result
].mName
) then exit
;
2296 function TDynRecord
.hasByName (const aname
: AnsiString
): Boolean; inline;
2298 result
:= (findByName(aname
) >= 0);
2302 function TDynRecord
.getFieldByName (const aname
: AnsiString
): TDynField
; inline;
2306 f
:= findByName(aname
);
2307 if (f
>= 0) then result
:= mFields
[f
] else result
:= nil;
2311 function TDynRecord
.getFieldAt (idx
: Integer): TDynField
; inline;
2313 if (idx
>= 0) and (idx
< mFields
.count
) then result
:= mFields
[idx
] else result
:= nil;
2317 function TDynRecord
.getCount (): Integer; inline;
2319 result
:= mFields
.count
;
2323 function TDynRecord
.getIsTrigData (): Boolean; inline;
2325 result
:= (Length(mTrigTypes
) > 0);
2329 function TDynRecord
.getIsForTrig (const aname
: AnsiString
): Boolean; inline;
2334 for f
:= 0 to High(mTrigTypes
) do if StrEqu(mTrigTypes
[f
], aname
) then exit
;
2339 function TDynRecord
.getForTrigCount (): Integer; inline;
2341 result
:= Length(mTrigTypes
);
2345 function TDynRecord
.getForTrigAt (idx
: Integer): AnsiString
; inline;
2347 if (idx
>= 0) and (idx
< Length(mTrigTypes
)) then result
:= mTrigTypes
[idx
] else result
:= '';
2351 function TDynRecord
.clone (registerIn
: TDynRecord
): TDynRecord
;
2356 result
:= TDynRecord
.Create();
2357 result
.mOwner
:= mOwner
;
2359 result
.mTypeName
:= mTypeName
;
2360 result
.mTip
:= mTip
;
2361 result
.mHelp
:= mHelp
;
2362 result
.mSize
:= mSize
;
2363 result
.mHeader
:= mHeader
;
2364 result
.mBinBlock
:= mBinBlock
;
2365 result
.mHeaderRec
:= mHeaderRec
;
2366 result
.mTagInt
:= mTagInt
;
2367 result
.mTagPtr
:= mTagPtr
;
2368 if (mFields
.count
> 0) then
2370 result
.mFields
.capacity
:= mFields
.count
;
2371 for fld
in mFields
do result
.addField(fld
.clone(result
, registerIn
));
2373 SetLength(result
.mTrigTypes
, Length(mTrigTypes
));
2374 for f
:= 0 to High(mTrigTypes
) do result
.mTrigTypes
[f
] := mTrigTypes
[f
];
2375 if (registerIn
<> nil) then registerIn
.regrec(result
);
2379 function TDynRecord
.findRecordByTypeId (const atypename
, aid
: AnsiString
): TDynRecord
;
2385 if (Length(aid
) = 0) then exit
;
2387 fld
:= mHeaderRec
.field
[atypename
];
2388 if (fld
= nil) then exit
;
2389 if (fld
.mType
<> fld
.TType
.TList
) then raise TDynRecException
.CreateFmt('cannot get record of type ''%s'' due to name conflict with ordinary field', [atypename
]);
2391 if (fld
.mRVal
<> nil) then
2393 if fld
.mRHash
.get(aid
, idx
) then begin result
:= fld
.mRVal
[idx
]; exit
; end;
2399 function TDynRecord
.findRecordNumByType (const atypename
: AnsiString
; rc
: TDynRecord
): Integer;
2406 fld
:= mHeaderRec
.field
[atypename
];
2407 if (fld
= nil) then exit
;
2408 if (fld
.mType
<> fld
.TType
.TList
) then raise TDynRecException
.CreateFmt('cannot get record of type ''%s'' due to name conflict with ordinary field', [atypename
]);
2410 if (fld
.mRVal
<> nil) then
2412 for idx
:= 0 to fld
.mRVal
.count
-1 do
2414 if (fld
.mRVal
[idx
] = rc
) then begin result
:= idx
; exit
; end;
2421 function TDynRecord
.addRecordByType (const atypename
: AnsiString
; rc
: TDynRecord
): Boolean;
2426 fld
:= mHeaderRec
.field
[atypename
];
2430 fld
:= TDynField
.Create(atypename
, TDynField
.TType
.TList
);
2431 fld
.mOwner
:= mHeaderRec
;
2432 mHeaderRec
.addField(fld
);
2434 if (fld
.mType
<> fld
.TType
.TList
) then raise TDynRecException
.CreateFmt('cannot append record of type ''%s'' due to name conflict with ordinary field', [atypename
]);
2436 if (fld
.mRVal
= nil) then
2438 fld
.mRVal
:= TDynRecList
.Create();
2439 fld
.mRHash
:= THashStrInt
.Create();
2441 result
:= fld
.addListItem(rc
);
2445 function TDynRecord
.isSimpleEqu (rec
: TDynRecord
): Boolean;
2449 if (rec
= nil) then begin result
:= false; exit
; end; // self.mRecRef can't be `nil` here
2450 if (rec
= self
) then begin result
:= true; exit
; end;
2451 if (mFields
.count
<> rec
.mFields
.count
) then begin result
:= false; exit
; end;
2453 for f
:= 0 to mFields
.count
-1 do
2455 if not mFields
[f
].isSimpleEqu(rec
.mFields
[f
]) then exit
;
2461 function TDynRecord
.trigTypeField (): TDynField
;
2466 for fld
in mFields
do
2468 if (fld
.mEBS
<> TDynField
.TEBS
.TEnum
) then continue
;
2469 if not (fld
.mEBSType
is TDynEBS
) then continue
;
2470 es
:= (fld
.mEBSType
as TDynEBS
);
2472 if StrEqu(es
.mTypeName
, 'TriggerType') then begin result
:= fld
; exit
; end;
2478 // number of records of the given instance
2479 function TDynRecord
.instanceCount (const atypename
: AnsiString
): Integer;
2484 fld
:= field
[atypename
];
2485 if (fld
<> nil) and (fld
.mType
= fld
.TType
.TList
) then result
:= fld
.mRVal
.count
;
2489 function TDynRecord
.newTypedRecord (const atypename
, aid
: AnsiString
): TDynRecord
;
2494 if not mHeader
then raise TDynRecException
.Create('cannot create new records with non-header');
2495 if (Length(aid
) = 0) then raise TDynRecException
.CreateFmt('cannot create new record of type ''%s'' without id', [atypename
]);
2496 trc
:= mapdef
.recType
[atypename
];
2497 if (trc
= nil) then begin result
:= nil; exit
; end;
2498 // check if aid is unique
2499 fld
:= field
[atypename
];
2500 if (fld
<> nil) and (fld
.getListItem(aid
) <> nil) then raise TDynRecException
.CreateFmt('cannot create record of type ''%s'' with duplicate id ''%s''', [atypename
, aid
]);
2501 result
:= trc
.clone(self
);
2503 addRecordByType(atypename
, result
);
2507 procedure TDynRecord
.clearRefRecs (rec
: TDynRecord
);
2508 procedure clearRefs (fld
: TDynField
);
2512 if (fld
= nil) then exit
;
2513 if (fld
.mRecRef
= rec
) then fld
.mRecRef
:= nil;
2514 if (fld
.mType
= fld
.TType
.TList
) then for rc
in fld
.mRVal
do rc
.clearRefRecs(rec
);
2519 if (rec
= nil) or (mFields
= nil) then exit
;
2520 for fld
in mFields
do clearRefs(fld
);
2524 // remove record with the given type and id
2525 // return `true` if record was successfully found and removed
2526 // this will do all necessary recref cleanup too
2527 function TDynRecord
.removeTypedRecord (const atypename
, aid
: AnsiString
): Boolean;
2529 trc
, rec
: TDynRecord
;
2532 doFree
: Boolean = false;
2535 if not mHeader
then raise TDynRecException
.Create('cannot remove records with non-header');
2536 if (Length(aid
) = 0) then exit
;
2537 trc
:= mapdef
.recType
[atypename
];
2538 if (trc
= nil) then exit
;
2539 fld
:= field
[atypename
];
2540 if (fld
= nil) then exit
;
2541 rec
:= fld
.removeListItem(aid
);
2542 if (rec
= nil) then exit
;
2544 for f
:= 0 to mRec2Free
.count
-1 do
2546 if (mRec2Free
[f
] = rec
) then
2548 mRec2Free
[f
] := nil;
2552 if doFree
then rec
.Free();
2556 function TDynRecord
.getUserVar (const aname
: AnsiString
): Variant
;
2560 fld
:= getFieldByName(aname
);
2561 if (fld
= nil) then result
:= Unassigned
else result
:= fld
.value
;
2565 procedure TDynRecord
.setUserVar (const aname
: AnsiString
; val
: Variant
);
2569 fld
:= getFieldByName(aname
);
2572 if (Length(aname
) = 0) then raise TDynRecException
.Create('cannot create nameless user field');
2573 fld
:= TDynField
.Create(aname
, val
);
2575 fld
.mInternal
:= true;
2585 procedure TDynRecord
.parseDef (pr
: TTextParser
);
2590 if pr
.eatId('TriggerData') then
2593 if pr
.eatDelim('(') then
2597 while (pr
.eatDelim(',')) do begin end;
2598 if pr
.eatDelim(')') then break
;
2599 tdn
:= pr
.expectId();
2600 if isForTrig
[tdn
] then raise TDynParseException
.CreateFmt(pr
, 'duplicate trigdata ''%s'' trigtype ''%s''', [mTypeName
, tdn
]);
2601 SetLength(mTrigTypes
, Length(mTrigTypes
)+1);
2602 mTrigTypes
[High(mTrigTypes
)] := tdn
;
2607 tdn
:= pr
.expectId();
2608 SetLength(mTrigTypes
, 1);
2609 mTrigTypes
[0] := tdn
;
2611 mTypeName
:= 'TriggerData';
2615 mTypeName
:= pr
.expectStrOrId();
2616 while (not pr
.isDelim('{')) do
2618 if pr
.eatId('header') then begin mHeader
:= true; continue
; end;
2619 if pr
.eatId('size') then
2621 if (mSize
> 0) then raise TDynParseException
.CreateFmt(pr
, 'duplicate `size` in record ''%s''', [mTypeName
]);
2622 mSize
:= pr
.expectInt();
2623 if (mSize
< 1) then raise TDynParseException
.CreateFmt(pr
, 'invalid record ''%s'' size: %d', [mTypeName
, mSize
]);
2624 pr
.expectId('bytes');
2627 if pr
.eatId('binblock') then
2629 if (mBinBlock
>= 0) then raise TDynParseException
.CreateFmt(pr
, 'duplicate `binblock` in record ''%s''', [mTypeName
]);
2630 mBinBlock
:= pr
.expectInt();
2631 if (mBinBlock
< 1) then raise TDynParseException
.CreateFmt(pr
, 'invalid record ''%s'' binblock: %d', [mTypeName
, mBinBlock
]);
2634 if pr
.eatId('tip') then
2636 if (Length(mTip
) > 0) then raise TDynParseException
.CreateFmt(pr
, 'duplicate tip definition for record ''%s''', [mTypeName
]);
2637 mTip
:= pr
.expectStr(false);
2640 if pr
.eatId('help') then
2642 if (Length(mHelp
) > 0) then raise TDynParseException
.CreateFmt(pr
, 'duplicate help definition for record ''%s''', [mTypeName
]);
2643 mHelp
:= pr
.expectStr(false);
2649 pr
.expectDelim('{');
2651 while (not pr
.isDelim('}')) do
2653 fld
:= TDynField
.Create(pr
);
2656 if addFieldChecked(fld
) then
2659 raise TDynParseException
.CreateFmt(pr
, 'duplicate field ''%s''', [fld
.name
]);
2663 pr
.expectDelim('}');
2667 function TDynRecord
.definition (): AnsiString
;
2674 result
:= 'TriggerData for ';
2675 if (Length(mTrigTypes
) > 1) then
2678 for f
:= 0 to High(mTrigTypes
) do
2680 if (f
<> 0) then result
+= ', ';
2681 result
+= mTrigTypes
[f
];
2687 result
+= mTrigTypes
[0];
2693 result
:= quoteStr(mTypeName
);
2694 if (mSize
>= 0) then result
+= Format(' size %d bytes', [mSize
]);
2695 if mHeader
then result
+= ' header';
2698 for f
:= 0 to mFields
.count
-1 do
2701 result
+= mFields
[f
].definition
;
2708 procedure TDynRecord
.parseBinValue (st
: TStream
; forceData
: Boolean=false);
2714 loaded
: array[0..255] of Boolean;
2715 rec
, rect
: TDynRecord
;
2718 mst
: TSFSMemoryChunkStream
= nil;
2720 procedure linkNames (rec
: TDynRecord
);
2725 //writeln('*** rec: ', rec.mName, '.', rec.mId, ' (', rec.mFields.count, ')');
2726 for fld
in rec
.mFields
do
2728 if (fld
.mType
= TDynField
.TType
.TTrigData
) then
2730 if (fld
.mRecRef
<> nil) then linkNames(fld
.mRecRef
);
2733 if (Length(fld
.mRecRefId
) = 0) then continue
;
2734 assert(fld
.mEBSType
<> nil);
2735 rt
:= findRecordByTypeId(fld
.mEBSTypeName
, fld
.mRecRefId
);
2738 if assigned(DynWarningCB
) then
2740 DynWarningCB(formatstrf('record of type ''%s'' with id ''%s'' links to inexistant record of type ''%s'' with id ''%s''', [rec
.mTypeName
, rec
.mId
, fld
.mEBSTypeName
, fld
.mRecRefId
]), -1, -1);
2742 //raise TDynRecException.CreateFmt('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]);
2744 //writeln(' ', rec.mName, '.', rec.mId, ':', fld.mName, ' -> ', rt.mName, '.', rt.mId, ' (', fld.mEBSTypeName, '.', fld.mRecRefId, ')');
2745 fld
.mRecRefId
:= '';
2747 fld
.mDefined
:= true;
2749 for fld
in rec
.mFields
do
2751 //if (fld.mName = 'ambient_color') then writeln('****', fld.mName);
2752 fld
.fixDefaultValue(); // just in case
2757 for f
:= 0 to High(loaded
) do loaded
[f
] := false;
2758 mst
:= TSFSMemoryChunkStream
.Create(nil, 0);
2760 if mHeader
and not forceData
then
2762 // parse map file as sequence of blocks
2764 st
.ReadBuffer(sign
[1], 4);
2765 if (sign
<> 'MAP'#1) then raise TDynRecException
.Create('invalid binary map signature');
2767 while (st
.position
< st
.size
) do
2769 btype
:= readByte(st
);
2770 if (btype
= 0) then break
; // no more blocks
2771 readLongWord(st
); // reserved
2772 bsize
:= readLongInt(st
);
2773 {$IF DEFINED(D2D_XDYN_DEBUG)}writeln('btype=', btype
, '; bsize=', bsize
);{$ENDIF}
2774 if (bsize
< 0) or (bsize
> $1fffffff) then raise TDynRecException
.CreateFmt('block of type %d has invalid size %d', [btype
, bsize
]);
2775 if loaded
[btype
] then raise TDynRecException
.CreateFmt('block of type %d already loaded', [btype
]);
2776 loaded
[btype
] := true;
2777 // find record type for this block
2779 for rec
in mOwner
.recTypes
do if (rec
.mBinBlock
= btype
) then begin rect
:= rec
; break
; end;
2780 if (rect
= nil) then raise TDynRecException
.CreateFmt('block of type %d has no corresponding record', [btype
]);
2781 //writeln('found type ''', rec.mName, ''' for block type ', btype);
2782 if (rec
.mSize
= 0) or ((bsize
mod rec
.mSize
) <> 0) then raise TDynRecException
.CreateFmt('block of type %d has invalid number of records', [btype
]);
2784 if (rect
.mHeader
) then
2786 if (bsize
<> mSize
) then raise TDynRecException
.CreateFmt('header block of type %d has invalid number of records', [btype
]);
2788 st
.ReadBuffer(buf
^, bsize
);
2789 mst
.setup(buf
, mSize
);
2790 parseBinValue(mst
, true); // force parsing data
2794 // create list for this type
2795 fld
:= TDynField
.Create(rec
.mTypeName
, TDynField
.TType
.TList
);
2801 st
.ReadBuffer(buf
^, bsize
);
2802 for f
:= 0 to (bsize
div rec
.mSize
)-1 do
2804 mst
.setup(buf
+f
*rec
.mSize
, rec
.mSize
);
2805 rec
:= rect
.clone(self
);
2806 rec
.mHeaderRec
:= self
;
2807 rec
.parseBinValue(mst
);
2808 rec
.mId
:= Format('%s%d', [rec
.mTypeName
, f
]);
2809 fld
.addListItem(rec
);
2810 //writeln('parsed ''', rec.mId, '''...');
2816 //st.position := st.position+bsize;
2819 for fld
in mFields
do
2821 if (fld
.mType
<> TDynField
.TType
.TList
) then continue
;
2822 for rec
in fld
.mRVal
do linkNames(rec
);
2828 if StrEqu(mTypeName
, 'TriggerData') then mSize
:= Integer(st
.size
-st
.position
);
2829 if (mSize
< 1) then raise TDynRecException
.CreateFmt('cannot read record of type ''%s'' with unknown size', [mTypeName
]);
2831 st
.ReadBuffer(buf
^, mSize
);
2832 for fld
in mFields
do
2834 if fld
.mInternal
then continue
;
2835 if (fld
.mBinOfs
< 0) then continue
;
2836 if (fld
.mBinOfs
>= st
.size
) then raise TDynRecException
.CreateFmt('record of type ''%s'' has invalid field ''%s''', [fld
.mName
]);
2837 mst
.setup(buf
+fld
.mBinOfs
, mSize
-fld
.mBinOfs
);
2838 //writeln('parsing ''', mName, '.', fld.mName, '''...');
2839 fld
.parseBinValue(mst
);
2841 // fix default values
2842 for fld
in mFields
do
2844 if (fld
.mType
= TDynField
.TType
.TList
) then continue
;
2845 fld
.fixDefaultValue();
2849 if (buf
<> nil) then FreeMem(buf
);
2854 procedure TDynRecord
.writeBinTo (var hasLostData
: Boolean; st
: TStream
; trigbufsz
: Integer=-1; onlyFields
: Boolean=false);
2857 rec
, rv
: TDynRecord
;
2860 blk
, blkmax
: Integer;
2864 if (trigbufsz
< 0) then
2866 if (mBinBlock
< 1) then raise TDynRecException
.Create('cannot write binary record without block number');
2867 if (mSize
< 1) then raise TDynRecException
.Create('cannot write binary record without size');
2876 FillChar(buf
^, bufsz
, 0);
2877 ws
:= TSFSMemoryChunkStream
.Create(buf
, bufsz
);
2879 // write normal fields
2880 for fld
in mFields
do
2883 if (fld
.mType
= fld
.TType
.TList
) then continue
; // later
2884 if fld
.mInternal
then continue
;
2885 if (fld
.mBinOfs
< 0) then
2887 if not fld
.equToDefault
then hasLostData
:= true;
2890 if (fld
.mBinOfs
>= bufsz
) then raise TDynRecException
.Create('binary value offset is outside of the buffer');
2891 TSFSMemoryChunkStream(ws
).setup(buf
+fld
.mBinOfs
, bufsz
-fld
.mBinOfs
);
2892 //writeln('writing field <', fld.mName, '>');
2893 fld
.writeBinTo(hasLostData
, ws
);
2896 // write block with normal fields
2897 if mHeader
and not onlyFields
then
2899 //writeln('writing header...');
2900 // signature and version
2901 writeIntBE(st
, LongWord($4D415001));
2902 writeInt(st
, Byte(mBinBlock
)); // type
2903 writeInt(st
, LongWord(0)); // reserved
2904 writeInt(st
, LongWord(bufsz
)); // size
2906 st
.WriteBuffer(buf
^, bufsz
);
2908 ws
.Free(); ws
:= nil;
2909 FreeMem(buf
); buf
:= nil;
2911 // write other blocks, if any
2912 if mHeader
and not onlyFields
then
2916 for fld
in mFields
do
2919 if (fld
.mType
= fld
.TType
.TList
) then
2921 if (fld
.mRVal
= nil) or (fld
.mRVal
.count
= 0) then continue
;
2922 rec
:= mOwner
.recType
[fld
.mName
];
2923 if (rec
= nil) then continue
;
2924 if (rec
.mBinBlock
<= 0) then continue
;
2925 if (blkmax
< rec
.mBinBlock
) then blkmax
:= rec
.mBinBlock
;
2929 for blk
:= 1 to blkmax
do
2931 if (blk
= mBinBlock
) then continue
;
2933 for fld
in mFields
do
2936 if (fld
.mType
= fld
.TType
.TList
) then
2938 if (fld
.mRVal
= nil) or (fld
.mRVal
.count
= 0) then continue
;
2939 rec
:= mOwner
.recType
[fld
.mName
];
2940 if (rec
= nil) then continue
;
2941 if (rec
.mBinBlock
<> blk
) then continue
;
2942 if (ws
= nil) then ws
:= TMemoryStream
.Create();
2943 for rv
in fld
.mRVal
do rv
.writeBinTo(hasLostData
, ws
);
2949 blksz
:= Integer(ws
.position
);
2951 writeInt(st
, Byte(blk
)); // type
2952 writeInt(st
, LongWord(0)); // reserved
2953 writeInt(st
, LongWord(blksz
)); // size
2954 st
.CopyFrom(ws
, blksz
);
2960 writeInt(st
, Byte(0));
2961 writeInt(st
, LongWord(0));
2962 writeInt(st
, LongWord(0));
2966 if (buf
<> nil) then FreeMem(buf
);
2971 procedure TDynRecord
.writeTo (wr
: TTextWriter
; putHeader
: Boolean=true);
2975 putTypeComment
: Boolean;
2981 if (Length(mId
) > 0) then begin wr
.put(' '); wr
.put(mId
); end;
2987 for fld
in mFields
do
2990 if (fld
.mType
= fld
.TType
.TList
) then
2992 if not mHeader
then raise TDynRecException
.Create('record list in non-header record');
2993 if (fld
.mRVal
<> nil) and (fld
.mRVal
.count
> 0) then
2995 putTypeComment
:= true;
2996 for rec
in fld
.mRVal
do
2998 if (rec
= nil) or (Length(rec
.mId
) = 0) then continue
;
2999 if putTypeComment
then
3002 if (80-wr
.curIndent
*2 >= 2) then
3005 for f
:= wr
.curIndent
to 80-wr
.curIndent
do wr
.put('/');
3008 putTypeComment
:= false;
3019 rec
.writeTo(wr
, true);
3024 if fld
.mInternal
then continue
;
3025 if (not fld
.mWriteDef
) and fld
.isDefaultValue
then continue
;
3037 {$IF DEFINED(D2D_DYNREC_PROFILER)}
3039 profCloneRec
: UInt64
= 0;
3040 profFindRecType
: UInt64
= 0;
3041 profFieldSearching
: UInt64
= 0;
3042 profListDupChecking
: UInt64
= 0;
3043 profAddRecByType
: UInt64
= 0;
3044 profFieldValParsing
: UInt64
= 0;
3045 profFixDefaults
: UInt64
= 0;
3046 profRecValParse
: UInt64
= 0;
3048 procedure xdynDumpProfiles ();
3050 writeln('=== XDYNREC PROFILES ===');
3051 writeln('record cloning: ', profCloneRec
div 1000, '.', profCloneRec
mod 1000, ' milliseconds');
3052 writeln('findRecType : ', profFindRecType
div 1000, '.', profFindRecType
mod 1000, ' milliseconds');
3053 writeln('field[] : ', profFieldSearching
div 1000, '.', profFieldSearching
mod 1000, ' milliseconds');
3054 writeln('list dup check: ', profListDupChecking
div 1000, '.', profListDupChecking
mod 1000, ' milliseconds');
3055 writeln('addRecByType : ', profAddRecByType
div 1000, '.', profAddRecByType
mod 1000, ' milliseconds');
3056 writeln('field valparse: ', profFieldValParsing
div 1000, '.', profFieldValParsing
mod 1000, ' milliseconds');
3057 writeln('fix defaults : ', profFixDefaults
div 1000, '.', profFixDefaults
mod 1000, ' milliseconds');
3058 writeln('recvalparse : ', profRecValParse
div 1000, '.', profRecValParse
mod 1000, ' milliseconds');
3063 procedure TDynRecord
.parseValue (pr
: TTextParser
; beginEaten
: Boolean=false);
3066 rec
: TDynRecord
= nil;
3067 trc
{, rv}: TDynRecord
;
3068 {$IF DEFINED(D2D_DYNREC_PROFILER)}
3072 procedure linkNames (rec
: TDynRecord
);
3075 rt
, rvc
: TDynRecord
;
3077 if (rec
= nil) then exit
;
3078 //writeln('*** rec: ', rec.mName, '.', rec.mId, ' (', rec.mFields.count, ')');
3079 for fld
in rec
.mFields
do
3081 if (fld
.mType
= TDynField
.TType
.TList
) then
3083 for rvc
in fld
.mRVal
do linkNames(rvc
);
3085 if (fld
.mType
= TDynField
.TType
.TTrigData
) then
3087 //if (fld.mRecRef <> nil) then linkNames(fld.mRecRef);
3090 if (Length(fld
.mRecRefId
) = 0) then continue
;
3091 assert(fld
.mEBSType
<> nil);
3092 rt
:= findRecordByTypeId(fld
.mEBSTypeName
, fld
.mRecRefId
);
3095 //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);
3096 raise TDynParseException
.CreateFmt(pr
, 'record of type ''%s'' with id ''%s'' links to inexistant record of type ''%s'' with id ''%s''', [rec
.mTypeName
, rec
.mId
, fld
.mEBSTypeName
, fld
.mRecRefId
]);
3098 //writeln(' ', rec.mName, '.', rec.mId, ':', fld.mName, ' -> ', rt.mName, '.', rt.mId, ' (', fld.mEBSTypeName, '.', fld.mRecRefId, ')');
3099 fld
.mRecRefId
:= '';
3101 fld
.mDefined
:= true;
3103 for fld
in rec
.mFields
do
3105 //writeln(' ', fld.mName);
3106 fld
.fixDefaultValue();
3111 if (mOwner
= nil) then raise TDynParseException
.CreateFmt(pr
, 'can''t parse record ''%s'' value without owner', [mTypeName
]);
3113 {$IF DEFINED(D2D_DYNREC_PROFILER)}stall
:= getTimeMicro();{$ENDIF}
3119 if (not beginEaten
) and (pr
.tokType
= pr
.TTId
) then mId
:= pr
.expectId();
3123 assert(mHeaderRec
= self
);
3126 //writeln('parsing record <', mName, '>');
3127 if not beginEaten
then pr
.expectDelim('{');
3128 while (not pr
.isDelim('}')) do
3130 if (pr
.tokType
<> pr
.TTId
) then raise TDynParseException
.Create(pr
, 'identifier expected');
3131 //writeln('<', mName, '.', pr.tokStr, '>');
3136 // add records with this type (if any)
3137 {$IF DEFINED(D2D_DYNREC_PROFILER)}stt
:= getTimeMicro();{$ENDIF}
3138 trc
:= mOwner
.recType
[pr
.tokStr
];
3139 {$IF DEFINED(D2D_DYNREC_PROFILER)}profFindRecType
:= getTimeMicro()-stt
;{$ENDIF}
3140 if (trc
<> nil) then
3142 {$IF DEFINED(D2D_DYNREC_PROFILER)}stt
:= getTimeMicro();{$ENDIF}
3143 rec
:= trc
.clone(mHeaderRec
);
3144 {$IF DEFINED(D2D_DYNREC_PROFILER)}profCloneRec
:= getTimeMicro()-stt
;{$ENDIF}
3145 rec
.mHeaderRec
:= mHeaderRec
;
3146 // on error, it will be freed by memowner
3149 {$IF DEFINED(D2D_DYNREC_PROFILER)}stt
:= getTimeMicro();{$ENDIF}
3150 addRecordByType(rec
.mTypeName
, rec
);
3151 {$IF DEFINED(D2D_DYNREC_PROFILER)}profAddRecByType
:= getTimeMicro()-stt
;{$ENDIF}
3157 {$IF DEFINED(D2D_DYNREC_PROFILER)}stt
:= getTimeMicro();{$ENDIF}
3158 //writeln('0: <', mName, '.', pr.tokStr, '>');
3159 fld
:= field
[pr
.tokStr
];
3160 //writeln('1: <', mName, '.', pr.tokStr, '>');
3161 {$IF DEFINED(D2D_DYNREC_PROFILER)}profFieldSearching
:= getTimeMicro()-stt
;{$ENDIF}
3162 if (fld
<> nil) then
3164 //writeln('2: <', mName, '.', pr.tokStr, '>');
3165 if fld
.defined
then raise TDynParseException
.CreateFmt(pr
, 'duplicate field ''%s'' in record ''%s''', [fld
.mName
, mTypeName
]);
3166 if fld
.internal
then raise TDynParseException
.CreateFmt(pr
, 'internal field ''%s'' in record ''%s''', [fld
.mName
, mTypeName
]);
3167 pr
.skipToken(); // skip field name
3168 //writeln('3: <', mName, '.', pr.tokStr, '>:', pr.tokType);
3169 {$IF DEFINED(D2D_DYNREC_PROFILER)}stt
:= getTimeMicro();{$ENDIF}
3171 {$IF DEFINED(D2D_DYNREC_PROFILER)}profFieldValParsing
:= getTimeMicro()-stt
;{$ENDIF}
3175 // something is wrong
3176 raise TDynParseException
.CreateFmt(pr
, 'unknown field ''%s'' in record ''%s''', [pr
.tokStr
, mTypeName
]);
3178 pr
.expectDelim('}');
3184 for rec
in mRec2Free
do if (rec
<> nil) then linkNames(rec
);
3186 //writeln('done parsing record <', mName, '>');
3187 //{$IF DEFINED(D2D_DYNREC_PROFILER)}writeln('stall: ', getTimeMicro()-stall);{$ENDIF}
3188 {$IF DEFINED(D2D_DYNREC_PROFILER)}profRecValParse
:= getTimeMicro()-stall
;{$ENDIF}
3192 // ////////////////////////////////////////////////////////////////////////// //
3193 constructor TDynEBS
.Create (pr
: TTextParser
);
3200 destructor TDynEBS
.Destroy ();
3207 procedure TDynEBS
.cleanup ();
3220 function TDynEBS
.findByName (const aname
: AnsiString
): Integer;
3223 while (result
< Length(mIds
)) do
3225 if StrEqu(aname
, mIds
[result
]) then exit
;
3232 function TDynEBS
.hasByName (const aname
: AnsiString
): Boolean; inline;
3234 result
:= (findByName(aname
) >= 0);
3238 function TDynEBS
.getFieldByName (const aname
: AnsiString
): Integer; inline;
3242 f
:= findByName(aname
);
3243 if (f
>= 0) then result
:= mVals
[f
] else result
:= 0;
3247 function TDynEBS
.definition (): AnsiString
;
3251 if mIsEnum
then result
:='enum ' else result
:= 'bitset ';
3252 result
+= mTypeName
;
3255 if mIsEnum
then cv
:= 0 else cv
:= 1;
3256 for f
:= 0 to High(mIds
) do
3258 if (mIds
[f
] = mMaxName
) then continue
;
3259 result
+= ' '+mIds
[f
];
3260 if (mVals
[f
] <> cv
) then
3262 result
+= Format(' = %d', [mVals
[f
]]);
3263 if mIsEnum
then cv
:= mVals
[f
];
3268 result
+= Format(', // %d'#10, [mVals
[f
]]);
3270 if mIsEnum
then Inc(cv
) else if (mVals
[f
] = cv
) then cv
:= cv
shl 1;
3273 if (Length(mMaxName
) > 0) then result
+= ' '+mMaxName
+' = MAX,'#10;
3278 function TDynEBS
.pasdef (): AnsiString
;
3282 result
:= '// '+mTypeName
+#10'const'#10;
3284 for f
:= 0 to High(mIds
) do
3286 result
+= formatstrf(' %s = %d;'#10, [mIds
[f
], mVals
[f
]]);
3291 function TDynEBS
.nameByValue (v
: Integer): AnsiString
;
3295 for f
:= 0 to High(mVals
) do
3297 if (mVals
[f
] = v
) then begin result
:= mIds
[f
]; exit
; end;
3303 procedure TDynEBS
.parseDef (pr
: TTextParser
);
3311 if pr
.eatId('enum') then mIsEnum
:= true
3312 else if pr
.eatId('bitset') then mIsEnum
:= false
3313 else pr
.expectId('enum');
3314 mTypeName
:= pr
.expectId();
3315 mMaxVal
:= Integer($80000000);
3316 if mIsEnum
then cv
:= 0 else cv
:= 1;
3317 while (not pr
.isDelim('{')) do
3319 if pr
.eatId('tip') then
3321 if (Length(mTip
) > 0) then raise TDynParseException
.CreateFmt(pr
, 'duplicate tip definition for enum/bitset ''%s''', [mTypeName
]);
3322 mTip
:= pr
.expectStr(false);
3325 if pr
.eatId('help') then
3327 if (Length(mHelp
) > 0) then raise TDynParseException
.CreateFmt(pr
, 'duplicate help definition for enum/bitset ''%s''', [mTypeName
]);
3328 mHelp
:= pr
.expectStr(false);
3333 pr
.expectDelim('{');
3334 while (not pr
.isDelim('}')) do
3336 idname
:= pr
.expectId();
3337 for f
:= 0 to High(mIds
) do
3339 if StrEqu(mIds
[f
], idname
) then raise TDynParseException
.CreateFmt(pr
, 'duplicate field ''%s'' in enum/bitset ''%s''', [idname
, mTypeName
]);
3341 if StrEqu(mMaxName
, idname
) then raise TDynParseException
.CreateFmt(pr
, 'duplicate field ''%s'' in enum/bitset ''%s''', [idname
, mTypeName
]);
3346 if pr
.eatDelim('=') then
3348 if pr
.eatId('MAX') then
3350 if (Length(mMaxName
) > 0) then raise TDynParseException
.CreateFmt(pr
, 'duplicate max field ''%s'' in enum/bitset ''%s''', [idname
, mTypeName
]);
3356 v
:= pr
.expectInt();
3357 if mIsEnum
then cv
:= v
;
3365 if mIsEnum
or (not hasV
) then
3367 if (mMaxVal
< v
) then mMaxVal
:= v
;
3369 SetLength(mIds
, Length(mIds
)+1);
3370 mIds
[High(mIds
)] := idname
;
3371 SetLength(mVals
, Length(mIds
));
3372 mVals
[High(mVals
)] := v
;
3374 if mIsEnum
or (not hasV
) then
3376 if mIsEnum
then Inc(cv
) else cv
:= cv
shl 1;
3379 if (pr
.isDelim('}')) then break
;
3380 pr
.expectDelim(',');
3381 while (pr
.eatDelim(',')) do begin end;
3383 pr
.expectDelim('}');
3385 if (Length(mMaxName
) > 0) then
3387 SetLength(mIds
, Length(mIds
)+1);
3388 mIds
[High(mIds
)] := mMaxName
;
3389 SetLength(mVals
, Length(mIds
));
3390 mVals
[High(mVals
)] := mMaxVal
;
3395 // ////////////////////////////////////////////////////////////////////////// //
3396 constructor TDynMapDef
.Create (pr
: TTextParser
);
3398 recTypes
:= TDynRecList
.Create();
3399 trigTypes
:= TDynRecList
.Create();
3400 ebsTypes
:= TDynEBSList
.Create();
3405 destructor TDynMapDef
.Destroy ();
3410 //!!!FIXME!!! check who owns trigs and recs!
3411 for rec
in recTypes
do rec
.Free();
3412 for rec
in trigTypes
do rec
.Free();
3413 for ebs
in ebsTypes
do ebs
.Free();
3424 function TDynMapDef
.getHeaderRecType (): TDynRecord
; inline;
3426 if (recTypes
.count
= 0) then raise TDynRecException
.Create('no header in empty mapdef');
3427 result
:= recTypes
[0];
3431 function TDynMapDef
.findRecType (const aname
: AnsiString
): TDynRecord
;
3435 for rec
in recTypes
do
3437 if StrEqu(rec
.typeName
, aname
) then begin result
:= rec
; exit
; end;
3443 function TDynMapDef
.findTrigFor (const aname
: AnsiString
): TDynRecord
;
3447 for rec
in trigTypes
do
3449 if (rec
.isForTrig
[aname
]) then begin result
:= rec
; exit
; end;
3455 function TDynMapDef
.findEBSType (const aname
: AnsiString
): TDynEBS
;
3459 for ebs
in ebsTypes
do
3461 if StrEqu(ebs
.typeName
, aname
) then begin result
:= ebs
; exit
; end;
3467 procedure TDynMapDef
.parseDef (pr
: TTextParser
);
3469 rec
, hdr
: TDynRecord
;
3473 // setup header links and type links
3474 procedure linkRecord (rec
: TDynRecord
);
3478 rec
.mHeaderRec
:= recTypes
[0];
3479 for fld
in rec
.mFields
do
3481 if (fld
.mType
= fld
.TType
.TTrigData
) then continue
;
3483 TDynField
.TEBS
.TNone
: begin end;
3484 TDynField
.TEBS
.TRec
:
3486 fld
.mEBSType
:= findRecType(fld
.mEBSTypeName
);
3487 if (fld
.mEBSType
= nil) then raise TDynParseException
.CreateFmt(pr
, 'field ''%s'' of type ''%s'' has no correcponding record definition', [fld
.mName
, fld
.mEBSTypeName
]);
3489 TDynField
.TEBS
.TEnum
,
3490 TDynField
.TEBS
.TBitSet
:
3492 fld
.mEBSType
:= findEBSType(fld
.mEBSTypeName
);
3493 if (fld
.mEBSType
= nil) then raise TDynParseException
.CreateFmt(pr
, 'field ''%s'' of type ''%s'' has no correcponding enum/bitset', [fld
.mName
, fld
.mEBSTypeName
]);
3494 if ((fld
.mEBS
= TDynField
.TEBS
.TEnum
) <> (fld
.mEBSType
as TDynEBS
).mIsEnum
) then raise TDynParseException
.CreateFmt(pr
, 'field ''%s'' of type ''%s'' enum/bitset type conflict', [fld
.mName
, fld
.mEBSTypeName
]);
3500 // setup default values
3501 procedure fixRecordDefaults (rec
: TDynRecord
);
3505 for fld
in rec
.mFields
do if fld
.mHasDefault
then fld
.parseDefaultValue();
3512 if not pr
.skipBlanks() then break
;
3514 if (pr
.tokType
= pr
.TTId
) then
3517 if (pr
.tokStr
= 'enum') or (pr
.tokStr
= 'bitset') then
3519 eb
:= TDynEBS
.Create(pr
);
3520 if (findEBSType(eb
.typeName
) <> nil) then
3523 raise TDynParseException
.CreateFmt(pr
, 'duplicate enum/bitset ''%s''', [eb
.typeName
]);
3526 ebsTypes
.append(eb
);
3527 //writeln(eb.definition); writeln;
3532 if (pr
.tokStr
= 'TriggerData') then
3534 rec
:= TDynRecord
.Create(pr
);
3535 for f
:= 0 to High(rec
.mTrigTypes
) do
3537 if (findTrigFor(rec
.mTrigTypes
[f
]) <> nil) then
3540 raise TDynParseException
.CreateFmt(pr
, 'duplicate trigdata ''%s''', [rec
.mTrigTypes
[f
]]);
3544 trigTypes
.append(rec
);
3545 //writeln(dr.definition); writeln;
3550 rec
:= TDynRecord
.Create(pr
);
3551 //writeln(dr.definition); writeln;
3552 if (findRecType(rec
.typeName
) <> nil) then begin rec
.Free(); raise TDynParseException
.CreateFmt(pr
, 'duplicate record ''%s''', [rec
.typeName
]); end;
3553 if (hdr
<> nil) and StrEqu(rec
.typeName
, hdr
.typeName
) then begin rec
.Free(); raise TDynParseException
.CreateFmt(pr
, 'duplicate record ''%s''', [rec
.typeName
]); end;
3557 if (hdr
<> nil) then begin rec
.Free(); raise TDynParseException
.CreateFmt(pr
, 'duplicate header record ''%s'' (previous is ''%s'')', [rec
.typeName
, hdr
.typeName
]); end;
3562 recTypes
.append(rec
);
3566 // put header record to top
3567 if (hdr
= nil) then raise TDynParseException
.Create(pr
, 'header definition not found in mapdef');
3568 recTypes
.append(nil);
3569 for f
:= recTypes
.count
-1 downto 1 do recTypes
[f
] := recTypes
[f
-1];
3572 // setup header links and type links
3573 for rec
in recTypes
do linkRecord(rec
);
3574 for rec
in trigTypes
do linkRecord(rec
);
3576 // setup default values
3577 for rec
in recTypes
do fixRecordDefaults(rec
);
3578 for rec
in trigTypes
do fixRecordDefaults(rec
);
3582 // ////////////////////////////////////////////////////////////////////////// //
3583 function TDynMapDef
.parseTextMap (pr
: TTextParser
): TDynRecord
;
3585 res
: TDynRecord
= nil;
3589 pr
.expectId(headerType
.typeName
);
3590 res
:= headerType
.clone(nil);
3591 res
.mHeaderRec
:= res
;
3601 function TDynMapDef
.parseBinMap (st
: TStream
): TDynRecord
;
3603 res
: TDynRecord
= nil;
3607 res
:= headerType
.clone(nil);
3608 res
.mHeaderRec
:= res
;
3609 res
.parseBinValue(st
);
3618 // WARNING! stream must be seekable
3619 function TDynMapDef
.parseMap (st
: TStream
; wasBinary
: PBoolean
=nil): TDynRecord
;
3621 sign
: packed array[0..3] of AnsiChar
;
3624 if (wasBinary
<> nil) then wasBinary
^ := false;
3626 st
.ReadBuffer(sign
[0], 4);
3628 if (sign
[0] = 'M') and (sign
[1] = 'A') and (sign
[2] = 'P') then
3630 if (sign
[3] = #1) then
3632 if (wasBinary
<> nil) then wasBinary
^ := true;
3633 result
:= parseBinMap(st
);
3636 raise TDynRecException
.Create('invalid binary map version');
3640 pr
:= TFileTextParser
.Create(st
, false); // `st` is not owned
3643 result
:= parseTextMap(pr
);
3644 except on e
: Exception
do
3645 raise TDynParseException
.Create(pr
, e
.message);
3654 // returns `true` if the given stream can be a map file
3655 // stream position is 0 on return
3656 // WARNING! stream must be seekable
3657 class function TDynMapDef
.canBeMap (st
: TStream
): Boolean;
3659 sign
: packed array[0..3] of AnsiChar
;
3664 st
.ReadBuffer(sign
[0], 4);
3665 if (sign
[0] = 'M') and (sign
[1] = 'A') and (sign
[2] = 'P') then
3667 result
:= (sign
[3] = #1);
3672 pr
:= TFileTextParser
.Create(st
, false); // `st` is not owned
3673 result
:= (pr
.tokType
= pr
.TTId
) and (pr
.tokStr
= 'map');
3680 function TDynMapDef
.pasdefconst (): AnsiString
;
3685 result
+= '// ////////////////////////////////////////////////////////////////////////// //'#10;
3686 result
+= '// enums and bitsets'#10;
3687 for ebs
in ebsTypes
do result
+= #10+ebs
.pasdef();
3691 function TDynMapDef
.getRecTypeCount (): Integer; inline; begin result
:= recTypes
.count
; end;
3692 function TDynMapDef
.getRecTypeAt (idx
: Integer): TDynRecord
; inline; begin if (idx
>= 0) and (idx
< recTypes
.count
) then result
:= recTypes
[idx
] else result
:= nil; end;
3694 function TDynMapDef
.getEBSTypeCount (): Integer; inline; begin result
:= ebsTypes
.count
; end;
3695 function TDynMapDef
.getEBSTypeAt (idx
: Integer): TDynEBS
; inline; begin if (idx
>= 0) and (idx
< ebsTypes
.count
) then result
:= ebsTypes
[idx
] else result
:= nil; end;
3697 function TDynMapDef
.getTrigTypeCount (): Integer; inline; begin result
:= trigTypes
.count
; end;
3698 function TDynMapDef
.getTrigTypeAt (idx
: Integer): TDynRecord
; inline; begin if (idx
>= 0) and (idx
< trigTypes
.count
) then result
:= trigTypes
[idx
] else result
:= nil; end;