DEADSOFTWARE

GIT / REPO / FRED-BOY
Projects / d2df-sdl.git / blob
summary | shortlog | log | commit | commitdiff | tree
history | raw | HEAD
mplat fixes
[d2df-sdl.git] / src / shared / xdynrec.pas
1 (* Copyright (C) DooM 2D:Forever Developers
2 *
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.
7 *
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.
12 *
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/>.
15 *)
16 {$INCLUDE a_modes.inc}
17 {.$DEFINE XDYNREC_USE_FIELDHASH} // actually, it is SLOWER with this
18 unit xdynrec;
19
20 interface
21
22 uses
23 Variants, Classes,
24 xparser, xstreams, utils, hashtable;
25
26
27 // ////////////////////////////////////////////////////////////////////////// //
28 type
29 TDynMapDef = class;
30 TDynRecord = class;
31 TDynField = class;
32 TDynEBS = class;
33
34 TDynFieldList = specialize TSimpleList<TDynField>;
35 TDynRecList = specialize TSimpleList<TDynRecord>;
36 TDynEBSList = specialize TSimpleList<TDynEBS>;
37
38 // this is base type for all scalars (and arrays)
39 TDynField = class
40 public
41 type
42 TType = (TBool, TChar, TByte, TUByte, TShort, TUShort, TInt, TUInt, TString, TPoint, TSize, TList, TTrigData);
43 // TPoint: pair of Integers
44 // TSize: pair of UShorts
45 // TList: actually, array of records
46 // TTrigData: array of mMaxDim bytes, but internally a record (mRecRef)
47 // arrays of chars are pascal shortstrings (with counter in the first byte)
48
49 private
50 type
51 TEBS = (TNone, TRec, TEnum, TBitSet);
52
53 private
54 mOwner: TDynRecord;
55 mPasName: AnsiString;
56 mName: AnsiString;
57 mType: TType;
58 mIVal: Integer; // for all integer types
59 mIVal2: Integer; // for point and size
60 mSVal: AnsiString; // string; for byte and char arrays
61 mRVal: TDynRecList; // for list
62 mRHash: THashStrInt; // id -> index in mRVal
63 mRecRef: TDynRecord; // for TEBS.TRec
64 mMaxDim: Integer; // for byte and char arrays; <0: not an array; 0: impossible value
65 mBinOfs: Integer; // offset in binary; <0 - none
66 mSepPosSize: Boolean; // for points and sizes, use separate fields
67 mAsT: Boolean; // for points and sizes, use separate fields, names starts with `t`
68 mDefined: Boolean;
69 mHasDefault: Boolean;
70 mOmitDef: Boolean;
71 mInternal: Boolean;
72 mNegBool: Boolean;
73 mBitSetUnique: Boolean; // bitset can contain only one value
74 mAsMonsterId: Boolean; // special hack for triggers: monster record number+1 in binary (so 0 means "none")
75 // default value
76 mDefUnparsed: AnsiString;
77 mDefSVal: AnsiString; // default string value
78 mDefIVal, mDefIVal2: Integer; // default integer values
79 mDefRecRef: TDynRecord;
80 mEBS: TEBS; // complex type type
81 mEBSTypeName: AnsiString; // name of enum, bitset or record
82 mEBSType: TObject; // either TDynRecord or TDynEBS; nil means "simple type"; nil for `TTrigData` too
83
84 // for binary parser
85 mRecRefId: AnsiString;
86
87 // for userdata
88 mTagInt: Integer;
89 mTagPtr: Pointer;
90
91 private
92 procedure cleanup ();
93
94 procedure parseDef (pr: TTextParser);
95
96 procedure parseDefaultValue (); // parse `mDefUnparsed` to `mDefSVal`, `mDefIVal`, `mDefIVal2`, `mDefRecRef`
97 procedure fixDefaultValue (); // this will NOT clone `mDefRecRef`
98 function isDefaultValue (): Boolean;
99
100 function getListCount (): Integer; inline;
101 function getListItem (idx: Integer): TDynRecord; inline; overload;
102 function getListItem (const aname: AnsiString): TDynRecord; inline; overload;
103
104 function getRecRefIndex (): Integer;
105
106 procedure setIVal (v: Integer); inline;
107
108 function getVar (): Variant;
109 procedure setVar (val: Variant);
110
111 protected
112 // returns `true` for duplicate record id
113 function addListItem (rec: TDynRecord): Boolean; inline;
114
115 public
116 constructor Create (const aname: AnsiString; atype: TType);
117 constructor Create (pr: TTextParser);
118 constructor Create (const aname: AnsiString; val: Variant);
119 destructor Destroy (); override;
120
121 class function getTypeName (t: TType): AnsiString;
122
123 function definition (): AnsiString;
124 function pasdef (): AnsiString;
125
126 function clone (newOwner: TDynRecord=nil; registerIn: TDynRecord=nil): TDynField;
127
128 procedure parseValue (pr: TTextParser);
129 procedure parseBinValue (st: TStream);
130
131 procedure writeTo (wr: TTextWriter);
132 procedure writeBinTo (st: TStream);
133
134 // won't work for lists
135 function isSimpleEqu (fld: TDynField): Boolean;
136
137 procedure setValue (const s: AnsiString);
138
139 function GetEnumerator (): TDynRecList.TEnumerator; inline;
140
141 public
142 property pasname: AnsiString read mPasName;
143 property name: AnsiString read mName;
144 property baseType: TType read mType;
145 property negbool: Boolean read mNegBool;
146 property defined: Boolean read mDefined;
147 property internal: Boolean read mInternal write mInternal;
148 property hasTPrefix: Boolean read mAsT;
149 property separatePasFields: Boolean read mSepPosSize;
150 property binOfs: Integer read mBinOfs;
151 property ival: Integer read mIVal write setIVal;
152 property ival2: Integer read mIVal2;
153 property sval: AnsiString read mSVal;
154 property hasDefault: Boolean read mHasDefault;
155 property defsval: AnsiString read mDefSVal;
156 property ebs: TEBS read mEBS;
157 property ebstype: TObject read mEBSType;
158 property ebstypename: AnsiString read mEBSTypeName; // enum/bitset name
159 property recref: TDynRecord read mRecRef;
160 property recrefIndex: Integer read getRecRefIndex; // search for this record in header; -1: not found
161 // for lists
162 property count: Integer read getListCount;
163 property item[idx: Integer]: TDynRecord read getListItem;
164 property items[const aname: AnsiString]: TDynRecord read getListItem; default; // alas, FPC 3+ lost property overloading feature
165 // userdata
166 property tagInt: Integer read mTagInt write mTagInt;
167 property tagPtr: Pointer read mTagPtr write mTagPtr;
168 //
169 property varvalue: Variant read getVar write setVar;
170 end;
171
172
173 // "value" header record contains TList fields, with name equal to record type
174 TDynRecord = class
175 private
176 mOwner: TDynMapDef;
177 mId: AnsiString;
178 mPasName: AnsiString;
179 mName: AnsiString;
180 mSize: Integer;
181 mFields: TDynFieldList;
182 {$IF DEFINED(XDYNREC_USE_FIELDHASH)}
183 mFieldsHash: THashStrInt; // id -> index in mRVal
184 {$ENDIF}
185 mTrigTypes: array of AnsiString; // if this is triggerdata, we'll hold list of triggers here
186 mHeader: Boolean; // true for header record
187 mBinBlock: Integer; // -1: none
188 mHeaderRec: TDynRecord; // for "value" records this is header record with data, for "type" records this is header type record
189
190 // for userdata
191 mTagInt: Integer;
192 mTagPtr: Pointer;
193
194 mRec2Free: TDynRecList;
195
196 private
197 procedure parseDef (pr: TTextParser); // parse definition
198
199 function findByName (const aname: AnsiString): Integer; inline;
200 function hasByName (const aname: AnsiString): Boolean; inline;
201 function getFieldByName (const aname: AnsiString): TDynField; inline;
202 function getFieldAt (idx: Integer): TDynField; inline;
203 function getCount (): Integer; inline;
204
205 function getIsTrigData (): Boolean; inline;
206 function getIsForTrig (const aname: AnsiString): Boolean; inline;
207
208 function getForTrigCount (): Integer; inline;
209 function getForTrigAt (idx: Integer): AnsiString; inline;
210
211 procedure regrec (rec: TDynRecord);
212
213 protected
214 function findRecordByTypeId (const atypename, aid: AnsiString): TDynRecord;
215 function findRecordNumByType (const atypename: AnsiString; rc: TDynRecord): Integer;
216 function addRecordByType (const atypename: AnsiString; rc: TDynRecord): Boolean; // `true`: duplicate record id
217
218 procedure addField (fld: TDynField); inline;
219 function addFieldChecked (fld: TDynField): Boolean; inline; // `true`: duplicate name
220
221 public
222 constructor Create ();
223 constructor Create (pr: TTextParser); // parse definition
224 destructor Destroy (); override;
225
226 function definition (): AnsiString;
227 function pasdef (): AnsiString;
228
229 function clone (registerIn: TDynRecord): TDynRecord;
230
231 function isSimpleEqu (rec: TDynRecord): Boolean;
232
233 procedure parseValue (pr: TTextParser; beginEaten: Boolean=false);
234 procedure parseBinValue (st: TStream; forceData: Boolean=false);
235
236 procedure writeTo (wr: TTextWriter; putHeader: Boolean=true);
237 procedure writeBinTo (st: TStream; trigbufsz: Integer=-1; onlyFields: Boolean=false);
238
239 // find field with `TriggerType` type
240 function trigTypeField (): TDynField;
241
242 // number of records of the given instance
243 function instanceCount (const typename: AnsiString): Integer;
244
245 //procedure setUserField (const fldname: AnsiString; v: LongInt);
246 //procedure setUserField (const fldname: AnsiString; v: AnsiString);
247 //procedure setUserField (const fldname: AnsiString; v: Boolean);
248
249 function getUserVar (const aname: AnsiString): Variant;
250 procedure setUserVar (const aname: AnsiString; val: Variant);
251
252 public
253 property id: AnsiString read mId; // for map parser
254 property pasname: AnsiString read mPasName;
255 property name: AnsiString read mName; // record name
256 property size: Integer read mSize; // size in bytes
257 //property fields: TDynFieldList read mFields;
258 property has[const aname: AnsiString]: Boolean read hasByName;
259 property count: Integer read getCount;
260 property field[const aname: AnsiString]: TDynField read getFieldByName; default;
261 property fieldAt[idx: Integer]: TDynField read getFieldAt;
262 property isTrigData: Boolean read getIsTrigData;
263 property isForTrig[const aname: AnsiString]: Boolean read getIsForTrig;
264 property forTrigCount: Integer read getForTrigCount;
265 property forTrigAt[idx: Integer]: AnsiString read getForTrigAt;
266 property headerRec: TDynRecord read mHeaderRec;
267 property isHeader: Boolean read mHeader;
268 // userdata
269 property tagInt: Integer read mTagInt write mTagInt;
270 property tagPtr: Pointer read mTagPtr write mTagPtr;
271 // userfields
272 property user[const aname: AnsiString]: Variant read getUserVar write setUserVar;
273 end;
274
275 TDynEBS = class
276 private
277 mOwner: TDynMapDef;
278 mIsEnum: Boolean;
279 mName: AnsiString;
280 mIds: array of AnsiString;
281 mVals: array of Integer;
282 mMaxName: AnsiString; // MAX field
283 mMaxVal: Integer; // max value
284
285 private
286 procedure cleanup ();
287
288 procedure parseDef (pr: TTextParser); // parse definition
289
290 function findByName (const aname: AnsiString): Integer; inline;
291 function hasByName (const aname: AnsiString): Boolean; inline;
292 function getFieldByName (const aname: AnsiString): Integer; inline;
293
294 public
295 constructor Create (pr: TTextParser); // parse definition
296 destructor Destroy (); override;
297
298 function definition (): AnsiString;
299 function pasdef (): AnsiString;
300
301 // return empty string if not found
302 function nameByValue (v: Integer): AnsiString;
303
304 public
305 property name: AnsiString read mName; // record name
306 property isEnum: Boolean read mIsEnum;
307 property has[const aname: AnsiString]: Boolean read hasByName;
308 property field[const aname: AnsiString]: Integer read getFieldByName;
309 end;
310
311
312 TDynMapDef = class
313 public
314 recTypes: TDynRecList; // [0] is always header
315 trigTypes: TDynRecList; // trigdata
316 ebsTypes: TDynEBSList; // enums, bitsets
317
318 private
319 procedure parseDef (pr: TTextParser);
320
321 function getHeaderRecType (): TDynRecord; inline;
322
323 function getTrigTypeCount (): Integer; inline;
324 function getTrigTypeAt (idx: Integer): TDynRecord; inline;
325
326 public
327 constructor Create (pr: TTextParser); // parses data definition
328 destructor Destroy (); override;
329
330 function findRecType (const aname: AnsiString): TDynRecord;
331 function findTrigFor (const aname: AnsiString): TDynRecord;
332 function findEBSType (const aname: AnsiString): TDynEBS;
333
334 function pasdef (): AnsiString;
335 function pasdefconst (): AnsiString;
336
337 // creates new header record
338 function parseMap (pr: TTextParser): TDynRecord;
339
340 // creates new header record
341 function parseBinMap (st: TStream): TDynRecord;
342
343 public
344 property headerType: TDynRecord read getHeaderRecType;
345 property trigTypeCount: Integer read getTrigTypeCount;
346 property trigType[idx: Integer]: TDynRecord read getTrigTypeAt;
347 end;
348
349
350 {$IF DEFINED(D2D_DYNREC_PROFILER)}
351 procedure xdynDumpProfiles ();
352 {$ENDIF}
353
354
355 implementation
356
357 uses
358 SysUtils, e_log
359 {$IF DEFINED(D2D_DYNREC_PROFILER)},xprofiler{$ENDIF};
360
361
362 // ////////////////////////////////////////////////////////////////////////// //
363 function StrEqu (const a, b: AnsiString): Boolean; inline; begin result := (a = b); end;
364
365
366 // ////////////////////////////////////////////////////////////////////////// //
367 function TDynField.GetEnumerator (): TDynRecList.TEnumerator; inline;
368 begin
369 //result := TListEnumerator.Create(mRVal);
370 if (mRVal <> nil) then result := mRVal.GetEnumerator else result := TDynRecList.TEnumerator.Create(nil, 0);
371 end;
372
373
374 // ////////////////////////////////////////////////////////////////////////// //
375 constructor TDynField.Create (const aname: AnsiString; atype: TType);
376 begin
377 mRVal := nil;
378 mRecRef := nil;
379 mRHash := nil;
380 cleanup();
381 mName := aname;
382 mType := atype;
383 if (mType = TType.TList) then
384 begin
385 mRVal := TDynRecList.Create();
386 mRHash := hashNewStrInt();
387 end;
388 end;
389
390
391 constructor TDynField.Create (pr: TTextParser);
392 begin
393 cleanup();
394 parseDef(pr);
395 end;
396
397
398 constructor TDynField.Create (const aname: AnsiString; val: Variant);
399 procedure setInt32 (v: LongInt);
400 begin
401 case mType of
402 TType.TBool:
403 if (v = 0) then mIVal := 0
404 else if (v = 1) then mIVal := 1
405 else raise Exception.Create('cannot convert shortint variant to field value');
406 TType.TByte:
407 if (v >= -128) and (v <= 127) then mIVal := v
408 else raise Exception.Create('cannot convert shortint variant to field value');
409 TType.TUByte:
410 if (v >= 0) and (v <= 255) then mIVal := v
411 else raise Exception.Create('cannot convert shortint variant to field value');
412 TType.TShort:
413 if (v >= -32768) and (v <= 32767) then mIVal := v
414 else raise Exception.Create('cannot convert shortint variant to field value');
415 TType.TUShort:
416 if (v >= 0) and (v <= 65535) then mIVal := v
417 else raise Exception.Create('cannot convert shortint variant to field value');
418 TType.TInt:
419 mIVal := v;
420 TType.TUInt:
421 mIVal := v;
422 TType.TString:
423 mSVal := formatstrf('%s', [v]);
424 else
425 raise Exception.Create('cannot convert integral variant to field value');
426 end;
427 end;
428 begin
429 mRVal := nil;
430 mRecRef := nil;
431 mRHash := nil;
432 cleanup();
433 mName := aname;
434 case varType(val) of
435 varEmpty: raise Exception.Create('cannot convert empty variant to field value');
436 varNull: raise Exception.Create('cannot convert null variant to field value');
437 varSingle: raise Exception.Create('cannot convert single variant to field value');
438 varDouble: raise Exception.Create('cannot convert double variant to field value');
439 varDecimal: raise Exception.Create('cannot convert decimal variant to field value');
440 varCurrency: raise Exception.Create('cannot convert currency variant to field value');
441 varDate: raise Exception.Create('cannot convert date variant to field value');
442 varOleStr: raise Exception.Create('cannot convert olestr variant to field value');
443 varStrArg: raise Exception.Create('cannot convert stdarg variant to field value');
444 varString: mType := TType.TString;
445 varDispatch: raise Exception.Create('cannot convert dispatch variant to field value');
446 varBoolean: mType := TType.TBool;
447 varVariant: raise Exception.Create('cannot convert variant variant to field value');
448 varUnknown: raise Exception.Create('cannot convert unknown variant to field value');
449 varByte: mType := TType.TUByte;
450 varWord: mType := TType.TUShort;
451 varShortInt: mType := TType.TByte;
452 varSmallint: mType := TType.TShort;
453 varInteger: mType := TType.TInt;
454 varInt64: raise Exception.Create('cannot convert int64 variant to field value');
455 varLongWord: raise Exception.Create('cannot convert longword variant to field value');
456 varQWord: raise Exception.Create('cannot convert uint64 variant to field value');
457 varError: raise Exception.Create('cannot convert error variant to field value');
458 else raise Exception.Create('cannot convert undetermined variant to field value');
459 end;
460 varvalue := val;
461 end;
462
463
464 destructor TDynField.Destroy ();
465 begin
466 cleanup();
467 inherited;
468 end;
469
470
471 procedure TDynField.cleanup ();
472 begin
473 mName := '';
474 mType := TType.TInt;
475 mIVal := 0;
476 mIVal2 := 0;
477 mSVal := '';
478 mRVal.Free();
479 mRVal := nil;
480 mRHash.Free();
481 mRHash := nil;
482 mRecRef := nil;
483 mMaxDim := -1;
484 mBinOfs := -1;
485 mSepPosSize := false;
486 mAsT := false;
487 mHasDefault := false;
488 mDefined := false;
489 mOmitDef := false;
490 mInternal := true;
491 mDefUnparsed := '';
492 mDefSVal := '';
493 mDefIVal := 0;
494 mDefIVal2 := 0;
495 mDefRecRef := nil;
496 mEBS := TEBS.TNone;
497 mEBSTypeName := '';
498 mEBSType := nil;
499 mBitSetUnique := false;
500 mAsMonsterId := false;
501 mNegBool := false;
502 mRecRefId := '';
503 mTagInt := 0;
504 mTagPtr := nil;
505 end;
506
507
508 function TDynField.clone (newOwner: TDynRecord=nil; registerIn: TDynRecord=nil): TDynField;
509 var
510 rec: TDynRecord;
511 begin
512 result := TDynField.Create(mName, mType);
513 result.mOwner := mOwner;
514 if (newOwner <> nil) then result.mOwner := newOwner else result.mOwner := mOwner;
515 result.mPasName := mPasName;
516 result.mName := mName;
517 result.mType := mType;
518 result.mIVal := mIVal;
519 result.mIVal2 := mIVal2;
520 result.mSVal := mSVal;
521 if (mRVal <> nil) then
522 begin
523 if (result.mRVal = nil) then result.mRVal := TDynRecList.Create(mRVal.count);
524 if (result.mRHash = nil) then result.mRHash := hashNewStrInt();
525 for rec in mRVal do result.addListItem(rec.clone(registerIn));
526 end;
527 result.mRecRef := mRecRef;
528 result.mMaxDim := mMaxDim;
529 result.mBinOfs := mBinOfs;
530 result.mSepPosSize := mSepPosSize;
531 result.mAsT := mAsT;
532 result.mDefined := mDefined;
533 result.mHasDefault := mHasDefault;
534 result.mOmitDef := mOmitDef;
535 result.mInternal := mInternal;
536 result.mNegBool := mNegBool;
537 result.mBitSetUnique := mBitSetUnique;
538 result.mAsMonsterId := mAsMonsterId;
539 result.mDefUnparsed := mDefUnparsed;
540 result.mDefSVal := mDefSVal;
541 result.mDefIVal := mDefIVal;
542 result.mDefIVal2 := mDefIVal2;
543 result.mDefRecRef := mDefRecRef;
544 result.mEBS := mEBS;
545 result.mEBSTypeName := mEBSTypeName;
546 result.mEBSType := mEBSType;
547 result.mRecRefId := mRecRefId;
548 result.mTagInt := mTagInt;
549 result.mTagPtr := mTagPtr;
550 end;
551
552
553 procedure TDynField.setIVal (v: Integer); inline;
554 begin
555 //FIXME: check type
556 mIVal := v;
557 mDefined := true;
558 end;
559
560
561 function TDynField.getVar (): Variant;
562 begin
563 if (mEBS = TEBS.TRec) then begin result := LongInt(getRecRefIndex); exit; end;
564 case mType of
565 TType.TBool: result := (mIVal <> 0);
566 TType.TChar: result := mSVal;
567 TType.TByte: result := ShortInt(mIVal);
568 TType.TUByte: result := Byte(mIVal);
569 TType.TShort: result := SmallInt(mIVal);
570 TType.TUShort: result := Word(mIVal);
571 TType.TInt: result := LongInt(mIVal);
572 TType.TUInt: result := LongWord(mIVal);
573 TType.TString: result := mSVal;
574 TType.TPoint: raise Exception.Create('cannot convert point field to variant');
575 TType.TSize: raise Exception.Create('cannot convert size field to variant');
576 TType.TList: raise Exception.Create('cannot convert list field to variant');
577 TType.TTrigData: raise Exception.Create('cannot convert trigdata field to variant');
578 else result := Unassigned; raise Exception.Create('ketmar forgot to handle some field type');
579 end;
580 end;
581
582
583 procedure TDynField.setVar (val: Variant);
584 procedure setInt32 (v: LongInt);
585 begin
586 case mType of
587 TType.TBool:
588 if (v = 0) then mIVal := 0
589 else if (v = 1) then mIVal := 1
590 else raise Exception.Create('cannot convert shortint variant to field value');
591 TType.TByte:
592 if (v >= -128) and (v <= 127) then mIVal := v
593 else raise Exception.Create('cannot convert shortint variant to field value');
594 TType.TUByte:
595 if (v >= 0) and (v <= 255) then mIVal := v
596 else raise Exception.Create('cannot convert shortint variant to field value');
597 TType.TShort:
598 if (v >= -32768) and (v <= 32767) then mIVal := v
599 else raise Exception.Create('cannot convert shortint variant to field value');
600 TType.TUShort:
601 if (v >= 0) and (v <= 65535) then mIVal := v
602 else raise Exception.Create('cannot convert shortint variant to field value');
603 TType.TInt:
604 mIVal := v;
605 TType.TUInt:
606 mIVal := v;
607 TType.TString:
608 mSVal := formatstrf('%s', [v]);
609 else
610 raise Exception.Create('cannot convert integral variant to field value');
611 end;
612 end;
613 begin
614 case varType(val) of
615 varEmpty: raise Exception.Create('cannot convert empty variant to field value');
616 varNull: raise Exception.Create('cannot convert null variant to field value');
617 varSingle: raise Exception.Create('cannot convert single variant to field value');
618 varDouble: raise Exception.Create('cannot convert double variant to field value');
619 varDecimal: raise Exception.Create('cannot convert decimal variant to field value');
620 varCurrency: raise Exception.Create('cannot convert currency variant to field value');
621 varDate: raise Exception.Create('cannot convert date variant to field value');
622 varOleStr: raise Exception.Create('cannot convert olestr variant to field value');
623 varStrArg: raise Exception.Create('cannot convert stdarg variant to field value');
624 varString:
625 if (mType = TType.TChar) or (mType = TType.TString) then
626 begin
627 mSVal := val;
628 end
629 else
630 begin
631 raise Exception.Create('cannot convert string variant to field value');
632 end;
633 varDispatch: raise Exception.Create('cannot convert dispatch variant to field value');
634 varBoolean:
635 case mType of
636 TType.TBool,
637 TType.TByte,
638 TType.TUByte,
639 TType.TShort,
640 TType.TUShort,
641 TType.TInt,
642 TType.TUInt:
643 if val then mIVal := 1 else mIVal := 0;
644 TType.TString:
645 if val then mSVal := 'true' else mSVal := 'false';
646 else
647 raise Exception.Create('cannot convert boolean variant to field value');
648 end;
649 varVariant: raise Exception.Create('cannot convert variant variant to field value');
650 varUnknown: raise Exception.Create('cannot convert unknown variant to field value');
651 varByte,
652 varWord,
653 varShortInt,
654 varSmallint,
655 varInteger:
656 setInt32(val);
657 varInt64:
658 if (val < Int64(LongInt($80000000))) or (val > LongInt($7FFFFFFF)) then
659 raise Exception.Create('cannot convert boolean variant to field value')
660 else
661 mIVal := LongInt(val);
662 varLongWord:
663 if (val > LongWord($7FFFFFFF)) then raise Exception.Create('cannot convert longword variant to field value')
664 else setInt32(Integer(val));
665 varQWord: raise Exception.Create('cannot convert uint64 variant to field value');
666 varError: raise Exception.Create('cannot convert error variant to field value');
667 else raise Exception.Create('cannot convert undetermined variant to field value');
668 end;
669 mDefined := true;
670 end;
671
672
673 // won't work for lists
674 function TDynField.isSimpleEqu (fld: TDynField): Boolean;
675 begin
676 if (fld = nil) or (mType <> fld.mType) then begin result := false; exit; end;
677 case mType of
678 TType.TBool: result := ((mIVal <> 0) = (fld.mIVal <> 0));
679 TType.TChar: result := (mSVal = fld.mSVal);
680 TType.TByte,
681 TType.TUByte,
682 TType.TShort,
683 TType.TUShort,
684 TType.TInt,
685 TType.TUInt:
686 result := (mIVal = fld.mIVal);
687 TType.TString: result := (mSVal = fld.mSVal);
688 TType.TPoint,
689 TType.TSize:
690 result := ((mIVal = fld.mIVal) and (mIVal2 = fld.mIVal2));
691 TType.TList: result := false;
692 TType.TTrigData:
693 begin
694 if (mRecRef = nil) then begin result := (fld.mRecRef = nil); exit; end;
695 result := mRecRef.isSimpleEqu(fld.mRecRef);
696 end;
697 else raise Exception.Create('ketmar forgot to handle some field type');
698 end;
699 end;
700
701
702 procedure TDynField.setValue (const s: AnsiString);
703 var
704 stp: TTextParser;
705 begin
706 stp := TStrTextParser.Create(s+';');
707 try
708 parseValue(stp);
709 finally
710 stp.Free();
711 end;
712 end;
713
714
715 procedure TDynField.parseDefaultValue ();
716 var
717 stp: TTextParser = nil;
718 oSVal: AnsiString;
719 oIVal, oIVal2: Integer;
720 oRRef: TDynRecord;
721 oDef: Boolean;
722 begin
723 if not mHasDefault then
724 begin
725 mDefSVal := '';
726 mDefIVal := 0;
727 mDefIVal2 := 0;
728 mDefRecRef := nil;
729 end
730 else
731 begin
732 oSVal := mSVal;
733 oIVal := mIVal;
734 oIVal2 := mIVal2;
735 oRRef := mRecRef;
736 oDef := mDefined;
737 try
738 stp := TStrTextParser.Create(mDefUnparsed+';');
739 parseValue(stp);
740 mDefSVal := mSVal;
741 mDefIVal := mIVal;
742 mDefIVal2 := mIVal2;
743 mDefRecRef := mRecRef;
744 finally
745 mSVal := oSVal;
746 mIVal := oIVal;
747 mIVal2 := oIVal2;
748 mRecRef := oRRef;
749 mDefined := oDef;
750 stp.Free();
751 end;
752 end;
753 end;
754
755
756 // default value should be parsed
757 procedure TDynField.fixDefaultValue ();
758 begin
759 if mDefined then exit;
760 if not mHasDefault then
761 begin
762 if mInternal then exit;
763 raise Exception.Create(Format('field ''%s'' in record ''%s'' of record type ''%s'' is not set', [mName, mOwner.mId, mOwner.mName]));
764 end;
765 if (mEBS = TEBS.TRec) then mRecRef := mDefRecRef;
766 mSVal := mDefSVal;
767 mIVal := mDefIVal;
768 mIVal2 := mDefIVal2;
769 mDefined := true;
770 end;
771
772
773 // default value should be parsed
774 function TDynField.isDefaultValue (): Boolean;
775 begin
776 if not mHasDefault then begin result := false; exit; end;
777 if (mEBS = TEBS.TRec) then begin result := (mRecRef = mDefRecRef); exit; end;
778 case mType of
779 TType.TChar, TType.TString: result := (mSVal = mDefSVal);
780 TType.TPoint, TType.TSize: result := (mIVal = mDefIVal2) and (mIVal2 = mDefIVal2);
781 TType.TList, TType.TTrigData: result := false; // no default values for those types
782 else result := (mIVal = mDefIVal);
783 end;
784 end;
785
786
787 function TDynField.getListCount (): Integer; inline;
788 begin
789 if (mRVal <> nil) then result := mRVal.count else result := 0;
790 end;
791
792
793 function TDynField.getListItem (idx: Integer): TDynRecord; inline; overload;
794 begin
795 if (mRVal <> nil) and (idx >= 0) and (idx < mRVal.count) then result := mRVal[idx] else result := nil;
796 end;
797
798
799 function TDynField.getListItem (const aname: AnsiString): TDynRecord; inline; overload;
800 var
801 idx: Integer;
802 begin
803 if (mRVal <> nil) and mRHash.get(aname, idx) then result := mRVal[idx] else result := nil;
804 end;
805
806
807 function TDynField.addListItem (rec: TDynRecord): Boolean; inline;
808 begin
809 result := false;
810 if (mRVal <> nil) then
811 begin
812 mRVal.append(rec);
813 if (Length(rec.mId) > 0) then result := mRHash.put(rec.mId, mRVal.count-1);
814 end;
815 end;
816
817
818 class function TDynField.getTypeName (t: TType): AnsiString;
819 begin
820 case t of
821 TType.TBool: result := 'bool';
822 TType.TChar: result := 'char';
823 TType.TByte: result := 'byte';
824 TType.TUByte: result := 'ubyte';
825 TType.TShort: result := 'short';
826 TType.TUShort: result := 'ushort';
827 TType.TInt: result := 'int';
828 TType.TUInt: result := 'uint';
829 TType.TString: result := 'string';
830 TType.TPoint: result := 'point';
831 TType.TSize: result := 'size';
832 TType.TList: result := 'array';
833 TType.TTrigData: result := 'trigdata';
834 else raise Exception.Create('ketmar forgot to handle some field type');
835 end;
836 end;
837
838
839 function TDynField.definition (): AnsiString;
840 begin
841 result := mPasName+' is '+quoteStr(mName)+' type ';
842 result += getTypeName(mType);
843 if (mMaxDim >= 0) then result += Format('[%d]', [mMaxDim]);
844 if (mBinOfs >= 0) then result += Format(' offset %d', [mBinOfs]);
845 case mEBS of
846 TEBS.TNone: begin end;
847 TEBS.TRec: result += ' '+mEBSTypeName;
848 TEBS.TEnum: result += ' enum '+mEBSTypeName;
849 TEBS.TBitSet: begin result += ' bitset '; if mBitSetUnique then result += 'unique '; result += mEBSTypeName; end;
850 end;
851 if mAsMonsterId then result += ' as monsterid';
852 if mHasDefault and (Length(mDefUnparsed) > 0) then result += ' default '+mDefUnparsed;
853 if mSepPosSize then
854 begin
855 if (mType = TType.TPoint) then begin if (mAsT) then result += ' as txy' else result += ' as xy'; end
856 else if (mType = TType.TSize) then begin if (mAsT) then result += ' as twh' else result += ' as wh'; end;
857 end;
858 if mOmitDef then result += ' omitdefault';
859 if mInternal then result += ' internal';
860 end;
861
862
863 function TDynField.pasdef (): AnsiString;
864 begin
865 result := mPasName+': ';
866 case mType of
867 TType.TBool: result += 'Boolean;';
868 TType.TChar: if (mMaxDim > 0) then result += formatstrf('Char%d;', [mMaxDim]) else result += 'Char;';
869 TType.TByte: result += 'ShortInt;';
870 TType.TUByte: result += 'Byte;';
871 TType.TShort: result += 'SmallInt;';
872 TType.TUShort: result += 'Word;';
873 TType.TInt: result += 'LongInt;';
874 TType.TUInt: result += 'LongWord;';
875 TType.TString: result += 'AnsiString;';
876 TType.TPoint:
877 if mAsT then result := 'tX, tY: Integer;'
878 else if mSepPosSize then result := 'X, Y: Integer;'
879 else result += 'TDFPoint;';
880 TType.TSize:
881 if mAsT then result := 'tWidth, tHeight: Word;'
882 else if mSepPosSize then result := 'Width, Height: Word;'
883 else result += 'TSize;';
884 TType.TList: assert(false);
885 TType.TTrigData: result += formatstrf('Byte%d;', [mMaxDim]);
886 else raise Exception.Create('ketmar forgot to handle some field type');
887 end;
888 end;
889
890
891 procedure TDynField.parseDef (pr: TTextParser);
892 var
893 fldname: AnsiString;
894 fldtype: AnsiString;
895 fldofs: Integer;
896 fldrecname: AnsiString;
897 fldpasname: AnsiString;
898 asxy, aswh, ast: Boolean;
899 ainternal: Boolean;
900 omitdef: Boolean;
901 defstr: AnsiString;
902 defint, defint2: Integer;
903 hasdefStr: Boolean;
904 hasdefInt: Boolean;
905 hasdefId: Boolean;
906 lmaxdim: Integer;
907 lebs: TDynField.TEBS;
908 unique: Boolean;
909 asmonid: Boolean;
910 defech: AnsiChar;
911 begin
912 fldpasname := '';
913 fldname := '';
914 fldtype := '';
915 fldofs := -1;
916 fldrecname := '';
917 asxy := false;
918 aswh := false;
919 ast := false;
920 ainternal := false;
921 omitdef := false;
922 defstr := '';
923 defint := 0;
924 defint2 := 0;
925 hasdefStr := false;
926 hasdefInt := false;
927 hasdefId := false;
928 unique := false;
929 asmonid := false;
930 lmaxdim := -1;
931 lebs := TDynField.TEBS.TNone;
932
933 fldpasname := pr.expectId(); // pascal field name
934 // field name
935 pr.expectId('is');
936 fldname := pr.expectStr();
937 // field type
938 pr.expectId('type');
939 fldtype := pr.expectId();
940
941 // fixed-size array?
942 if pr.eatDelim('[') then
943 begin
944 lmaxdim := pr.expectInt();
945 if (lmaxdim < 1) then raise Exception.Create(Format('invalid field ''%s'' array size', [fldname]));
946 pr.expectDelim(']');
947 end;
948
949 while (pr.tokType <> pr.TTSemi) do
950 begin
951 if pr.eatId('offset') then
952 begin
953 if (fldofs >= 0) then raise Exception.Create(Format('duplicate field ''%s'' offset', [fldname]));
954 fldofs := pr.expectInt();
955 if (fldofs < 0) then raise Exception.Create(Format('invalid field ''%s'' offset', [fldname]));
956 continue;
957 end;
958
959 if pr.eatId('as') then
960 begin
961 if pr.eatId('xy') then asxy := true
962 else if pr.eatId('wh') then aswh := true
963 else if pr.eatId('txy') then begin asxy := true; ast := true; end
964 else if pr.eatId('twh') then begin aswh := true; ast := true; end
965 else if pr.eatId('monsterid') then begin asmonid := true; end
966 else raise Exception.Create(Format('invalid field ''%s'' as what?', [fldname]));
967 continue;
968 end;
969
970 if pr.eatId('enum') then
971 begin
972 lebs := TDynField.TEBS.TEnum;
973 if (Length(fldrecname) <> 0) then raise Exception.Create(Format('field ''%s'' already typed as ''%s''', [fldname, fldrecname]));
974 fldrecname := pr.expectId();
975 continue;
976 end;
977
978 if pr.eatId('bitset') then
979 begin
980 lebs := TDynField.TEBS.TBitSet;
981 if (Length(fldrecname) <> 0) then raise Exception.Create(Format('field ''%s'' already typed as ''%s''', [fldname, fldrecname]));
982 unique := pr.eatId('unique');
983 fldrecname := pr.expectId();
984 continue;
985 end;
986
987 if pr.eatId('default') then
988 begin
989 if hasdefStr or hasdefInt or hasdefId then raise Exception.Create(Format('field ''%s'' has duplicate default', [fldname]));
990 case pr.tokType of
991 pr.TTStr:
992 begin
993 hasdefStr := true;
994 defstr := pr.expectStr(true); // allow empty strings
995 end;
996 pr.TTId:
997 begin
998 hasdefId := true;
999 defstr := pr.expectId();
1000 end;
1001 pr.TTInt:
1002 begin
1003 hasdefInt := true;
1004 defint := pr.expectInt();
1005 end;
1006 pr.TTDelim:
1007 begin
1008 hasdefInt := true;
1009 if pr.eatDelim('[') then defech := ']' else begin pr.expectDelim('('); defech := ')'; end;
1010 defint := pr.expectInt();
1011 defint2 := pr.expectInt();
1012 pr.expectDelim(defech);
1013 end;
1014 else
1015 raise Exception.Create(Format('field ''%s'' has invalid default', [fldname]));
1016 end;
1017 continue;
1018 end;
1019
1020 if pr.eatId('omitdefault') then
1021 begin
1022 omitdef := true;
1023 continue;
1024 end;
1025
1026 if pr.eatId('internal') then
1027 begin
1028 ainternal := true;
1029 continue;
1030 end;
1031
1032 if (pr.tokType <> pr.TTId) then raise Exception.Create(Format('field ''%s'' has something unexpected in definition', [fldname]));
1033
1034 if (Length(fldrecname) <> 0) then raise Exception.Create(Format('field ''%s'' already typed as ''%s''', [fldname, fldrecname]));
1035 fldrecname := pr.expectId();
1036 lebs := TDynField.TEBS.TRec;
1037 end;
1038
1039 pr.expectTT(pr.TTSemi);
1040
1041 // create field
1042 mName := fldname;
1043 if (fldtype = 'bool') then mType := TType.TBool
1044 else if (fldtype = 'negbool') then begin mType := TType.TBool; mNegBool := true; end
1045 else if (fldtype = 'char') then mType := TType.TChar
1046 else if (fldtype = 'byte') then mType := TType.TByte
1047 else if (fldtype = 'ubyte') then mType := TType.TUByte
1048 else if (fldtype = 'short') then mType := TType.TShort
1049 else if (fldtype = 'ushort') then mType := TType.TUShort
1050 else if (fldtype = 'int') then mType := TType.TInt
1051 else if (fldtype = 'uint') then mType := TType.TUInt
1052 else if (fldtype = 'string') then mType := TType.TString
1053 else if (fldtype = 'point') then mType := TType.TPoint
1054 else if (fldtype = 'size') then mType := TType.TSize
1055 else if (fldtype = 'trigdata') then mType := TType.TTrigData
1056 else raise Exception.Create(Format('field ''%s'' has invalid type ''%s''', [fldname, fldtype]));
1057
1058 if (lmaxdim > 0) and (mType <> TType.TChar) and (mType <> TType.TTrigData) then raise Exception.Create(Format('field ''%s'' of type ''%s'' cannot be array', [fldname, fldtype]));
1059 if (mType = TType.TTrigData) then
1060 begin
1061 if (lmaxdim < 1) then raise Exception.Create(Format('field ''%s'' of type ''%s'' cannot be array', [fldname, fldtype]));
1062 if (Length(fldrecname) > 0) then raise Exception.Create(Format('field ''%s'' of type ''%s'' cannot have another type', [fldname, fldtype]));
1063 lebs := TDynField.TEBS.TRec;
1064 end;
1065
1066 if hasdefStr then self.mDefUnparsed := quoteStr(defstr)
1067 else if hasdefId then self.mDefUnparsed := defstr
1068 else if hasdefInt then
1069 begin
1070 if (mType = TType.TPoint) then self.mDefUnparsed := Format('(%d %d)', [defint, defint2])
1071 else if (mType = TType.TSize) then self.mDefUnparsed := Format('[%d %d]', [defint, defint2])
1072 else self.mDefUnparsed := Format('%d', [defint]);
1073 end;
1074
1075 self.mHasDefault := (hasdefStr or hasdefId or hasdefInt);
1076 self.mPasName := fldpasname;
1077 self.mEBS := lebs;
1078 self.mEBSTypeName := fldrecname;
1079 self.mBitSetUnique := unique;
1080 self.mAsMonsterId := asmonid;
1081 self.mMaxDim := lmaxdim;
1082 self.mBinOfs := fldofs;
1083 self.mSepPosSize := (asxy or aswh);
1084 self.mAsT := ast;
1085 self.mOmitDef := omitdef;
1086 self.mInternal := ainternal;
1087 end;
1088
1089
1090 function TDynField.getRecRefIndex (): Integer;
1091 begin
1092 if (mRecRef = nil) then begin result := -1; exit; end;
1093 result := mOwner.findRecordNumByType(mEBSTypeName, mRecRef);
1094 end;
1095
1096
1097 procedure TDynField.writeBinTo (st: TStream);
1098 var
1099 s: AnsiString;
1100 f: Integer;
1101 maxv: Integer;
1102 buf: PByte;
1103 ws: TStream = nil;
1104 begin
1105 case mEBS of
1106 TEBS.TNone: begin end;
1107 TEBS.TRec:
1108 begin
1109 if (mMaxDim >= 0) then
1110 begin
1111 // this must be triggerdata
1112 if (mType <> TType.TTrigData) then
1113 begin
1114 raise Exception.Create(Format('record reference type ''%s'' in field ''%s'' cannot be written', [mEBSTypeName, mName]));
1115 end;
1116 // write triggerdata
1117 GetMem(buf, mMaxDim);
1118 if (buf = nil) then raise Exception.Create(Format('record reference type ''%s'' in field ''%s'' cannot be written', [mEBSTypeName, mName]));
1119 try
1120 FillChar(buf^, mMaxDim, 0);
1121 if (mRecRef <> nil) then
1122 begin
1123 ws := TSFSMemoryChunkStream.Create(buf, mMaxDim);
1124 mRecRef.writeBinTo(ws, mMaxDim); // as trigdata
1125 end;
1126 st.WriteBuffer(buf^, mMaxDim);
1127 finally
1128 ws.Free();
1129 if (buf <> nil) then FreeMem(buf);
1130 end;
1131 exit;
1132 end;
1133 // record reference
1134 case mType of
1135 TType.TByte: maxv := 127;
1136 TType.TUByte: maxv := 254;
1137 TType.TShort: maxv := 32767;
1138 TType.TUShort: maxv := 65534;
1139 TType.TInt: maxv := $7fffffff;
1140 TType.TUInt: maxv := $7fffffff;
1141 else raise Exception.Create(Format('record reference type ''%s'' in field ''%s'' cannot be written', [mEBSTypeName, mName]));
1142 end;
1143 // find record number
1144 if (mRecRef <> nil) then
1145 begin
1146 f := mOwner.findRecordNumByType(mEBSTypeName, mRecRef);
1147 if (f < 0) then raise Exception.Create(Format('record reference type ''%s'' in field ''%s'' not found in record list', [mEBSTypeName, mName]));
1148 if mAsMonsterId then Inc(f);
1149 if (f > maxv) then raise Exception.Create(Format('record reference type ''%s'' in field ''%s'' has too big index', [mEBSTypeName, mName]));
1150 end
1151 else
1152 begin
1153 if mAsMonsterId then f := 0 else f := -1;
1154 end;
1155 case mType of
1156 TType.TByte, TType.TUByte: writeInt(st, Byte(f));
1157 TType.TShort, TType.TUShort: writeInt(st, SmallInt(f));
1158 TType.TInt, TType.TUInt: writeInt(st, LongWord(f));
1159 else raise Exception.Create(Format('record reference type ''%s'' in field ''%s'' cannot be written', [mEBSTypeName, mName]));
1160 end;
1161 exit;
1162 end;
1163 TEBS.TEnum: begin end;
1164 TEBS.TBitSet: begin end;
1165 else raise Exception.Create('ketmar forgot to handle some EBS type');
1166 end;
1167
1168 case mType of
1169 TType.TBool:
1170 begin
1171 if not mNegBool then
1172 begin
1173 if (mIVal <> 0) then writeInt(st, Byte(1)) else writeInt(st, Byte(0));
1174 end
1175 else
1176 begin
1177 if (mIVal = 0) then writeInt(st, Byte(1)) else writeInt(st, Byte(0));
1178 end;
1179 exit;
1180 end;
1181 TType.TChar:
1182 begin
1183 if (mMaxDim = 0) then raise Exception.Create(Format('invalid string size definition for field ''%s''', [mName]));
1184 if (mMaxDim < 0) then
1185 begin
1186 if (Length(mSVal) <> 1) then raise Exception.Create(Format('invalid string size definition for field ''%s''', [mName]));
1187 writeInt(st, Byte(mSVal[1]));
1188 end
1189 else
1190 begin
1191 if (Length(mSVal) > mMaxDim) then raise Exception.Create(Format('invalid string size definition for field ''%s''', [mName]));
1192 s := utf2win(mSVal);
1193 if (Length(s) > 0) then st.WriteBuffer(PChar(s)^, Length(s));
1194 for f := Length(s) to mMaxDim do writeInt(st, Byte(0));
1195 end;
1196 exit;
1197 end;
1198 TType.TByte,
1199 TType.TUByte:
1200 begin
1201 // triggerdata array was processed earlier
1202 if (mMaxDim >= 0) then Exception.Create(Format('byte array in field ''%s'' cannot be written', [mName]));
1203 writeInt(st, Byte(mIVal));
1204 exit;
1205 end;
1206 TType.TShort,
1207 TType.TUShort:
1208 begin
1209 if (mMaxDim >= 0) then raise Exception.Create(Format('short array in field ''%s'' cannot be written', [mName]));
1210 writeInt(st, Word(mIVal));
1211 exit;
1212 end;
1213 TType.TInt,
1214 TType.TUInt:
1215 begin
1216 if (mMaxDim >= 0) then raise Exception.Create(Format('int array in field ''%s'' cannot be written', [mName]));
1217 writeInt(st, LongWord(mIVal));
1218 exit;
1219 end;
1220 TType.TString:
1221 begin
1222 raise Exception.Create(Format('cannot write string field ''%s''', [mName]));
1223 end;
1224 TType.TPoint:
1225 begin
1226 if (mMaxDim >= 0) then raise Exception.Create(Format('pos/size array in field ''%s'' cannot be written', [mName]));
1227 writeInt(st, LongInt(mIVal));
1228 writeInt(st, LongInt(mIVal2));
1229 exit;
1230 end;
1231 TType.TSize:
1232 begin
1233 if (mMaxDim >= 0) then raise Exception.Create(Format('pos/size array in field ''%s'' cannot be written', [mName]));
1234 writeInt(st, Word(mIVal));
1235 writeInt(st, Word(mIVal2));
1236 exit;
1237 end;
1238 TType.TList:
1239 begin
1240 assert(false);
1241 exit;
1242 end;
1243 TType.TTrigData:
1244 begin
1245 assert(false);
1246 exit;
1247 end;
1248 else raise Exception.Create('ketmar forgot to handle some field type');
1249 end;
1250 end;
1251
1252
1253 procedure TDynField.writeTo (wr: TTextWriter);
1254 var
1255 es: TDynEBS = nil;
1256 f, mask: Integer;
1257 first, found: Boolean;
1258 begin
1259 wr.put(mName);
1260 wr.put(' ');
1261 case mEBS of
1262 TEBS.TNone: begin end;
1263 TEBS.TRec:
1264 begin
1265 if (mRecRef = nil) then
1266 begin
1267 if (mType = TType.TTrigData) then wr.put('{}'#10) else wr.put('null;'#10);
1268 end
1269 else if (Length(mRecRef.mId) = 0) then
1270 begin
1271 mRecRef.writeTo(wr, false); // only data, no header
1272 end
1273 else
1274 begin
1275 wr.put(mRecRef.mId);
1276 wr.put(';'#10);
1277 end;
1278 exit;
1279 end;
1280 TEBS.TEnum:
1281 begin
1282 //def := mOwner.mOwner;
1283 //es := def.findEBSType(mEBSTypeName);
1284 es := nil;
1285 if (mEBSType <> nil) and (mEBSType is TDynEBS) then es := (mEBSType as TDynEBS);
1286 if (es = nil) or (not es.mIsEnum) then raise Exception.Create(Format('record enum type ''%s'' for field ''%s'' not found', [mEBSTypeName, mName]));
1287 for f := 0 to High(es.mVals) do
1288 begin
1289 if (es.mVals[f] = mIVal) then
1290 begin
1291 wr.put(es.mIds[f]);
1292 wr.put(';'#10);
1293 exit;
1294 end;
1295 end;
1296 raise Exception.Create(Format('value %d in record enum type ''%s'' for field ''%s'' not found', [mIVal, mEBSTypeName, mName]));
1297 end;
1298 TEBS.TBitSet:
1299 begin
1300 //def := mOwner.mOwner;
1301 //es := def.findEBSType(mEBSTypeName);
1302 es := nil;
1303 if (mEBSType <> nil) and (mEBSType is TDynEBS) then es := (mEBSType as TDynEBS);
1304 if (es = nil) or es.mIsEnum then raise Exception.Create(Format('record bitset type ''%s'' for field ''%s'' not found', [mEBSTypeName, mName]));
1305 // none?
1306 if (mIVal = 0) then
1307 begin
1308 for f := 0 to High(es.mVals) do
1309 begin
1310 if (es.mVals[f] = 0) then
1311 begin
1312 wr.put(es.mIds[f]);
1313 wr.put(';'#10);
1314 exit;
1315 end;
1316 end;
1317 raise Exception.Create(Format('value %d in record bitset type ''%s'' for field ''%s'' not found', [0, mEBSTypeName, mName]));
1318 end;
1319 // not none
1320 mask := 1;
1321 first := true;
1322 while (mask <> 0) do
1323 begin
1324 if ((mIVal and mask) <> 0) then
1325 begin
1326 found := false;
1327 for f := 0 to High(es.mVals) do
1328 begin
1329 if (es.mVals[f] = mask) then
1330 begin
1331 if not first then wr.put('+') else first := false;
1332 wr.put(es.mIds[f]);
1333 found := true;
1334 break;
1335 end;
1336 end;
1337 if not found then raise Exception.Create(Format('value %d in record bitset type ''%s'' for field ''%s'' not found', [mask, mEBSTypeName, mName]));
1338 end;
1339 mask := mask shl 1;
1340 end;
1341 wr.put(';'#10);
1342 exit;
1343 end;
1344 else raise Exception.Create('ketmar forgot to handle some EBS type');
1345 end;
1346
1347 case mType of
1348 TType.TBool:
1349 begin
1350 if (mIVal = 0) then wr.put('false;'#10) else wr.put('true;'#10);
1351 exit;
1352 end;
1353 TType.TChar:
1354 begin
1355 if (mMaxDim = 0) then raise Exception.Create(Format('invalid string size definition for field ''%s''', [mName]));
1356 wr.put(quoteStr(mSVal));
1357 wr.put(';'#10);
1358 exit;
1359 end;
1360 TType.TByte,
1361 TType.TUByte,
1362 TType.TShort,
1363 TType.TUShort,
1364 TType.TInt,
1365 TType.TUInt:
1366 begin
1367 wr.put('%d;'#10, [mIVal]);
1368 exit;
1369 end;
1370 TType.TString:
1371 begin
1372 wr.put(quoteStr(mSVal));
1373 wr.put(';'#10);
1374 exit;
1375 end;
1376 TType.TPoint,
1377 TType.TSize:
1378 begin
1379 wr.put('(%d %d);'#10, [mIVal, mIVal2]);
1380 exit;
1381 end;
1382 TType.TList:
1383 begin
1384 assert(false);
1385 exit;
1386 end;
1387 TType.TTrigData:
1388 begin
1389 assert(false);
1390 exit;
1391 end;
1392 else raise Exception.Create('ketmar forgot to handle some field type');
1393 end;
1394 raise Exception.Create(Format('cannot parse field ''%s'' yet', [mName]));
1395 end;
1396
1397
1398 procedure TDynField.parseBinValue (st: TStream);
1399 var
1400 rec, rc: TDynRecord;
1401 tfld: TDynField;
1402 es: TDynEBS = nil;
1403 tdata: PByte = nil;
1404 f, mask: Integer;
1405 s: AnsiString;
1406 begin
1407 case mEBS of
1408 TEBS.TNone: begin end;
1409 TEBS.TRec:
1410 begin
1411 // this must be triggerdata
1412 if (mType = TType.TTrigData) then
1413 begin
1414 assert(mMaxDim > 0);
1415 rec := mOwner;
1416 // find trigger definition
1417 tfld := rec.trigTypeField();
1418 if (tfld = nil) then raise Exception.Create(Format('triggerdata value for field ''%s'' in record ''%s'' without TriggerType field', [mName, rec.mName]));
1419 rc := mOwner.mOwner.findTrigFor(tfld.mSVal); // find in mapdef
1420 if (rc = nil) then raise Exception.Create(Format('triggerdata definition for field ''%s'' in record ''%s'' with type ''%s'' not found', [mName, rec.mName, tfld.mSVal]));
1421 rc := rc.clone(mOwner.mHeaderRec);
1422 rc.mHeaderRec := mOwner.mHeaderRec;
1423 try
1424 rc.parseBinValue(st, true);
1425 mRecRef := rc;
1426 rc := nil;
1427 finally
1428 rc.Free();
1429 end;
1430 mDefined := true;
1431 exit;
1432 end
1433 else
1434 begin
1435 // not a trigger data
1436 case mType of
1437 TType.TByte: f := readShortInt(st);
1438 TType.TUByte: f := readByte(st);
1439 TType.TShort: f := readSmallInt(st);
1440 TType.TUShort: f := readWord(st);
1441 TType.TInt: f := readLongInt(st);
1442 TType.TUInt: f := readLongWord(st);
1443 else raise Exception.Create(Format('invalid non-numeric type ''%s'' for field ''%s'' of record ''%s''', [getTypeName(mType), mName, mEBSTypeName]));
1444 end;
1445 if mAsMonsterId then Dec(f);
1446 if (f < 0) then mRecRefId := '' else mRecRefId := Format('%s%d', [mEBSTypeName, f]);
1447 end;
1448 mDefined := true;
1449 exit;
1450 end;
1451 TEBS.TEnum,
1452 TEBS.TBitSet:
1453 begin
1454 assert(mMaxDim < 0);
1455 case mType of
1456 TType.TByte: f := readShortInt(st);
1457 TType.TUByte: f := readByte(st);
1458 TType.TShort: f := readSmallInt(st);
1459 TType.TUShort: f := readWord(st);
1460 TType.TInt: f := readLongInt(st);
1461 TType.TUInt: f := readLongWord(st);
1462 else raise Exception.Create(Format('invalid non-numeric type ''%s'' for field ''%s'' of record ''%s''', [getTypeName(mType), mName, mEBSTypeName]));
1463 end;
1464 es := nil;
1465 if (mEBSType <> nil) and (mEBSType is TDynEBS) then es := (mEBSType as TDynEBS);
1466 if (es = nil) or (es.mIsEnum <> (mEBS = TEBS.TEnum)) then raise Exception.Create(Format('record enum type ''%s'' for field ''%s'' not found', [mEBSTypeName, mName]));
1467 mIVal := f;
1468 // build enum/bitfield values
1469 if (mEBS = TEBS.TEnum) then
1470 begin
1471 mSVal := es.nameByValue(mIVal);
1472 if (Length(mSVal) = 0) then raise Exception.Create(Format('record enum type ''%s'' for field ''%s'' has invalid value %d', [mEBSTypeName, mName, mIVal]));
1473 end
1474 else
1475 begin
1476 // special for 'none'
1477 if (mIVal = 0) then
1478 begin
1479 mSVal := es.nameByValue(mIVal);
1480 if (Length(mSVal) = 0) then raise Exception.Create(Format('record bitset type ''%s'' for field ''%s'' has invalid value %d', [mEBSTypeName, mName, mIVal]));
1481 end
1482 else
1483 begin
1484 mSVal := '';
1485 mask := 1;
1486 while (mask <> 0) do
1487 begin
1488 if ((mIVal and mask) <> 0) then
1489 begin
1490 s := es.nameByValue(mask);
1491 if (Length(s) = 0) then raise Exception.Create(Format('record bitset type ''%s'' for field ''%s'' has invalid value %d', [mEBSTypeName, mName, mask]));
1492 if (Length(mSVal) <> 0) then mSVal += '+';
1493 mSVal += s;
1494 end;
1495 mask := mask shl 1;
1496 end;
1497 end;
1498 end;
1499 //writeln('ebs <', es.mName, '>: ', mSVal);
1500 mDefined := true;
1501 exit;
1502 end;
1503 else raise Exception.Create('ketmar forgot to handle some EBS type');
1504 end;
1505
1506 case mType of
1507 TType.TBool:
1508 begin
1509 f := readByte(st);
1510 if (f <> 0) then f := 1;
1511 if mNegBool then f := 1-f;
1512 mIVal := f;
1513 mDefined := true;
1514 exit;
1515 end;
1516 TType.TChar:
1517 begin
1518 if (mMaxDim < 0) then
1519 begin
1520 mIVal := readByte(st);
1521 end
1522 else
1523 begin
1524 mSVal := '';
1525 GetMem(tdata, mMaxDim);
1526 try
1527 st.ReadBuffer(tdata^, mMaxDim);
1528 f := 0;
1529 while (f < mMaxDim) and (tdata[f] <> 0) do Inc(f);
1530 if (f > 0) then
1531 begin
1532 SetLength(mSVal, f);
1533 Move(tdata^, PChar(mSVal)^, f);
1534 mSVal := win2utf(mSVal);
1535 end;
1536 finally
1537 FreeMem(tdata);
1538 end;
1539 end;
1540 mDefined := true;
1541 exit;
1542 end;
1543 TType.TByte: begin mIVal := readShortInt(st); mDefined := true; exit; end;
1544 TType.TUByte: begin mIVal := readByte(st); mDefined := true; exit; end;
1545 TType.TShort: begin mIVal := readSmallInt(st); mDefined := true; exit; end;
1546 TType.TUShort: begin mIVal := readWord(st); mDefined := true; exit; end;
1547 TType.TInt: begin mIVal := readLongInt(st); mDefined := true; exit; end;
1548 TType.TUInt: begin mIVal := readLongWord(st); mDefined := true; exit; end;
1549 TType.TString:
1550 begin
1551 raise Exception.Create('cannot read strings from binaries yet');
1552 exit;
1553 end;
1554 TType.TPoint:
1555 begin
1556 mIVal := readLongInt(st);
1557 mIVal2 := readLongInt(st);
1558 mDefined := true;
1559 exit;
1560 end;
1561 TType.TSize:
1562 begin
1563 mIVal := readWord(st);
1564 mIVal2 := readWord(st);
1565 mDefined := true;
1566 exit;
1567 end;
1568 TType.TList:
1569 begin
1570 assert(false);
1571 exit;
1572 end;
1573 TType.TTrigData:
1574 begin
1575 assert(false);
1576 exit;
1577 end;
1578 else raise Exception.Create('ketmar forgot to handle some field type');
1579 end;
1580 raise Exception.Create(Format('cannot parse field ''%s'' yet', [mName]));
1581 end;
1582
1583
1584 procedure TDynField.parseValue (pr: TTextParser);
1585
1586 procedure parseInt (min, max: Integer);
1587 begin
1588 mIVal := pr.expectInt();
1589 if (mIVal < min) or (mIVal > max) then raise Exception.Create(Format('invalid %s value for field ''%s''', [getTypeName(mType), mName]));
1590 mDefined := true;
1591 end;
1592
1593 var
1594 rec, rc: TDynRecord;
1595 es: TDynEBS = nil;
1596 tfld: TDynField;
1597 tk: AnsiString;
1598 edim: AnsiChar;
1599 begin
1600 if (pr.tokType = pr.TTEOF) then raise Exception.Create('field value expected');
1601 if (pr.tokType = pr.TTSemi) then raise Exception.Create('extra semicolon');
1602 // if this field should contain struct, convert type and parse struct
1603 case mEBS of
1604 TEBS.TNone: begin end;
1605 TEBS.TRec:
1606 begin
1607 // ugly hack. sorry.
1608 if (mType = TType.TTrigData) then
1609 begin
1610 pr.expectTT(pr.TTBegin);
1611 if (pr.tokType = pr.TTEnd) then
1612 begin
1613 // '{}'
1614 mRecRef := nil;
1615 pr.expectTT(pr.TTEnd);
1616 end
1617 else
1618 begin
1619 rec := mOwner;
1620 // find trigger definition
1621 tfld := rec.trigTypeField();
1622 if (tfld = nil) then raise Exception.Create(Format('triggerdata value for field ''%s'' in record ''%s'' without ''type'' field', [mName, rec.mName]));
1623 rc := mOwner.mOwner.findTrigFor(tfld.mSVal); // find in mapdef
1624 if (rc = nil) then raise Exception.Create(Format('triggerdata definition for field ''%s'' in record ''%s'' with type ''%s'' not found', [mName, rec.mName, tfld.mSVal]));
1625 rc := rc.clone(mOwner.mHeaderRec);
1626 rc.mHeaderRec := mOwner.mHeaderRec;
1627 //writeln(rc.definition);
1628 try
1629 rc.parseValue(pr, true);
1630 mRecRef := rc;
1631 rc := nil;
1632 finally
1633 rc.Free();
1634 end;
1635 end;
1636 mDefined := true;
1637 pr.eatTT(pr.TTSemi); // hack: allow (but don't require) semicolon after inline records
1638 exit;
1639 end;
1640 // other record types
1641 if (pr.tokType = pr.TTId) then
1642 begin
1643 if pr.eatId('null') then
1644 begin
1645 mRecRef := nil;
1646 end
1647 else
1648 begin
1649 rec := mOwner.findRecordByTypeId(mEBSTypeName, pr.tokStr);
1650 if (rec = nil) then
1651 begin
1652 //raise Exception.Create(Format('record ''%s'' (%s) value for field ''%s'' not found', [pr.tokStr, mEBSTypeName, mName]));
1653 mRecRefId := pr.tokStr;
1654 end
1655 else
1656 begin
1657 mRecRef := rec;
1658 mRecRefId := '';
1659 end;
1660 pr.expectId();
1661 end;
1662 mDefined := true;
1663 pr.expectTT(pr.TTSemi);
1664 exit;
1665 end
1666 else if (pr.tokType = pr.TTBegin) then
1667 begin
1668 //rec := mOwner.mOwner.findRecType(mEBSTypeName); // find in mapdef
1669 rec := nil;
1670 if (mEBSType <> nil) and (mEBSType is TDynRecord) then rec := (mEBSType as TDynRecord);
1671 if (rec = nil) then raise Exception.Create(Format('record type ''%s'' for field ''%s'' not found', [mEBSTypeName, mName]));
1672 rc := rec.clone(mOwner.mHeaderRec);
1673 rc.mHeaderRec := mOwner.mHeaderRec;
1674 rc.parseValue(pr);
1675 mRecRef := rc;
1676 mDefined := true;
1677 if mOwner.addRecordByType(mEBSTypeName, rc) then
1678 begin
1679 //raise Exception.Create(Format('record type ''%s'' for field ''%s'' not found', [mEBSTypeName, mName]));
1680 e_LogWritefln('duplicate record with id ''%s'' for field ''%s'' in record ''%s''', [rc.mId, mName, mOwner.mName]);
1681 end;
1682 pr.eatTT(pr.TTSemi); // hack: allow (but don't require) semicolon after inline records
1683 exit;
1684 end;
1685 pr.expectTT(pr.TTBegin);
1686 end;
1687 TEBS.TEnum:
1688 begin
1689 //es := mOwner.mOwner.findEBSType(mEBSTypeName); // find in mapdef
1690 es := nil;
1691 if (mEBSType <> nil) and (mEBSType is TDynEBS) then es := (mEBSType as TDynEBS);
1692 if (es = nil) or (not es.mIsEnum) then raise Exception.Create(Format('record enum type ''%s'' for field ''%s'' not found', [mEBSTypeName, mName]));
1693 tk := pr.expectId();
1694 if not es.has[tk] then raise Exception.Create(Format('record enum value ''%s'' of type ''%s'' for field ''%s'' not found', [tk, mEBSTypeName, mName]));
1695 mIVal := es.field[tk];
1696 mSVal := tk;
1697 //writeln('ENUM ', mEBSName, '; element <', mSVal, '> with value ', mIVal);
1698 mDefined := true;
1699 pr.expectTT(pr.TTSemi);
1700 exit;
1701 end;
1702 TEBS.TBitSet:
1703 begin
1704 //es := mOwner.mOwner.findEBSType(mEBSTypeName); // find in mapdef
1705 es := nil;
1706 if (mEBSType <> nil) and (mEBSType is TDynEBS) then es := (mEBSType as TDynEBS);
1707 if (es = nil) or es.mIsEnum then raise Exception.Create(Format('record bitset type ''%s'' for field ''%s'' not found', [mEBSTypeName, mName]));
1708 mIVal := 0;
1709 while true do
1710 begin
1711 tk := pr.expectId();
1712 if not es.has[tk] then raise Exception.Create(Format('record bitset value ''%s'' of type ''%s'' for field ''%s'' not found', [tk, mEBSTypeName, mName]));
1713 mIVal := mIVal or es.field[tk];
1714 mSVal := tk;
1715 if (pr.tokType <> pr.TTDelim) or ((pr.tokChar <> '|') and (pr.tokChar <> '+')) then break;
1716 if mBitSetUnique then raise Exception.Create(Format('record bitset of type ''%s'' for field ''%s'' expects only one value', [tk, mEBSTypeName, mName]));
1717 //pr.expectDelim('|');
1718 pr.skipToken(); // plus or pipe
1719 end;
1720 mDefined := true;
1721 pr.expectTT(pr.TTSemi);
1722 exit;
1723 end;
1724 else raise Exception.Create('ketmar forgot to handle some EBS type');
1725 end;
1726
1727 case mType of
1728 TType.TBool:
1729 begin
1730 if pr.eatId('true') or pr.eatId('tan') or pr.eatId('yes') then mIVal := 1
1731 else if pr.eatId('false') or pr.eatId('ona') or pr.eatId('no') then mIVal := 0
1732 else raise Exception.Create(Format('invalid bool value for field ''%s''', [mName]));
1733 mDefined := true;
1734 pr.expectTT(pr.TTSemi);
1735 exit;
1736 end;
1737 TType.TChar:
1738 begin
1739 if (mMaxDim = 0) then raise Exception.Create(Format('invalid string size definition for field ''%s''', [mName]));
1740 mSVal := pr.expectStr(true);
1741 if (mMaxDim < 0) then
1742 begin
1743 // single char
1744 if (Length(mSVal) <> 1) then raise Exception.Create(Format('invalid string size for field ''%s''', [mName]));
1745 mIVal := Integer(mSVal[1]);
1746 mSVal := '';
1747 end
1748 else
1749 begin
1750 // string
1751 if (Length(mSVal) > mMaxDim) then raise Exception.Create(Format('invalid string size for field ''%s''', [mName]));
1752 end;
1753 mDefined := true;
1754 pr.expectTT(pr.TTSemi);
1755 exit;
1756 end;
1757 TType.TByte:
1758 begin
1759 parseInt(-128, 127);
1760 pr.expectTT(pr.TTSemi);
1761 exit;
1762 end;
1763 TType.TUByte:
1764 begin
1765 parseInt(0, 255);
1766 pr.expectTT(pr.TTSemi);
1767 exit;
1768 end;
1769 TType.TShort:
1770 begin
1771 parseInt(-32768, 32768);
1772 pr.expectTT(pr.TTSemi);
1773 exit;
1774 end;
1775 TType.TUShort:
1776 begin
1777 parseInt(0, 65535);
1778 pr.expectTT(pr.TTSemi);
1779 exit;
1780 end;
1781 TType.TInt:
1782 begin
1783 parseInt(Integer($80000000), $7fffffff);
1784 pr.expectTT(pr.TTSemi);
1785 exit;
1786 end;
1787 TType.TUInt:
1788 begin
1789 parseInt(0, $7fffffff); //FIXME
1790 pr.expectTT(pr.TTSemi);
1791 exit;
1792 end;
1793 TType.TString:
1794 begin
1795 mSVal := pr.expectStr(true);
1796 mDefined := true;
1797 pr.expectTT(pr.TTSemi);
1798 exit;
1799 end;
1800 TType.TPoint,
1801 TType.TSize:
1802 begin
1803 if pr.eatDelim('[') then edim := ']' else begin pr.expectDelim('('); edim := ')'; end;
1804 mIVal := pr.expectInt();
1805 if (mType = TType.TSize) then
1806 begin
1807 if (mIVal < 0) or (mIVal > 32767) then raise Exception.Create(Format('invalid %s value for field ''%s''', [getTypeName(mType), mName]));
1808 end;
1809 mIVal2 := pr.expectInt();
1810 if (mType = TType.TSize) then
1811 begin
1812 if (mIVal2 < 0) or (mIVal2 > 32767) then raise Exception.Create(Format('invalid %s value for field ''%s''', [getTypeName(mType), mName]));
1813 end;
1814 mDefined := true;
1815 pr.expectDelim(edim);
1816 pr.expectTT(pr.TTSemi);
1817 exit;
1818 end;
1819 TType.TList:
1820 begin
1821 assert(false);
1822 exit;
1823 end;
1824 TType.TTrigData:
1825 begin
1826 assert(false);
1827 exit;
1828 end;
1829 else raise Exception.Create('ketmar forgot to handle some field type');
1830 end;
1831 raise Exception.Create(Format('cannot parse field ''%s'' yet', [mName]));
1832 end;
1833
1834
1835 // ////////////////////////////////////////////////////////////////////////// //
1836 constructor TDynRecord.Create (pr: TTextParser);
1837 begin
1838 if (pr = nil) then raise Exception.Create('cannot create record type without type definition');
1839 mId := '';
1840 mName := '';
1841 mSize := 0;
1842 mFields := TDynFieldList.Create();
1843 {$IF DEFINED(XDYNREC_USE_FIELDHASH)}
1844 mFieldsHash := hashNewStrInt();
1845 {$ENDIF}
1846 mTrigTypes := nil;
1847 mHeader := false;
1848 mHeaderRec := nil;
1849 mBinBlock := -1;
1850 mTagInt := 0;
1851 mTagPtr := nil;
1852 parseDef(pr);
1853 end;
1854
1855
1856 constructor TDynRecord.Create ();
1857 begin
1858 mName := '';
1859 mSize := 0;
1860 mFields := TDynFieldList.Create();
1861 {$IF DEFINED(XDYNREC_USE_FIELDHASH)}
1862 mFieldsHash := hashNewStrInt();
1863 {$ENDIF}
1864 mTrigTypes := nil;
1865 mHeader := false;
1866 mHeaderRec := nil;
1867 mTagInt := 0;
1868 mTagPtr := nil;
1869 mRec2Free := nil;
1870 end;
1871
1872
1873 destructor TDynRecord.Destroy ();
1874 var
1875 fld: TDynField;
1876 rec: TDynRecord;
1877 begin
1878 if (mRec2Free <> nil) then
1879 begin
1880 for rec in mRec2Free do
1881 begin
1882 if (rec <> self) then
1883 begin
1884 //writeln('freeing: ', LongWord(rec));
1885 rec.Free();
1886 end;
1887 end;
1888 mRec2Free.Free();
1889 mRec2Free := nil;
1890 end;
1891 mName := '';
1892 for fld in mFields do fld.Free();
1893 mFields.Free();
1894 mFields := nil;
1895 {$IF DEFINED(XDYNREC_USE_FIELDHASH)}
1896 mFieldsHash.Free();
1897 mFieldsHash := nil;
1898 {$ENDIF}
1899 mTrigTypes := nil;
1900 mHeaderRec := nil;
1901 mTagInt := 0;
1902 mTagPtr := nil;
1903 inherited;
1904 end;
1905
1906
1907 procedure TDynRecord.regrec (rec: TDynRecord);
1908 begin
1909 if (rec <> nil) and (rec <> self) then
1910 begin
1911 if (mRec2Free = nil) then mRec2Free := TDynRecList.Create();
1912 mRec2Free.append(rec);
1913 end;
1914 end;
1915
1916
1917 procedure TDynRecord.addField (fld: TDynField); inline;
1918 begin
1919 if (fld = nil) then raise Exception.Create('cannot append nil field to record');
1920 mFields.append(fld);
1921 {$IF DEFINED(XDYNREC_USE_FIELDHASH)}
1922 if (Length(fld.mName) > 0) then mFieldsHash.put(fld.mName, mFields.count-1);
1923 {$ENDIF}
1924 end;
1925
1926
1927 function TDynRecord.addFieldChecked (fld: TDynField): Boolean; inline; // `true`: duplicate name
1928 begin
1929 result := false;
1930 if (fld = nil) then raise Exception.Create('cannot append nil field to record');
1931 {$IF not DEFINED(XDYNREC_USE_FIELDHASH)}
1932 if (Length(fld.mName) > 0) then result := hasByName(fld.mName);
1933 {$ENDIF}
1934 mFields.append(fld);
1935 {$IF DEFINED(XDYNREC_USE_FIELDHASH)}
1936 if (Length(fld.mName) > 0) then result := mFieldsHash.put(fld.mName, mFields.count-1);
1937 {$ENDIF}
1938 end;
1939
1940
1941 function TDynRecord.findByName (const aname: AnsiString): Integer; inline;
1942 begin
1943 {$IF DEFINED(XDYNREC_USE_FIELDHASH)}
1944 if not mFieldsHash.get(aname, result) then result := -1;
1945 {$ELSE}
1946 result := 0;
1947 while (result < mFields.count) do
1948 begin
1949 if StrEqu(aname, mFields[result].mName) then exit;
1950 Inc(result);
1951 end;
1952 result := -1;
1953 {$ENDIF}
1954 end;
1955
1956
1957 function TDynRecord.hasByName (const aname: AnsiString): Boolean; inline;
1958 begin
1959 result := (findByName(aname) >= 0);
1960 end;
1961
1962
1963 function TDynRecord.getFieldByName (const aname: AnsiString): TDynField; inline;
1964 var
1965 f: Integer;
1966 begin
1967 f := findByName(aname);
1968 if (f >= 0) then result := mFields[f] else result := nil;
1969 end;
1970
1971
1972 function TDynRecord.getFieldAt (idx: Integer): TDynField; inline;
1973 begin
1974 if (idx >= 0) and (idx < mFields.count) then result := mFields[idx] else result := nil;
1975 end;
1976
1977
1978 function TDynRecord.getCount (): Integer; inline;
1979 begin
1980 result := mFields.count;
1981 end;
1982
1983
1984 function TDynRecord.getIsTrigData (): Boolean; inline;
1985 begin
1986 result := (Length(mTrigTypes) > 0);
1987 end;
1988
1989
1990 function TDynRecord.getIsForTrig (const aname: AnsiString): Boolean; inline;
1991 var
1992 f: Integer;
1993 begin
1994 result := true;
1995 for f := 0 to High(mTrigTypes) do if StrEqu(mTrigTypes[f], aname) then exit;
1996 result := false;
1997 end;
1998
1999
2000 function TDynRecord.getForTrigCount (): Integer; inline;
2001 begin
2002 result := Length(mTrigTypes);
2003 end;
2004
2005
2006 function TDynRecord.getForTrigAt (idx: Integer): AnsiString; inline;
2007 begin
2008 if (idx >= 0) and (idx < Length(mTrigTypes)) then result := mTrigTypes[idx] else result := '';
2009 end;
2010
2011
2012 function TDynRecord.clone (registerIn: TDynRecord): TDynRecord;
2013 var
2014 fld: TDynField;
2015 f: Integer;
2016 begin
2017 result := TDynRecord.Create();
2018 result.mOwner := mOwner;
2019 result.mId := mId;
2020 result.mPasName := mPasName;
2021 result.mName := mName;
2022 result.mSize := mSize;
2023 result.mHeader := mHeader;
2024 result.mBinBlock := mBinBlock;
2025 result.mHeaderRec := mHeaderRec;
2026 result.mTagInt := mTagInt;
2027 result.mTagPtr := mTagPtr;
2028 if (mFields.count > 0) then
2029 begin
2030 result.mFields.capacity := mFields.count;
2031 for fld in mFields do result.addField(fld.clone(result, registerIn));
2032 end;
2033 SetLength(result.mTrigTypes, Length(mTrigTypes));
2034 for f := 0 to High(mTrigTypes) do result.mTrigTypes[f] := mTrigTypes[f];
2035 if (registerIn <> nil) then registerIn.regrec(result);
2036 end;
2037
2038
2039 function TDynRecord.findRecordByTypeId (const atypename, aid: AnsiString): TDynRecord;
2040 var
2041 fld: TDynField;
2042 idx: Integer;
2043 begin
2044 result := nil;
2045 if (Length(aid) = 0) then exit;
2046 // find record data
2047 fld := mHeaderRec.field[atypename];
2048 if (fld = nil) then exit;
2049 if (fld.mType <> fld.TType.TList) then raise Exception.Create(Format('cannot get record of type ''%s'' due to name conflict with ordinary field', [atypename]));
2050 // find by id
2051 if (fld.mRVal <> nil) then
2052 begin
2053 if fld.mRHash.get(aid, idx) then begin result := fld.mRVal[idx]; exit; end;
2054 end;
2055 // alas
2056 end;
2057
2058
2059 function TDynRecord.findRecordNumByType (const atypename: AnsiString; rc: TDynRecord): Integer;
2060 var
2061 fld: TDynField;
2062 idx: Integer;
2063 begin
2064 result := -1;
2065 // find record data
2066 fld := mHeaderRec.field[atypename];
2067 if (fld = nil) then exit;
2068 if (fld.mType <> fld.TType.TList) then raise Exception.Create(Format('cannot get record of type ''%s'' due to name conflict with ordinary field', [atypename]));
2069 // find by ref
2070 if (fld.mRVal <> nil) then
2071 begin
2072 for idx := 0 to fld.mRVal.count-1 do
2073 begin
2074 if (fld.mRVal[idx] = rc) then begin result := idx; exit; end;
2075 end;
2076 end;
2077 // alas
2078 end;
2079
2080
2081 function TDynRecord.addRecordByType (const atypename: AnsiString; rc: TDynRecord): Boolean;
2082 var
2083 fld: TDynField;
2084 begin
2085 // find record data
2086 fld := mHeaderRec.field[atypename];
2087 if (fld = nil) then
2088 begin
2089 // first record
2090 fld := TDynField.Create(atypename, TDynField.TType.TList);
2091 fld.mOwner := mHeaderRec;
2092 mHeaderRec.addField(fld);
2093 end;
2094 if (fld.mType <> fld.TType.TList) then raise Exception.Create(Format('cannot append record of type ''%s'' due to name conflict with ordinary field', [atypename]));
2095 // append
2096 if (fld.mRVal = nil) then
2097 begin
2098 fld.mRVal := TDynRecList.Create();
2099 fld.mRHash := hashNewStrInt();
2100 end;
2101 result := fld.addListItem(rc);
2102 end;
2103
2104
2105 function TDynRecord.isSimpleEqu (rec: TDynRecord): Boolean;
2106 var
2107 f: Integer;
2108 begin
2109 if (rec = nil) then begin result := false; exit; end; // self.mRecRef can't be `nil` here
2110 if (rec = self) then begin result := true; exit; end;
2111 if (mFields.count <> rec.mFields.count) then begin result := false; exit; end;
2112 result := false;
2113 for f := 0 to mFields.count-1 do
2114 begin
2115 if not mFields[f].isSimpleEqu(rec.mFields[f]) then exit;
2116 end;
2117 result := true;
2118 end;
2119
2120
2121 function TDynRecord.trigTypeField (): TDynField;
2122 var
2123 fld: TDynField;
2124 es: TDynEBS = nil;
2125 begin
2126 for fld in mFields do
2127 begin
2128 if (fld.mEBS <> TDynField.TEBS.TEnum) then continue;
2129 if not (fld.mEBSType is TDynEBS) then continue;
2130 es := (fld.mEBSType as TDynEBS);
2131 assert(es <> nil);
2132 if StrEqu(es.mName, 'TriggerType') then begin result := fld; exit; end;
2133 end;
2134 result := nil;
2135 end;
2136
2137
2138 // number of records of the given instance
2139 function TDynRecord.instanceCount (const typename: AnsiString): Integer;
2140 var
2141 fld: TDynField;
2142 begin
2143 result := 0;
2144 fld := field[typename];
2145 if (fld <> nil) and (fld.mType = fld.TType.TList) then result := fld.mRVal.count;
2146 end;
2147
2148
2149 function TDynRecord.getUserVar (const aname: AnsiString): Variant;
2150 var
2151 fld: TDynField;
2152 begin
2153 fld := getFieldByName(aname);
2154 if (fld = nil) then result := Unassigned else result := fld.varvalue;
2155 end;
2156
2157
2158 procedure TDynRecord.setUserVar (const aname: AnsiString; val: Variant);
2159 var
2160 fld: TDynField;
2161 begin
2162 fld := getFieldByName(aname);
2163 if (fld = nil) then
2164 begin
2165 if (Length(aname) = 0) then raise Exception.Create('cannot create nameless user field');
2166 fld := TDynField.Create(aname, val);
2167 fld.mOwner := self;
2168 fld.mInternal := true;
2169 addField(fld);
2170 end
2171 else
2172 begin
2173 fld.varvalue := val;
2174 end;
2175 end;
2176
2177
2178 procedure TDynRecord.parseDef (pr: TTextParser);
2179 var
2180 fld: TDynField;
2181 tdn: AnsiString;
2182 begin
2183 if pr.eatId('TriggerData') then
2184 begin
2185 pr.expectId('for');
2186 if pr.eatDelim('(') then
2187 begin
2188 while true do
2189 begin
2190 while pr.eatTT(pr.TTComma) do begin end;
2191 if pr.eatDelim(')') then break;
2192 tdn := pr.expectId();
2193 if isForTrig[tdn] then raise Exception.Create(Format('duplicate trigdata ''%s'' trigtype ''%s''', [mName, tdn]));
2194 SetLength(mTrigTypes, Length(mTrigTypes)+1);
2195 mTrigTypes[High(mTrigTypes)] := tdn;
2196 end;
2197 end
2198 else
2199 begin
2200 tdn := pr.expectId();
2201 SetLength(mTrigTypes, 1);
2202 mTrigTypes[0] := tdn;
2203 end;
2204 mName := 'TriggerData';
2205 end
2206 else
2207 begin
2208 mPasName := pr.expectId(); // pascal record name
2209 pr.expectId('is');
2210 mName := pr.expectStr();
2211 while (pr.tokType <> pr.TTBegin) do
2212 begin
2213 if pr.eatId('header') then begin mHeader := true; continue; end;
2214 if pr.eatId('size') then
2215 begin
2216 if (mSize > 0) then raise Exception.Create(Format('duplicate `size` in record ''%s''', [mName]));
2217 mSize := pr.expectInt();
2218 if (mSize < 1) then raise Exception.Create(Format('invalid record ''%s'' size: %d', [mName, mSize]));
2219 pr.expectId('bytes');
2220 continue;
2221 end;
2222 if pr.eatId('binblock') then
2223 begin
2224 if (mBinBlock >= 0) then raise Exception.Create(Format('duplicate `binblock` in record ''%s''', [mName]));
2225 mBinBlock := pr.expectInt();
2226 if (mBinBlock < 1) then raise Exception.Create(Format('invalid record ''%s'' binblock: %d', [mName, mBinBlock]));
2227 continue;
2228 end;
2229 end;
2230 end;
2231
2232 pr.expectTT(pr.TTBegin);
2233 // load fields
2234 while (pr.tokType <> pr.TTEnd) do
2235 begin
2236 fld := TDynField.Create(pr);
2237 //if hasByName(fld.name) then begin fld.Free(); raise Exception.Create(Format('duplicate field ''%s''', [fld.name])); end;
2238 // append
2239 fld.mOwner := self;
2240 if addFieldChecked(fld) then
2241 begin
2242 fld.Free();
2243 raise Exception.Create(Format('duplicate field ''%s''', [fld.name]));
2244 end;
2245 // done with field
2246 end;
2247 pr.expectTT(pr.TTEnd);
2248 end;
2249
2250
2251 function TDynRecord.pasdef (): AnsiString;
2252 var
2253 fld: TDynField;
2254 begin
2255 if isTrigData then
2256 begin
2257 assert(false);
2258 result := '';
2259 end
2260 else
2261 begin
2262 // record
2263 result := ' '+mPasName+' = packed record'#10;
2264 end;
2265 for fld in mFields do
2266 begin
2267 if fld.mInternal then continue;
2268 if (fld.mBinOfs < 0) then continue;
2269 result += ' '+fld.pasdef+#10;
2270 end;
2271 result += ' end;'#10;
2272 end;
2273
2274
2275 function TDynRecord.definition (): AnsiString;
2276 var
2277 f: Integer;
2278 begin
2279 if isTrigData then
2280 begin
2281 // trigger data
2282 result := 'TriggerData for ';
2283 if (Length(mTrigTypes) > 1) then
2284 begin
2285 result += '(';
2286 for f := 0 to High(mTrigTypes) do
2287 begin
2288 if (f <> 0) then result += ', ';
2289 result += mTrigTypes[f];
2290 end;
2291 result += ')';
2292 end
2293 else
2294 begin
2295 result += mTrigTypes[0];
2296 end;
2297 end
2298 else
2299 begin
2300 // record
2301 result := mPasName+' is '+quoteStr(mName);
2302 if (mSize >= 0) then result += Format(' size %d bytes', [mSize]);
2303 if mHeader then result += ' header';
2304 end;
2305 result += ' {'#10;
2306 for f := 0 to mFields.count-1 do
2307 begin
2308 result += ' ';
2309 result += mFields[f].definition;
2310 result += ';'#10;
2311 end;
2312 result += '}';
2313 end;
2314
2315
2316 procedure TDynRecord.parseBinValue (st: TStream; forceData: Boolean=false);
2317 var
2318 sign: string[4];
2319 btype: Integer;
2320 bsize: Integer;
2321 buf: PByte = nil;
2322 loaded: array[0..255] of Boolean;
2323 rec, rect: TDynRecord;
2324 fld: TDynField;
2325 f: Integer;
2326 mst: TSFSMemoryChunkStream = nil;
2327
2328 procedure linkNames (rec: TDynRecord);
2329 var
2330 fld: TDynField;
2331 rt: TDynRecord;
2332 begin
2333 //writeln('*** rec: ', rec.mName, '.', rec.mId, ' (', rec.mFields.count, ')');
2334 for fld in rec.mFields do
2335 begin
2336 if (fld.mType = TDynField.TType.TTrigData) then
2337 begin
2338 if (fld.mRecRef <> nil) then linkNames(fld.mRecRef);
2339 continue;
2340 end;
2341 if (Length(fld.mRecRefId) = 0) then continue;
2342 assert(fld.mEBSType <> nil);
2343 rt := findRecordByTypeId(fld.mEBSTypeName, fld.mRecRefId);
2344 if (rt = nil) then
2345 begin
2346 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);
2347 //raise Exception.Create(Format('record of type ''%s'' with id ''%s'' links to inexistant record of type ''%s'' with id ''%s''', [rec.mName, rec.mId, fld.mEBSTypeName, fld.mRecRefId]));
2348 end;
2349 //writeln(' ', rec.mName, '.', rec.mId, ':', fld.mName, ' -> ', rt.mName, '.', rt.mId, ' (', fld.mEBSTypeName, '.', fld.mRecRefId, ')');
2350 fld.mRecRefId := '';
2351 fld.mRecRef := rt;
2352 fld.mDefined := true;
2353 end;
2354 for fld in rec.mFields do
2355 begin
2356 //writeln(' ', fld.mName);
2357 fld.fixDefaultValue(); // just in case
2358 end;
2359 end;
2360
2361 begin
2362 for f := 0 to High(loaded) do loaded[f] := false;
2363 mst := TSFSMemoryChunkStream.Create(nil, 0);
2364 try
2365 if mHeader and not forceData then
2366 begin
2367 // parse map file as sequence of blocks
2368 sign[0] := #4;
2369 st.ReadBuffer(sign[1], 4);
2370 if (sign <> 'MAP'#1) then raise Exception.Create('invalid binary map signature');
2371 // parse blocks
2372 while (st.position < st.size) do
2373 begin
2374 btype := readByte(st);
2375 if (btype = 0) then break; // no more blocks
2376 readLongWord(st); // reserved
2377 bsize := readLongInt(st);
2378 {$IF DEFINED(D2D_XDYN_DEBUG)}writeln('btype=', btype, '; bsize=', bsize);{$ENDIF}
2379 if (bsize < 0) or (bsize > $1fffffff) then raise Exception.Create(Format('block of type %d has invalid size %d', [btype, bsize]));
2380 if loaded[btype] then raise Exception.Create(Format('block of type %d already loaded', [btype]));
2381 loaded[btype] := true;
2382 // find record type for this block
2383 rect := nil;
2384 for rec in mOwner.recTypes do if (rec.mBinBlock = btype) then begin rect := rec; break; end;
2385 if (rect = nil) then raise Exception.Create(Format('block of type %d has no corresponding record', [btype]));
2386 //writeln('found type ''', rec.mName, ''' for block type ', btype);
2387 if (rec.mSize = 0) or ((bsize mod rec.mSize) <> 0) then raise Exception.Create(Format('block of type %d has invalid number of records', [btype]));
2388 // header?
2389 if (rect.mHeader) then
2390 begin
2391 if (bsize <> mSize) then raise Exception.Create(Format('header block of type %d has invalid number of records', [btype]));
2392 GetMem(buf, bsize);
2393 st.ReadBuffer(buf^, bsize);
2394 mst.setup(buf, mSize);
2395 parseBinValue(mst, true); // force parsing data
2396 end
2397 else
2398 begin
2399 // create list for this type
2400 fld := TDynField.Create(rec.mName, TDynField.TType.TList);
2401 fld.mOwner := self;
2402 addField(fld);
2403 if (bsize > 0) then
2404 begin
2405 GetMem(buf, bsize);
2406 st.ReadBuffer(buf^, bsize);
2407 for f := 0 to (bsize div rec.mSize)-1 do
2408 begin
2409 mst.setup(buf+f*rec.mSize, rec.mSize);
2410 rec := rect.clone(self);
2411 rec.mHeaderRec := self;
2412 rec.parseBinValue(mst);
2413 rec.mId := Format('%s%d', [rec.mName, f]);
2414 fld.addListItem(rec);
2415 //writeln('parsed ''', rec.mId, '''...');
2416 end;
2417 end;
2418 end;
2419 FreeMem(buf);
2420 buf := nil;
2421 //st.position := st.position+bsize;
2422 end;
2423 // link fields
2424 for fld in mFields do
2425 begin
2426 if (fld.mType <> TDynField.TType.TList) then continue;
2427 for rec in fld.mRVal do linkNames(rec);
2428 end;
2429 exit;
2430 end;
2431
2432 // read fields
2433 if StrEqu(mName, 'TriggerData') then mSize := Integer(st.size-st.position);
2434 if (mSize < 1) then raise Exception.Create(Format('cannot read record of type ''%s'' with unknown size', [mName]));
2435 GetMem(buf, mSize);
2436 st.ReadBuffer(buf^, mSize);
2437 for fld in mFields do
2438 begin
2439 if fld.mInternal then continue;
2440 if (fld.mBinOfs < 0) then continue;
2441 if (fld.mBinOfs >= st.size) then raise Exception.Create(Format('record of type ''%s'' has invalid field ''%s''', [fld.mName]));
2442 mst.setup(buf+fld.mBinOfs, mSize-fld.mBinOfs);
2443 //writeln('parsing ''', mName, '.', fld.mName, '''...');
2444 fld.parseBinValue(mst);
2445 end;
2446 finally
2447 mst.Free();
2448 if (buf <> nil) then FreeMem(buf);
2449 end;
2450 end;
2451
2452
2453 procedure TDynRecord.writeBinTo (st: TStream; trigbufsz: Integer=-1; onlyFields: Boolean=false);
2454 var
2455 fld: TDynField;
2456 rec, rv: TDynRecord;
2457 buf: PByte = nil;
2458 ws: TStream = nil;
2459 blk, blkmax: Integer;
2460 //f, c: Integer;
2461 bufsz: Integer = 0;
2462 blksz: Integer;
2463 begin
2464 if (trigbufsz < 0) then
2465 begin
2466 if (mBinBlock < 1) then raise Exception.Create('cannot write binary record without block number');
2467 if (mSize < 1) then raise Exception.Create('cannot write binary record without size');
2468 bufsz := mSize;
2469 end
2470 else
2471 begin
2472 bufsz := trigbufsz;
2473 end;
2474 try
2475 GetMem(buf, bufsz);
2476 FillChar(buf^, bufsz, 0);
2477 ws := TSFSMemoryChunkStream.Create(buf, bufsz);
2478
2479 // write normal fields
2480 for fld in mFields do
2481 begin
2482 // record list?
2483 if (fld.mType = fld.TType.TList) then continue; // later
2484 if fld.mInternal then continue;
2485 if (fld.mBinOfs < 0) then continue;
2486 if (fld.mBinOfs >= bufsz) then raise Exception.Create('binary value offset is outside of the buffer');
2487 TSFSMemoryChunkStream(ws).setup(buf+fld.mBinOfs, bufsz-fld.mBinOfs);
2488 //writeln('writing field <', fld.mName, '>');
2489 fld.writeBinTo(ws);
2490 end;
2491
2492 // write block with normal fields
2493 if mHeader and not onlyFields then
2494 begin
2495 //writeln('writing header...');
2496 // signature and version
2497 writeIntBE(st, LongWord($4D415001));
2498 writeInt(st, Byte(mBinBlock)); // type
2499 writeInt(st, LongWord(0)); // reserved
2500 writeInt(st, LongWord(bufsz)); // size
2501 end;
2502 st.WriteBuffer(buf^, bufsz);
2503
2504 ws.Free(); ws := nil;
2505 FreeMem(buf); buf := nil;
2506
2507 // write other blocks, if any
2508 if mHeader and not onlyFields then
2509 begin
2510 // calculate blkmax
2511 blkmax := 0;
2512 for fld in mFields do
2513 begin
2514 // record list?
2515 if (fld.mType = fld.TType.TList) then
2516 begin
2517 if (fld.mRVal = nil) or (fld.mRVal.count = 0) then continue;
2518 rec := mOwner.findRecType(fld.mName);
2519 if (rec = nil) then continue;
2520 if (rec.mBinBlock <= 0) then continue;
2521 if (blkmax < rec.mBinBlock) then blkmax := rec.mBinBlock;
2522 end;
2523 end;
2524 // write blocks
2525 for blk := 1 to blkmax do
2526 begin
2527 if (blk = mBinBlock) then continue;
2528 ws := nil;
2529 for fld in mFields do
2530 begin
2531 // record list?
2532 if (fld.mType = fld.TType.TList) then
2533 begin
2534 if (fld.mRVal = nil) or (fld.mRVal.count = 0) then continue;
2535 rec := mOwner.findRecType(fld.mName);
2536 if (rec = nil) then continue;
2537 if (rec.mBinBlock <> blk) then continue;
2538 if (ws = nil) then ws := TMemoryStream.Create();
2539 for rv in fld.mRVal do rv.writeBinTo(ws);
2540 end;
2541 end;
2542 // flush block
2543 if (ws <> nil) then
2544 begin
2545 blksz := Integer(ws.position);
2546 ws.position := 0;
2547 writeInt(st, Byte(blk)); // type
2548 writeInt(st, LongWord(0)); // reserved
2549 writeInt(st, LongWord(blksz)); // size
2550 st.CopyFrom(ws, blksz);
2551 ws.Free();
2552 ws := nil;
2553 end;
2554 end;
2555 // write end marker
2556 writeInt(st, Byte(0));
2557 writeInt(st, LongWord(0));
2558 writeInt(st, LongWord(0));
2559 end;
2560 finally
2561 ws.Free();
2562 if (buf <> nil) then FreeMem(buf);
2563 end;
2564 end;
2565
2566
2567 procedure TDynRecord.writeTo (wr: TTextWriter; putHeader: Boolean=true);
2568 var
2569 fld: TDynField;
2570 rec: TDynRecord;
2571 begin
2572 if putHeader then
2573 begin
2574 wr.put(mName);
2575 if (Length(mId) > 0) then begin wr.put(' '); wr.put(mId); end;
2576 wr.put(' ');
2577 end;
2578 wr.put('{'#10);
2579 wr.indent();
2580 try
2581 for fld in mFields do
2582 begin
2583 // record list?
2584 if (fld.mType = fld.TType.TList) then
2585 begin
2586 if not mHeader then raise Exception.Create('record list in non-header record');
2587 if (fld.mRVal <> nil) then
2588 begin
2589 for rec in fld.mRVal do
2590 begin
2591 if (Length(rec.mId) = 0) then continue;
2592 wr.putIndent();
2593 rec.writeTo(wr, true);
2594 end;
2595 end;
2596 continue;
2597 end;
2598 if fld.mInternal then continue;
2599 if fld.mOmitDef and fld.isDefaultValue then continue;
2600 wr.putIndent();
2601 fld.writeTo(wr);
2602 end;
2603 finally
2604 wr.unindent();
2605 end;
2606 wr.putIndent();
2607 wr.put('}'#10);
2608 end;
2609
2610
2611 {$IF DEFINED(D2D_DYNREC_PROFILER)}
2612 var
2613 profCloneRec: UInt64 = 0;
2614 profFindRecType: UInt64 = 0;
2615 profFieldSearching: UInt64 = 0;
2616 profListDupChecking: UInt64 = 0;
2617 profAddRecByType: UInt64 = 0;
2618 profFieldValParsing: UInt64 = 0;
2619 profFixDefaults: UInt64 = 0;
2620 profRecValParse: UInt64 = 0;
2621
2622 procedure xdynDumpProfiles ();
2623 begin
2624 writeln('=== XDYNREC PROFILES ===');
2625 writeln('record cloning: ', profCloneRec div 1000, '.', profCloneRec mod 1000, ' milliseconds');
2626 writeln('findRecType : ', profFindRecType div 1000, '.', profFindRecType mod 1000, ' milliseconds');
2627 writeln('field[] : ', profFieldSearching div 1000, '.', profFieldSearching mod 1000, ' milliseconds');
2628 writeln('list dup check: ', profListDupChecking div 1000, '.', profListDupChecking mod 1000, ' milliseconds');
2629 writeln('addRecByType : ', profAddRecByType div 1000, '.', profAddRecByType mod 1000, ' milliseconds');
2630 writeln('field valparse: ', profFieldValParsing div 1000, '.', profFieldValParsing mod 1000, ' milliseconds');
2631 writeln('fix defaults : ', profFixDefaults div 1000, '.', profFixDefaults mod 1000, ' milliseconds');
2632 writeln('recvalparse : ', profRecValParse div 1000, '.', profRecValParse mod 1000, ' milliseconds');
2633 end;
2634 {$ENDIF}
2635
2636
2637 procedure TDynRecord.parseValue (pr: TTextParser; beginEaten: Boolean=false);
2638 var
2639 fld: TDynField;
2640 rec: TDynRecord = nil;
2641 trc{, rv}: TDynRecord;
2642 {$IF DEFINED(D2D_DYNREC_PROFILER)}
2643 stt, stall: UInt64;
2644 {$ENDIF}
2645
2646 procedure linkNames (rec: TDynRecord);
2647 var
2648 fld: TDynField;
2649 rt: TDynRecord;
2650 begin
2651 //writeln('*** rec: ', rec.mName, '.', rec.mId, ' (', rec.mFields.count, ')');
2652 for fld in rec.mFields do
2653 begin
2654 if (fld.mType = TDynField.TType.TTrigData) then
2655 begin
2656 if (fld.mRecRef <> nil) then linkNames(fld.mRecRef);
2657 continue;
2658 end;
2659 if (Length(fld.mRecRefId) = 0) then continue;
2660 assert(fld.mEBSType <> nil);
2661 rt := findRecordByTypeId(fld.mEBSTypeName, fld.mRecRefId);
2662 if (rt = nil) then
2663 begin
2664 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);
2665 //raise Exception.Create(Format('record of type ''%s'' with id ''%s'' links to inexistant record of type ''%s'' with id ''%s''', [rec.mName, rec.mId, fld.mEBSTypeName, fld.mRecRefId]));
2666 end;
2667 //writeln(' ', rec.mName, '.', rec.mId, ':', fld.mName, ' -> ', rt.mName, '.', rt.mId, ' (', fld.mEBSTypeName, '.', fld.mRecRefId, ')');
2668 fld.mRecRefId := '';
2669 fld.mRecRef := rt;
2670 fld.mDefined := true;
2671 end;
2672 for fld in rec.mFields do
2673 begin
2674 //writeln(' ', fld.mName);
2675 fld.fixDefaultValue(); // just in case
2676 end;
2677 end;
2678
2679 begin
2680 if (mOwner = nil) then raise Exception.Create(Format('can''t parse record ''%s'' value without owner', [mName]));
2681
2682 {$IF DEFINED(D2D_DYNREC_PROFILER)}stall := curTimeMicro();{$ENDIF}
2683
2684 // not a header?
2685 if not mHeader then
2686 begin
2687 // id?
2688 if (not beginEaten) and (pr.tokType = pr.TTId) then mId := pr.expectId();
2689 end
2690 else
2691 begin
2692 assert(mHeaderRec = self);
2693 end;
2694
2695 //writeln('parsing record <', mName, '>');
2696 if not beginEaten then pr.expectTT(pr.TTBegin);
2697 while (pr.tokType <> pr.TTEnd) do
2698 begin
2699 if (pr.tokType <> pr.TTId) then raise Exception.Create('identifier expected');
2700 //writeln('<', mName, '.', pr.tokStr, '>');
2701
2702 // records
2703 if mHeader then
2704 begin
2705 // add records with this type (if any)
2706 {$IF DEFINED(D2D_DYNREC_PROFILER)}stt := curTimeMicro();{$ENDIF}
2707 trc := mOwner.findRecType(pr.tokStr);
2708 {$IF DEFINED(D2D_DYNREC_PROFILER)}profFindRecType := curTimeMicro()-stt;{$ENDIF}
2709 if (trc <> nil) then
2710 begin
2711 {$IF DEFINED(D2D_DYNREC_PROFILER)}stt := curTimeMicro();{$ENDIF}
2712 rec := trc.clone(mHeaderRec);
2713 {$IF DEFINED(D2D_DYNREC_PROFILER)}profCloneRec := curTimeMicro()-stt;{$ENDIF}
2714 rec.mHeaderRec := mHeaderRec;
2715 try
2716 pr.skipToken();
2717 rec.parseValue(pr);
2718 (*
2719 if (Length(rec.mId) > 0) then
2720 begin
2721 {$IF DEFINED(D2D_DYNREC_PROFILER)}stt := curTimeMicro();{$ENDIF}
2722 fld := field[pr.tokStr];
2723 {$IF DEFINED(D2D_DYNREC_PROFILER)}profFieldSearching := curTimeMicro()-stt;{$ENDIF}
2724 (*
2725 if (fld <> nil) and (fld.mRVal <> nil) then
2726 begin
2727 {$IF DEFINED(D2D_DYNREC_PROFILER)}stt := curTimeMicro();{$ENDIF}
2728 //idtmp := trc.mName+':'+rec.mId;
2729 //if ids.put(idtmp, 1) then raise Exception.Create(Format('duplicate thing ''%s'' in record ''%s''', [fld.mName, mName]));
2730 if fld.mRHash.has(rec.mId) then raise Exception.Create(Format('duplicate thing ''%s'' in record ''%s''', [fld.mName, mName]));
2731 {$IF DEFINED(D2D_DYNREC_PROFILER)}profListDupChecking := curTimeMicro()-stt;{$ENDIF}
2732 end;
2733 end;
2734 *)
2735 {$IF DEFINED(D2D_DYNREC_PROFILER)}stt := curTimeMicro();{$ENDIF}
2736 addRecordByType(rec.mName, rec);
2737 {$IF DEFINED(D2D_DYNREC_PROFILER)}profAddRecByType := curTimeMicro()-stt;{$ENDIF}
2738 rec := nil;
2739 finally
2740 rec.Free();
2741 end;
2742 continue;
2743 end;
2744 end;
2745
2746 // fields
2747 {$IF DEFINED(D2D_DYNREC_PROFILER)}stt := curTimeMicro();{$ENDIF}
2748 //writeln('0: <', mName, '.', pr.tokStr, '>');
2749 fld := field[pr.tokStr];
2750 //writeln('1: <', mName, '.', pr.tokStr, '>');
2751 {$IF DEFINED(D2D_DYNREC_PROFILER)}profFieldSearching := curTimeMicro()-stt;{$ENDIF}
2752 if (fld <> nil) then
2753 begin
2754 //writeln('2: <', mName, '.', pr.tokStr, '>');
2755 if fld.defined then raise Exception.Create(Format('duplicate field ''%s'' in record ''%s''', [fld.mName, mName]));
2756 if fld.internal then raise Exception.Create(Format('internal field ''%s'' in record ''%s''', [fld.mName, mName]));
2757 pr.skipToken(); // skip field name
2758 //writeln('3: <', mName, '.', pr.tokStr, '>:', pr.tokType);
2759 {$IF DEFINED(D2D_DYNREC_PROFILER)}stt := curTimeMicro();{$ENDIF}
2760 fld.parseValue(pr);
2761 {$IF DEFINED(D2D_DYNREC_PROFILER)}profFieldValParsing := curTimeMicro()-stt;{$ENDIF}
2762 continue;
2763 end;
2764
2765 // something is wrong
2766 raise Exception.Create(Format('unknown field ''%s'' in record ''%s''', [pr.tokStr, mName]));
2767 end;
2768 pr.expectTT(pr.TTEnd);
2769
2770 if mHeader then
2771 begin
2772 // link fields
2773 for fld in mFields do
2774 begin
2775 if (fld.mType <> TDynField.TType.TList) then continue;
2776 for rec in fld.mRVal do linkNames(rec);
2777 end;
2778 end;
2779
2780 // fix field defaults
2781 {$IF DEFINED(D2D_DYNREC_PROFILER)}stt := curTimeMicro();{$ENDIF}
2782 for fld in mFields do fld.fixDefaultValue();
2783 {$IF DEFINED(D2D_DYNREC_PROFILER)}profFixDefaults := curTimeMicro()-stt;{$ENDIF}
2784 //writeln('done parsing record <', mName, '>');
2785 //{$IF DEFINED(D2D_DYNREC_PROFILER)}writeln('stall: ', curTimeMicro()-stall);{$ENDIF}
2786 {$IF DEFINED(D2D_DYNREC_PROFILER)}profRecValParse := curTimeMicro()-stall;{$ENDIF}
2787 end;
2788
2789
2790 // ////////////////////////////////////////////////////////////////////////// //
2791 constructor TDynEBS.Create (pr: TTextParser);
2792 begin
2793 cleanup();
2794 parseDef(pr);
2795 end;
2796
2797
2798 destructor TDynEBS.Destroy ();
2799 begin
2800 cleanup();
2801 inherited;
2802 end;
2803
2804
2805 procedure TDynEBS.cleanup ();
2806 begin
2807 mIsEnum := false;
2808 mName := '';
2809 mIds := nil;
2810 mVals := nil;
2811 mMaxName := '';
2812 mMaxVal := 0;
2813 end;
2814
2815
2816 function TDynEBS.findByName (const aname: AnsiString): Integer;
2817 begin
2818 result := 0;
2819 while (result < Length(mIds)) do
2820 begin
2821 if StrEqu(aname, mIds[result]) then exit;
2822 Inc(result);
2823 end;
2824 result := -1;
2825 end;
2826
2827
2828 function TDynEBS.hasByName (const aname: AnsiString): Boolean; inline;
2829 begin
2830 result := (findByName(aname) >= 0);
2831 end;
2832
2833
2834 function TDynEBS.getFieldByName (const aname: AnsiString): Integer; inline;
2835 var
2836 f: Integer;
2837 begin
2838 f := findByName(aname);
2839 if (f >= 0) then result := mVals[f] else result := 0;
2840 end;
2841
2842
2843 function TDynEBS.definition (): AnsiString;
2844 var
2845 f, cv: Integer;
2846 begin
2847 if mIsEnum then result :='enum ' else result := 'bitset ';
2848 result += mName;
2849 result += ' {'#10;
2850 // fields
2851 if mIsEnum then cv := 0 else cv := 1;
2852 for f := 0 to High(mIds) do
2853 begin
2854 if (mIds[f] = mMaxName) then continue;
2855 result += ' '+mIds[f];
2856 if (mVals[f] <> cv) then
2857 begin
2858 result += Format(' = %d', [mVals[f]]);
2859 if mIsEnum then cv := mVals[f];
2860 result += ','#10;
2861 end
2862 else
2863 begin
2864 result += Format(', // %d'#10, [mVals[f]]);
2865 end;
2866 if mIsEnum then Inc(cv) else if (mVals[f] = cv) then cv := cv shl 1;
2867 end;
2868 // max field
2869 if (Length(mMaxName) > 0) then result += ' '+mMaxName+' = MAX,'#10;
2870 result += '}';
2871 end;
2872
2873
2874 function TDynEBS.pasdef (): AnsiString;
2875 var
2876 f: Integer;
2877 begin
2878 result := '// '+mName+#10'const'#10;
2879 // fields
2880 for f := 0 to High(mIds) do
2881 begin
2882 result += formatstrf(' %s = %d;'#10, [mIds[f], mVals[f]]);
2883 end;
2884 end;
2885
2886
2887 function TDynEBS.nameByValue (v: Integer): AnsiString;
2888 var
2889 f: Integer;
2890 begin
2891 for f := 0 to High(mVals) do
2892 begin
2893 if (mVals[f] = v) then begin result := mIds[f]; exit; end;
2894 end;
2895 result := '';
2896 end;
2897
2898
2899 procedure TDynEBS.parseDef (pr: TTextParser);
2900 var
2901 idname: AnsiString;
2902 cv, v: Integer;
2903 f: Integer;
2904 skipAdd: Boolean;
2905 hasV: Boolean;
2906 begin
2907 if pr.eatId('enum') then mIsEnum := true
2908 else if pr.eatId('bitset') then mIsEnum := false
2909 else pr.expectId('enum');
2910 mName := pr.expectId();
2911 mMaxVal := Integer($80000000);
2912 if mIsEnum then cv := 0 else cv := 1;
2913 pr.expectTT(pr.TTBegin);
2914 while (pr.tokType <> pr.TTEnd) do
2915 begin
2916 idname := pr.expectId();
2917 for f := 0 to High(mIds) do
2918 begin
2919 if StrEqu(mIds[f], idname) then raise Exception.Create(Format('duplicate field ''%s'' in enum/bitset ''%s''', [idname, mName]));
2920 end;
2921 if StrEqu(mMaxName, idname) then raise Exception.Create(Format('duplicate field ''%s'' in enum/bitset ''%s''', [idname, mName]));
2922 skipAdd := false;
2923 hasV := false;
2924 v := cv;
2925 // has value?
2926 if pr.eatDelim('=') then
2927 begin
2928 if pr.eatId('MAX') then
2929 begin
2930 if (Length(mMaxName) > 0) then raise Exception.Create(Format('duplicate max field ''%s'' in enum/bitset ''%s''', [idname, mName]));
2931 mMaxName := idname;
2932 skipAdd := true;
2933 end
2934 else
2935 begin
2936 v := pr.expectInt();
2937 if mIsEnum then cv := v;
2938 hasV := true;
2939 end;
2940 end;
2941 // append it?
2942 if not skipAdd then
2943 begin
2944 // fix maxvalue
2945 if mIsEnum or (not hasV) then
2946 begin
2947 if (mMaxVal < v) then mMaxVal := v;
2948 end;
2949 SetLength(mIds, Length(mIds)+1);
2950 mIds[High(mIds)] := idname;
2951 SetLength(mVals, Length(mIds));
2952 mVals[High(mVals)] := v;
2953 // next cv
2954 if mIsEnum or (not hasV) then
2955 begin
2956 if mIsEnum then Inc(cv) else cv := cv shl 1;
2957 end;
2958 end;
2959 if (pr.tokType = pr.TTEnd) then break;
2960 pr.expectTT(pr.TTComma);
2961 while pr.eatTT(pr.TTComma) do begin end;
2962 end;
2963 pr.expectTT(pr.TTEnd);
2964 // add max field
2965 if (Length(mMaxName) > 0) then
2966 begin
2967 SetLength(mIds, Length(mIds)+1);
2968 mIds[High(mIds)] := mMaxName;
2969 SetLength(mVals, Length(mIds));
2970 mVals[High(mVals)] := mMaxVal;
2971 end;
2972 end;
2973
2974
2975 // ////////////////////////////////////////////////////////////////////////// //
2976 constructor TDynMapDef.Create (pr: TTextParser);
2977 begin
2978 recTypes := TDynRecList.Create();
2979 trigTypes := TDynRecList.Create();
2980 ebsTypes := TDynEBSList.Create();
2981 parseDef(pr);
2982 end;
2983
2984
2985 destructor TDynMapDef.Destroy ();
2986 var
2987 rec: TDynRecord;
2988 ebs: TDynEBS;
2989 begin
2990 for rec in recTypes do rec.Free();
2991 for rec in trigTypes do rec.Free();
2992 for ebs in ebsTypes do ebs.Free();
2993 recTypes.Free();
2994 trigTypes.Free();
2995 ebsTypes.Free();
2996 recTypes := nil;
2997 trigTypes := nil;
2998 ebsTypes := nil;
2999 inherited;
3000 end;
3001
3002
3003 function TDynMapDef.getHeaderRecType (): TDynRecord; inline;
3004 begin
3005 if (recTypes.count = 0) then raise Exception.Create('no header in empty mapdef');
3006 result := recTypes[0];
3007 end;
3008
3009
3010 function TDynMapDef.findRecType (const aname: AnsiString): TDynRecord;
3011 var
3012 rec: TDynRecord;
3013 begin
3014 for rec in recTypes do
3015 begin
3016 if StrEqu(rec.name, aname) then begin result := rec; exit; end;
3017 end;
3018 result := nil;
3019 end;
3020
3021
3022 function TDynMapDef.findTrigFor (const aname: AnsiString): TDynRecord;
3023 var
3024 rec: TDynRecord;
3025 begin
3026 for rec in trigTypes do
3027 begin
3028 if (rec.isForTrig[aname]) then begin result := rec; exit; end;
3029 end;
3030 result := nil;
3031 end;
3032
3033
3034 function TDynMapDef.findEBSType (const aname: AnsiString): TDynEBS;
3035 var
3036 ebs: TDynEBS;
3037 begin
3038 for ebs in ebsTypes do
3039 begin
3040 if StrEqu(ebs.name, aname) then begin result := ebs; exit; end;
3041 end;
3042 result := nil;
3043 end;
3044
3045
3046 procedure TDynMapDef.parseDef (pr: TTextParser);
3047 var
3048 rec, hdr: TDynRecord;
3049 eb: TDynEBS;
3050 f: Integer;
3051
3052 // setup header links and type links
3053 procedure linkRecord (rec: TDynRecord);
3054 var
3055 fld: TDynField;
3056 begin
3057 rec.mHeaderRec := recTypes[0];
3058 for fld in rec.mFields do
3059 begin
3060 if (fld.mType = fld.TType.TTrigData) then continue;
3061 case fld.mEBS of
3062 TDynField.TEBS.TNone: begin end;
3063 TDynField.TEBS.TRec:
3064 begin
3065 fld.mEBSType := findRecType(fld.mEBSTypeName);
3066 if (fld.mEBSType = nil) then raise Exception.Create(Format('field ''%s'' of type ''%s'' has no correcponding record definition', [fld.mName, fld.mEBSTypeName]));
3067 end;
3068 TDynField.TEBS.TEnum,
3069 TDynField.TEBS.TBitSet:
3070 begin
3071 fld.mEBSType := findEBSType(fld.mEBSTypeName);
3072 if (fld.mEBSType = nil) then raise Exception.Create(Format('field ''%s'' of type ''%s'' has no correcponding enum/bitset', [fld.mName, fld.mEBSTypeName]));
3073 if ((fld.mEBS = TDynField.TEBS.TEnum) <> (fld.mEBSType as TDynEBS).mIsEnum) then raise Exception.Create(Format('field ''%s'' of type ''%s'' enum/bitset type conflict', [fld.mName, fld.mEBSTypeName]));
3074 end;
3075 end;
3076 end;
3077 end;
3078
3079 // setup default values
3080 procedure fixRecordDefaults (rec: TDynRecord);
3081 var
3082 fld: TDynField;
3083 begin
3084 for fld in rec.mFields do if fld.mHasDefault then fld.parseDefaultValue();
3085 end;
3086
3087 begin
3088 hdr := nil;
3089 while true do
3090 begin
3091 if not pr.skipBlanks() then break;
3092 if (pr.tokType <> pr.TTId) then raise Exception.Create('identifier expected');
3093
3094 if (pr.tokStr = 'enum') or (pr.tokStr = 'bitset') then
3095 begin
3096 eb := TDynEBS.Create(pr);
3097 if (findEBSType(eb.name) <> nil) then
3098 begin
3099 eb.Free();
3100 raise Exception.Create(Format('duplicate enum/bitset ''%s''', [eb.name]));
3101 end;
3102 eb.mOwner := self;
3103 ebsTypes.append(eb);
3104 //writeln(eb.definition); writeln;
3105 continue;
3106 end;
3107
3108 if (pr.tokStr = 'TriggerData') then
3109 begin
3110 rec := TDynRecord.Create(pr);
3111 for f := 0 to High(rec.mTrigTypes) do
3112 begin
3113 if (findTrigFor(rec.mTrigTypes[f]) <> nil) then
3114 begin
3115 rec.Free();
3116 raise Exception.Create(Format('duplicate trigdata ''%s''', [rec.mTrigTypes[f]]));
3117 end;
3118 end;
3119 rec.mOwner := self;
3120 trigTypes.append(rec);
3121 //writeln(dr.definition); writeln;
3122 continue;
3123 end;
3124
3125 rec := TDynRecord.Create(pr);
3126 //writeln(dr.definition); writeln;
3127 if (findRecType(rec.name) <> nil) then begin rec.Free(); raise Exception.Create(Format('duplicate record ''%s''', [rec.name])); end;
3128 if (hdr <> nil) and StrEqu(rec.name, hdr.name) then begin rec.Free(); raise Exception.Create(Format('duplicate record ''%s''', [rec.name])); end;
3129 rec.mOwner := self;
3130 if rec.mHeader then
3131 begin
3132 if (hdr <> nil) then begin rec.Free(); raise Exception.Create(Format('duplicate header record ''%s'' (previous is ''%s'')', [rec.name, hdr.name])); end;
3133 hdr := rec;
3134 end
3135 else
3136 begin
3137 recTypes.append(rec);
3138 end;
3139 end;
3140
3141 // put header record to top
3142 if (hdr = nil) then raise Exception.Create('header definition not found in mapdef');
3143 recTypes.append(nil);
3144 for f := recTypes.count-1 downto 1 do recTypes[f] := recTypes[f-1];
3145 recTypes[0] := hdr;
3146
3147 // setup header links and type links
3148 for rec in recTypes do linkRecord(rec);
3149 for rec in trigTypes do linkRecord(rec);
3150
3151 // setup default values
3152 for rec in recTypes do fixRecordDefaults(rec);
3153 for rec in trigTypes do fixRecordDefaults(rec);
3154 end;
3155
3156
3157 // ////////////////////////////////////////////////////////////////////////// //
3158 function TDynMapDef.parseMap (pr: TTextParser): TDynRecord;
3159 var
3160 res: TDynRecord = nil;
3161 begin
3162 result := nil;
3163 try
3164 pr.expectId(headerType.name);
3165 res := headerType.clone(nil);
3166 res.mHeaderRec := res;
3167 res.parseValue(pr);
3168 result := res;
3169 res := nil;
3170 finally
3171 //TMP:segfaults! res.Free();
3172 end;
3173 end;
3174
3175
3176 function TDynMapDef.parseBinMap (st: TStream): TDynRecord;
3177 var
3178 res: TDynRecord = nil;
3179 begin
3180 result := nil;
3181 try
3182 res := headerType.clone(nil);
3183 res.mHeaderRec := res;
3184 res.parseBinValue(st);
3185 result := res;
3186 res := nil;
3187 finally
3188 res.Free();
3189 end;
3190 end;
3191
3192
3193 function TDynMapDef.pasdef (): AnsiString;
3194 var
3195 ebs: TDynEBS;
3196 rec: TDynRecord;
3197 fld: TDynField;
3198 needComma: Boolean;
3199 tn: AnsiString;
3200 begin
3201 result := '';
3202 result += '// ////////////////////////////////////////////////////////////////////////// //'#10;
3203 result += '// enums and bitsets'#10;
3204 for ebs in ebsTypes do result += #10+ebs.pasdef();
3205 result += #10#10'// ////////////////////////////////////////////////////////////////////////// //'#10;
3206 result += '// records'#10'type'#10;
3207 for rec in recTypes do
3208 begin
3209 if (rec.mSize < 1) then continue;
3210 result += rec.pasdef();
3211 result += #10;
3212 end;
3213 result += #10#10'// ////////////////////////////////////////////////////////////////////////// //'#10;
3214 result += '// triggerdata'#10'type'#10;
3215 result += ' TTriggerData = record'#10;
3216 result += ' case Byte of'#10;
3217 result += ' 0: (Default: Byte128);'#10;
3218 for rec in trigTypes do
3219 begin
3220 result += ' ';
3221 needComma := false;
3222 for tn in rec.mTrigTypes do
3223 begin
3224 if needComma then result += ', ' else needComma := true;
3225 result += tn;
3226 end;
3227 result += ': ('#10;
3228 for fld in rec.mFields do
3229 begin
3230 if fld.mInternal then continue;
3231 if (fld.mBinOfs < 0) then continue;
3232 result += ' '+fld.pasdef+#10;
3233 end;
3234 result += ' );'#10;
3235 end;
3236 result += ' end;'#10;
3237 end;
3238
3239
3240 function TDynMapDef.pasdefconst (): AnsiString;
3241 var
3242 ebs: TDynEBS;
3243 begin
3244 result := '';
3245 result += '// ////////////////////////////////////////////////////////////////////////// //'#10;
3246 result += '// enums and bitsets'#10;
3247 for ebs in ebsTypes do result += #10+ebs.pasdef();
3248 end;
3249
3250
3251 function TDynMapDef.getTrigTypeCount (): Integer; inline; begin result := trigTypes.count; end;
3252 function TDynMapDef.getTrigTypeAt (idx: Integer): TDynRecord; inline; begin if (idx >= 0) and (idx < trigTypes.count) then result := trigTypes[idx] else result := nil; end;
3253
3254
3255 end.
[MIRROR] a port of Doom 2D Forever to FPC/SDL
[25/02/2024 19:55:35]
DEADSOFTWARE 2012-2024