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}
20 interface
22 uses
27 // ////////////////////////////////////////////////////////////////////////// //
28 type
30 public
36 public
39 public
45 // ////////////////////////////////////////////////////////////////////////// //
46 type
56 // this is base type for all scalars (and arrays)
58 public
59 type
60 TType = (TBool, TChar, TByte, TUByte, TShort, TUShort, TInt, TUInt, TString, TPoint, TSize, TList, TTrigData);
61 // TPoint: pair of Integers
62 // TSize: pair of UShorts
63 // TList: actually, array of records
64 // TTrigData: array of mMaxDim bytes, but internally a record (mRecRef)
65 // in binary: arrays of chars are pascal shortstrings (with counter in the first byte)
67 private
68 type
71 private
91 mAsMonsterId: Boolean; // special hack for triggers: monster record number+1 in binary (so 0 means "none")
92 // default value
99 mEBSType: TObject; // either TDynRecord or TDynEBS; nil means "simple type"; nil for `TTrigData` too
101 // for binary parser
104 // for userdata
108 // for pasgen
111 private
114 procedure parseDefaultValue (); // parse `mDefUnparsed` to `mDefSVal`, `mDefIVal`, `mDefIVal2`, `mDefRecRef`
132 protected
133 // returns `true` for duplicate record id
137 public
138 // get string name for the given type
141 public
147 // clone this field; register all list records in `registerIn`
148 // "registration" is required to manage record lifetime; use header record if in doubt
149 // owner will be set to `newOwner`, if it is not `nil`, or to `owner`
150 // for lists, cloning will clone all list members
153 // compare field values (including trigdata)
154 // WARNING: won't work for lists
157 // parse string value to appropriate type and set new field value
160 // supports `for rec in field do` (for lists)
163 public
164 // text parser and writer
168 // binary parser and writer (DO NOT USE!)
172 public
173 // the following functions are here only for 'mapgen'! DO NOT USE!
174 // build "alias name" for pascal code
177 public
183 property ival: Integer read mIVal; // integer value for int field (for speed), first field (x/w) for `TPoint` and `TSize`
186 property hasDefault: Boolean read mHasDefault; // `true` if this field has default value in mapdef
189 property ebstype: TObject read mEBSType; // reference type (nil, TDynRecord, TDynEBS); WARNING: don't modify type!
191 property recref: TDynRecord read mRecRef write setRecRef; // referenced record (actual one, you can modify it)
192 property recrefIndex: Integer read getRecRefIndex; // index of referenced record in header; -1: not found
193 // for record lists
196 property item[const aname: AnsiString]: TDynRecord read getListItem; default; // alas, FPC 3+ lost property overloading feature
197 // field value as Variant
200 public
201 // userdata (you can use these properties as you want to; they won't be written or read to files)
205 public
206 // the following properties are here only for 'mapgen'! DO NOT USE!
214 // record, either with actual values, or with type definitions
216 private
222 {$IF DEFINED(XDYNREC_USE_FIELDHASH)}
224 {$ENDIF}
228 mHeaderRec: TDynRecord; // for "value" records this is header record with data, for "type" records this is header type record
230 // for userdata
236 private
259 protected
262 function addRecordByType (const atypename: AnsiString; rc: TDynRecord): Boolean; // `true`: duplicate record id
267 public
272 // clone this record; register all list records in `registerIn`
273 // "registration" is required to manage record lifetime; use header record if in doubt
274 // all fields are cloned too
277 // compare records (values of all fields, including trigdata)
278 // WARNING: won't work for records with list fields
281 // find field with `TriggerType` type
284 // number of records of the given instance
287 // only for headers: create new record with the given type
288 // will return cloned record ready for use, or `nil` on unknown type name
289 // `aid` must not be empty, and must be unique
292 // remove record with the given type and id
293 // return `true` if record was successfully found and removed
294 // this will do all necessary recref cleanup too
295 // WARNING: not tested yet
298 //TODO:
299 // [.] API to create triggers
300 // [.] API to properly remove triggers (remove trigdata)
301 // [.] check if `removeTypedRecord()` does the right thing with inline records
302 // [.] for fields: assigning `recref` should remove previously assigned inline record (record without id)
303 // [.] other API i forgot
305 public
306 // text parser
307 // `beginEaten`: `true` if "{" was eaten
310 // text writer
311 // `putHeader`: `true` to write complete header, otherwise only "{...}"
314 // binary parser and writer (DO NOT USE!)
318 public
322 property has[const aname: AnsiString]: Boolean read hasByName; // do we have field with the given name?
324 property field[const aname: AnsiString]: TDynField read getFieldByName; default; // get field by name
327 property isForTrig[const aname: AnsiString]: Boolean read getIsForTrig; // can this "TriggerData" be used for the trigger with the given type?
328 property forTrigCount: Integer read getForTrigCount; // number of trigger type names for "TriggerData"
329 property forTrigAt[idx: Integer]: AnsiString read getForTrigAt; // trigger type name at the given index for "TriggerData"
330 property headerRec: TDynRecord read mHeaderRec; // get header record for this one (header contains all other records, enums, bitsets, etc.)
333 public
334 // user fields; user can add arbitrary custom fields
335 // by default, any user field will be marked as "internal"
336 // note: you can use this to manipulate non-user fields too
339 public
340 // userdata (you can use these properties as you want to; they won't be written or read to files)
346 // bitset/enum definition
348 private
357 private
369 public
373 // find name for the given value
374 // return empty string if not found
377 public
386 // parsed "mapdef.txt"
388 public
393 private
407 // creates new header record
410 // creates new header record
413 public
421 public
422 // parse text or binary map, return new header record
423 // WARNING! stream must be seekable
426 // returns `true` if the given stream can be a map file
427 // stream position is 0 on return
428 // WARNING! stream must be seekable
431 public
432 // the following functions are here only for 'mapgen'! DO NOT USE!
435 public
437 // for record types
441 // for enum/bitset types
445 // for trigtypes
452 {$IF DEFINED(D2D_DYNREC_PROFILER)}
454 {$ENDIF}
457 implementation
459 uses
460 e_log
464 // ////////////////////////////////////////////////////////////////////////// //
468 // ////////////////////////////////////////////////////////////////////////// //
470 begin
475 begin
480 // ////////////////////////////////////////////////////////////////////////// //
482 begin
483 if (pr <> nil) then begin tokLine := pr.tokLine; tokCol := pr.tokCol; end else begin tokLine := 0; tokCol := 0; end;
487 constructor TDynParseException.CreateFmt (pr: TTextParser; const afmt: AnsiString; const args: array of const);
488 begin
489 if (pr <> nil) then begin tokLine := pr.tokLine; tokCol := pr.tokCol; end else begin tokLine := 0; tokCol := 0; end;
494 // ////////////////////////////////////////////////////////////////////////// //
496 begin
497 //result := TListEnumerator.Create(mRVal);
498 if (mRVal <> nil) then result := mRVal.GetEnumerator else result := TDynRecList.TEnumerator.Create(nil, 0);
502 // ////////////////////////////////////////////////////////////////////////// //
504 begin
512 begin
520 begin
528 begin
552 else
556 begin
593 begin
600 begin
638 var
640 begin
650 begin
683 var
686 begin
688 begin
689 if firstUp then result := UpCase1251(mAlias[1])+Copy(mAlias, 2, Length(mAlias)-1) else result := mAlias;
690 end
691 else
692 begin
696 begin
706 var
708 begin
710 TEBS.TNone: raise TDynRecException.CreateFmt('cannot set refrec for non-reference field ''%s''', [mName]);
712 begin
714 begin
716 if (trc = nil) then raise TDynRecException.CreateFmt('cannot set refrec for field ''%s'' (type conflict: improperly initialized field)', [mName]);
717 if (trc.typeName <> arec.typeName) then raise TDynRecException.CreateFmt('cannot set refrec for field ''%s'' (type conflict: expected ''%s'' got ''%s'')', [mName, trc.typeName, arec.typeName]);
721 exit;
723 TEBS.TEnum: raise TDynRecException.CreateFmt('cannot set refrec for enum field ''%s''', [mName]);
724 TEBS.TBitSet: raise TDynRecException.CreateFmt('cannot set refrec for bitset field ''%s''', [mName]);
731 begin
747 else result := Unassigned; raise TDynRecException.Create('ketmar forgot to handle some field type');
754 begin
778 else
782 begin
793 varString:
795 begin
797 end
798 else
799 begin
803 varBoolean:
815 else
820 varByte,
821 varWord,
822 varShortInt,
823 varSmallint,
824 varInteger:
826 varInt64:
829 else
831 varLongWord:
832 if (val > LongWord($7FFFFFFF)) then raise TDynRecException.Create('cannot convert longword variant to field value')
842 // won't work for lists
844 begin
862 begin
872 var
874 begin
876 try
878 finally
885 var
891 begin
893 begin
898 end
899 else
900 begin
906 try
913 finally
925 // default value should be parsed
927 begin
930 begin
932 raise TDynRecException.CreateFmt('field ''%s'' in record ''%s'' of record type ''%s'' is not set', [mName, mOwner.mId, mOwner.mTypeName]);
942 // default value should be parsed
944 begin
957 begin
963 begin
964 if (mRVal <> nil) and (idx >= 0) and (idx < mRVal.count) then result := mRVal[idx] else result := nil;
969 var
971 begin
977 begin
980 begin
988 var
990 begin
993 begin
996 // fix hash and list
998 begin
1008 begin
1029 begin
1039 TEBS.TBitSet: begin result += ' bitset '; if mBitSetUnique then result += 'unique '; result += mEBSTypeName; end;
1044 begin
1045 if (mType = TType.TPoint) then begin if (mAsT) then result += ' as txy' else result += ' as xy'; end
1046 else if (mType = TType.TSize) then begin if (mAsT) then result += ' as twh' else result += ' as wh'; end;
1054 var
1073 begin
1099 begin
1101 begin
1102 if (Length(fldtype) > 0) then raise TDynParseException.CreateFmt(pr, 'duplicate type definition for field ''%s''', [fldname]);
1107 begin
1109 // arbitrary limits
1110 if (lmaxdim < 1) or (lmaxdim > 32768) then raise TDynParseException.CreateFmt(pr, 'invalid field ''%s'' array size', [fldname]);
1112 end;
1113 continue;
1117 begin
1118 if (Length(xalias) > 0) then raise TDynParseException.CreateFmt(pr, 'duplicate alias definition for field ''%s''', [fldname]);
1120 continue;
1124 begin
1125 if (fldofs >= 0) then raise TDynParseException.CreateFmt(pr, 'duplicate field ''%s'' offset', [fldname]);
1127 if (fldofs < 0) then raise TDynParseException.CreateFmt(pr, 'invalid field ''%s'' offset', [fldname]);
1128 continue;
1132 begin
1139 continue;
1140 end;
1143 begin
1145 if (Length(fldrecname) <> 0) then raise TDynParseException.CreateFmt(pr, 'field ''%s'' already typed as ''%s''', [fldname, fldrecname]);
1147 continue;
1151 begin
1153 if (Length(fldrecname) <> 0) then raise TDynParseException.CreateFmt(pr, 'field ''%s'' already typed as ''%s''', [fldname, fldrecname]);
1156 continue;
1160 begin
1161 if hasdefStr or hasdefInt or hasdefId then raise TDynParseException.CreateFmt(pr, 'field ''%s'' has duplicate default', [fldname]);
1164 begin
1169 begin
1174 begin
1179 begin
1186 else
1189 continue;
1193 begin
1195 continue;
1199 begin
1201 continue;
1204 // record type, no special modifiers
1205 if (pr.tokType <> pr.TTId) then raise TDynParseException.CreateFmt(pr, 'field ''%s'' has something unexpected in definition', [fldname]);
1207 if (Length(fldrecname) <> 0) then raise TDynParseException.CreateFmt(pr, 'field ''%s'' already typed as ''%s''', [fldname, fldrecname]);
1214 // create field
1229 else
1230 begin
1231 // record types defaults to int
1233 begin
1235 end
1236 else
1237 begin
1238 if (Length(fldtype) = 0) then raise TDynParseException.CreateFmt(pr, 'field ''%s'' has no type', [fldname])
1239 else raise TDynParseException.CreateFmt(pr, 'field ''%s'' has invalid type ''%s''', [fldname, fldtype]);
1243 // check for valid arrays
1244 if (lmaxdim > 0) and (mType <> TType.TChar) and (mType <> TType.TTrigData) then raise TDynParseException.CreateFmt(pr, 'field ''%s'' of type ''%s'' cannot be array', [fldname, fldtype]);
1246 // check for valid trigdata or record type
1248 begin
1249 // trigdata
1250 if (lmaxdim < 1) then raise TDynParseException.CreateFmt(pr, 'field ''%s'' of type ''%s'' cannot be non-array', [fldname, 'trigdata']);
1251 if (Length(fldrecname) > 0) then raise TDynParseException.CreateFmt(pr, 'field ''%s'' of type ''%s'' cannot have another type', [fldname, 'trigdata']);
1253 end
1255 begin
1256 // record
1257 if not (mType in [TType.TByte, TType.TUByte, TType.TShort, TType.TUShort, TType.TInt, TType.TUInt]) then
1258 begin
1259 raise TDynParseException.CreateFmt(pr, 'field ''%s'' of record type ''%s'' cannot have type ''%s''', [fldname, fldrecname, fldtype]);
1263 // setup default value
1267 begin
1285 end;
1289 begin
1296 var
1302 begin
1306 begin
1308 begin
1309 // this must be triggerdata
1311 begin
1312 raise TDynRecException.CreateFmt('record reference type ''%s'' in field ''%s'' cannot be written', [mEBSTypeName, mName]);
1314 // write triggerdata
1316 if (buf = nil) then raise TDynRecException.CreateFmt('record reference type ''%s'' in field ''%s'' cannot be written', [mEBSTypeName, mName]);
1317 try
1320 begin
1325 finally
1329 exit;
1331 // record reference
1339 else raise TDynRecException.CreateFmt('record reference type ''%s'' in field ''%s'' cannot be written', [mEBSTypeName, mName]);
1341 // find record number
1343 begin
1345 if (f < 0) then raise TDynRecException.CreateFmt('record reference type ''%s'' in field ''%s'' not found in record list', [mEBSTypeName, mName]);
1347 if (f > maxv) then raise TDynRecException.CreateFmt('record reference type ''%s'' in field ''%s'' has too big index', [mEBSTypeName, mName]);
1348 end
1349 else
1350 begin
1357 else raise TDynRecException.CreateFmt('record reference type ''%s'' in field ''%s'' cannot be written', [mEBSTypeName, mName]);
1359 exit;
1368 begin
1370 begin
1372 end
1373 else
1374 begin
1377 exit;
1380 begin
1381 if (mMaxDim = 0) then raise TDynRecException.CreateFmt('invalid string size definition for field ''%s''', [mName]);
1383 begin
1384 if (Length(mSVal) <> 1) then raise TDynRecException.CreateFmt('invalid string size definition for field ''%s''', [mName]);
1386 end
1387 else
1388 begin
1389 if (Length(mSVal) > mMaxDim) then raise TDynRecException.CreateFmt('invalid string size definition for field ''%s''', [mName]);
1394 exit;
1398 begin
1399 // triggerdata array was processed earlier
1400 if (mMaxDim >= 0) then TDynRecException.CreateFmt('byte array in field ''%s'' cannot be written', [mName]);
1402 exit;
1406 begin
1407 if (mMaxDim >= 0) then raise TDynRecException.CreateFmt('short array in field ''%s'' cannot be written', [mName]);
1409 exit;
1413 begin
1414 if (mMaxDim >= 0) then raise TDynRecException.CreateFmt('int array in field ''%s'' cannot be written', [mName]);
1416 exit;
1419 begin
1423 begin
1424 if (mMaxDim >= 0) then raise TDynRecException.CreateFmt('pos/size array in field ''%s'' cannot be written', [mName]);
1427 exit;
1430 begin
1431 if (mMaxDim >= 0) then raise TDynRecException.CreateFmt('pos/size array in field ''%s'' cannot be written', [mName]);
1434 exit;
1437 begin
1439 exit;
1442 begin
1444 exit;
1452 var
1456 begin
1462 begin
1464 begin
1466 end
1468 begin
1470 end
1471 else
1472 begin
1476 exit;
1479 begin
1480 //def := mOwner.mOwner;
1481 //es := def.ebsType[mEBSTypeName];
1484 if (es = nil) or (not es.mIsEnum) then raise TDynRecException.CreateFmt('record enum type ''%s'' for field ''%s'' not found', [mEBSTypeName, mName]);
1486 begin
1488 begin
1491 exit;
1494 raise TDynRecException.CreateFmt('value %d in record enum type ''%s'' for field ''%s'' not found', [mIVal, mEBSTypeName, mName]);
1497 begin
1498 //def := mOwner.mOwner;
1499 //es := def.ebsType[mEBSTypeName];
1502 if (es = nil) or es.mIsEnum then raise TDynRecException.CreateFmt('record bitset type ''%s'' for field ''%s'' not found', [mEBSTypeName, mName]);
1503 // none?
1505 begin
1507 begin
1509 begin
1512 exit;
1515 raise TDynRecException.CreateFmt('value %d in record bitset type ''%s'' for field ''%s'' not found', [0, mEBSTypeName, mName]);
1517 // not none
1521 begin
1523 begin
1526 begin
1528 begin
1532 break;
1535 if not found then raise TDynRecException.CreateFmt('value %d in record bitset type ''%s'' for field ''%s'' not found', [mask, mEBSTypeName, mName]);
1540 exit;
1547 begin
1549 exit;
1552 begin
1553 if (mMaxDim = 0) then raise TDynRecException.CreateFmt('invalid string size definition for field ''%s''', [mName]);
1556 exit;
1564 begin
1566 exit;
1569 begin
1572 exit;
1576 begin
1578 exit;
1581 begin
1583 exit;
1586 begin
1588 exit;
1597 var
1604 begin
1608 begin
1609 // this must be triggerdata
1611 begin
1614 // find trigger definition
1616 if (tfld = nil) then raise TDynRecException.CreateFmt('triggerdata value for field ''%s'' in record ''%s'' without TriggerType field', [mName, rec.mTypeName]);
1618 if (rc = nil) then raise TDynRecException.CreateFmt('triggerdata definition for field ''%s'' in record ''%s'' with type ''%s'' not found', [mName, rec.mTypeName, tfld.mSVal]);
1621 // on error, it will be freed by memowner
1625 exit;
1626 end
1627 else
1628 begin
1629 // not a trigger data
1637 else raise TDynRecException.CreateFmt('invalid non-numeric type ''%s'' for field ''%s'' of record ''%s''', [getTypeName(mType), mName, mEBSTypeName]);
1643 exit;
1647 begin
1656 else raise TDynRecException.CreateFmt('invalid non-numeric type ''%s'' for field ''%s'' of record ''%s''', [getTypeName(mType), mName, mEBSTypeName]);
1660 if (es = nil) or (es.mIsEnum <> (mEBS = TEBS.TEnum)) then raise TDynRecException.CreateFmt('record enum type ''%s'' for field ''%s'' not found', [mEBSTypeName, mName]);
1662 // build enum/bitfield values
1664 begin
1666 if (Length(mSVal) = 0) then raise TDynRecException.CreateFmt('record enum type ''%s'' for field ''%s'' has invalid value %d', [mEBSTypeName, mName, mIVal]);
1667 end
1668 else
1669 begin
1670 // special for 'none'
1672 begin
1674 if (Length(mSVal) = 0) then raise TDynRecException.CreateFmt('record bitset type ''%s'' for field ''%s'' has invalid value %d', [mEBSTypeName, mName, mIVal]);
1675 end
1676 else
1677 begin
1681 begin
1683 begin
1685 if (Length(s) = 0) then raise TDynRecException.CreateFmt('record bitset type ''%s'' for field ''%s'' has invalid value %d', [mEBSTypeName, mName, mask]);
1693 //writeln('ebs <', es.mName, '>: ', mSVal);
1695 exit;
1702 begin
1708 exit;
1711 begin
1713 begin
1715 end
1716 else
1717 begin
1720 try
1725 begin
1730 finally
1735 exit;
1744 begin
1746 exit;
1749 begin
1753 exit;
1756 begin
1760 exit;
1763 begin
1765 exit;
1768 begin
1770 exit;
1781 begin
1783 if (mIVal < min) or (mIVal > max) then raise TDynParseException.CreateFmt(pr, 'invalid %s value for field ''%s''', [getTypeName(mType), mName]);
1787 var
1793 begin
1796 // if this field should contain struct, convert type and parse struct
1800 begin
1801 // ugly hack. sorry.
1803 begin
1806 begin
1807 // '{}'
1810 end
1811 else
1812 begin
1814 // find trigger definition
1816 if (tfld = nil) then raise TDynParseException.CreateFmt(pr, 'triggerdata value for field ''%s'' in record ''%s'' without ''type'' field', [mName, rec.mTypeName]);
1818 if (rc = nil) then raise TDynParseException.CreateFmt(pr, 'triggerdata definition for field ''%s'' in record ''%s'' with type ''%s'' not found', [mName, rec.mTypeName, tfld.mSVal]);
1821 //writeln(rc.definition);
1822 // on error, it will be freed by memowner
1828 exit;
1830 // other record types
1832 begin
1834 begin
1836 end
1837 else
1838 begin
1841 begin
1843 end
1844 else
1845 begin
1853 exit;
1854 end
1856 begin
1857 //rec := mOwner.mOwner.recType[mEBSTypeName]; // find in mapdef
1860 if (rec = nil) then raise TDynParseException.CreateFmt(pr, 'record type ''%s'' for field ''%s'' not found', [mEBSTypeName, mName]);
1867 begin
1868 raise TDynParseException.CreateFmt(pr, 'duplicate record with id ''%s'' for field ''%s'' in record ''%s''', [rc.mId, mName, mOwner.mTypeName]);
1871 exit;
1876 begin
1877 //es := mOwner.mOwner.ebsType[mEBSTypeName]; // find in mapdef
1880 if (es = nil) or (not es.mIsEnum) then raise TDynParseException.CreateFmt(pr, 'record enum type ''%s'' for field ''%s'' not found', [mEBSTypeName, mName]);
1882 if not es.has[tk] then raise TDynParseException.CreateFmt(pr, 'record enum value ''%s'' of type ''%s'' for field ''%s'' not found', [tk, mEBSTypeName, mName]);
1885 //writeln('ENUM ', mEBSName, '; element <', mSVal, '> with value ', mIVal);
1888 exit;
1891 begin
1892 //es := mOwner.mOwner.ebsType[mEBSTypeName]; // find in mapdef
1895 if (es = nil) or es.mIsEnum then raise TDynParseException.CreateFmt(pr, 'record bitset type ''%s'' for field ''%s'' not found', [mEBSTypeName, mName]);
1898 begin
1900 if not es.has[tk] then raise TDynParseException.CreateFmt(pr, 'record bitset value ''%s'' of type ''%s'' for field ''%s'' not found', [tk, mEBSTypeName, mName]);
1904 if mBitSetUnique then raise TDynParseException.CreateFmt(pr, 'record bitset of type ''%s'' for field ''%s'' expects only one value', [tk, mEBSTypeName, mName]);
1909 exit;
1916 begin
1922 exit;
1925 begin
1926 if (mMaxDim = 0) then raise TDynParseException.CreateFmt(pr, 'invalid string size definition for field ''%s''', [mName]);
1929 begin
1930 // single char
1931 if (Length(mSVal) <> 1) then raise TDynParseException.CreateFmt(pr, 'invalid string size for field ''%s''', [mName]);
1934 end
1935 else
1936 begin
1937 // string
1938 if (Length(mSVal) > mMaxDim) then raise TDynParseException.CreateFmt(pr, 'invalid string size for field ''%s''', [mName]);
1942 exit;
1945 begin
1948 exit;
1951 begin
1954 exit;
1957 begin
1960 exit;
1963 begin
1966 exit;
1969 begin
1972 exit;
1975 begin
1978 exit;
1981 begin
1985 exit;
1989 begin
1993 begin
1994 if (mIVal < 0) or (mIVal > 32767) then raise TDynParseException.CreateFmt(pr, 'invalid %s value for field ''%s''', [getTypeName(mType), mName]);
1998 begin
1999 if (mIVal2 < 0) or (mIVal2 > 32767) then raise TDynParseException.CreateFmt(pr, 'invalid %s value for field ''%s''', [getTypeName(mType), mName]);
2004 exit;
2007 begin
2009 exit;
2012 begin
2014 exit;
2022 // ////////////////////////////////////////////////////////////////////////// //
2024 begin
2025 if (pr = nil) then raise TDynParseException.Create(pr, 'cannot create record type without type definition');
2030 {$IF DEFINED(XDYNREC_USE_FIELDHASH)}
2032 {$ENDIF}
2044 begin
2048 {$IF DEFINED(XDYNREC_USE_FIELDHASH)}
2050 {$ENDIF}
2061 var
2064 begin
2066 begin
2068 begin
2070 begin
2071 //writeln(formatstrf('freeing: 0x%08x; name=%s; id=%s', [Pointer(rec), rec.mName, rec.mId]));
2082 {$IF DEFINED(XDYNREC_USE_FIELDHASH)}
2085 {$ENDIF}
2095 begin
2097 begin
2105 begin
2108 {$IF DEFINED(XDYNREC_USE_FIELDHASH)}
2110 {$ENDIF}
2114 function TDynRecord.addFieldChecked (fld: TDynField): Boolean; inline; // `true`: duplicate name
2115 begin
2118 {$IF not DEFINED(XDYNREC_USE_FIELDHASH)}
2120 {$ENDIF}
2122 {$IF DEFINED(XDYNREC_USE_FIELDHASH)}
2124 {$ENDIF}
2129 begin
2130 {$IF DEFINED(XDYNREC_USE_FIELDHASH)}
2132 {$ELSE}
2135 begin
2140 {$ENDIF}
2145 begin
2151 var
2153 begin
2160 begin
2166 begin
2172 begin
2178 var
2180 begin
2188 begin
2194 begin
2200 var
2203 begin
2215 begin
2226 var
2229 begin
2232 // find record data
2235 if (fld.mType <> fld.TType.TList) then raise TDynRecException.CreateFmt('cannot get record of type ''%s'' due to name conflict with ordinary field', [atypename]);
2236 // find by id
2238 begin
2241 // alas
2245 function TDynRecord.findRecordNumByType (const atypename: AnsiString; rc: TDynRecord): Integer;
2246 var
2249 begin
2251 // find record data
2254 if (fld.mType <> fld.TType.TList) then raise TDynRecException.CreateFmt('cannot get record of type ''%s'' due to name conflict with ordinary field', [atypename]);
2255 // find by ref
2257 begin
2259 begin
2263 // alas
2268 var
2270 begin
2271 // find record data
2274 begin
2275 // first record
2280 if (fld.mType <> fld.TType.TList) then raise TDynRecException.CreateFmt('cannot append record of type ''%s'' due to name conflict with ordinary field', [atypename]);
2281 // append
2283 begin
2292 var
2294 begin
2300 begin
2308 var
2311 begin
2313 begin
2324 // number of records of the given instance
2326 var
2328 begin
2336 var
2339 begin
2340 if not mHeader then raise TDynRecException.Create('cannot create new records with non-header');
2341 if (Length(aid) = 0) then raise TDynRecException.CreateFmt('cannot create new record of type ''%s'' without id', [atypename]);
2344 // check if aid is unique
2346 if (fld <> nil) and (fld.getListItem(aid) <> nil) then raise TDynRecException.CreateFmt('cannot create record of type ''%s'' with duplicate id ''%s''', [atypename, aid]);
2355 var
2357 begin
2362 var
2364 begin
2370 // remove record with the given type and id
2371 // return `true` if record was successfully found and removed
2372 // this will do all necessary recref cleanup too
2374 var
2379 begin
2391 begin
2393 begin
2403 var
2405 begin
2412 var
2414 begin
2417 begin
2418 if (Length(aname) = 0) then raise TDynRecException.Create('cannot create nameless user field');
2423 end
2424 else
2425 begin
2432 var
2435 begin
2437 begin
2440 begin
2442 begin
2446 if isForTrig[tdn] then raise TDynParseException.CreateFmt(pr, 'duplicate trigdata ''%s'' trigtype ''%s''', [mTypeName, tdn]);
2450 end
2451 else
2452 begin
2458 end
2459 else
2460 begin
2463 begin
2466 begin
2467 if (mSize > 0) then raise TDynParseException.CreateFmt(pr, 'duplicate `size` in record ''%s''', [mTypeName]);
2469 if (mSize < 1) then raise TDynParseException.CreateFmt(pr, 'invalid record ''%s'' size: %d', [mTypeName, mSize]);
2471 continue;
2474 begin
2475 if (mBinBlock >= 0) then raise TDynParseException.CreateFmt(pr, 'duplicate `binblock` in record ''%s''', [mTypeName]);
2477 if (mBinBlock < 1) then raise TDynParseException.CreateFmt(pr, 'invalid record ''%s'' binblock: %d', [mTypeName, mBinBlock]);
2478 continue;
2484 // load fields
2486 begin
2488 // append
2491 begin
2495 // done with field
2502 var
2504 begin
2506 begin
2507 // trigger data
2510 begin
2513 begin
2518 end
2519 else
2520 begin
2523 end
2524 else
2525 begin
2526 // record
2533 begin
2543 var
2555 var
2558 begin
2559 //writeln('*** rec: ', rec.mName, '.', rec.mId, ' (', rec.mFields.count, ')');
2561 begin
2563 begin
2565 continue;
2571 begin
2572 e_LogWritefln('record of type ''%s'' with id ''%s'' links to inexistant record of type ''%s'' with id ''%s''', [rec.mTypeName, rec.mId, fld.mEBSTypeName, fld.mRecRefId], MSG_WARNING);
2573 //raise TDynRecException.CreateFmt('record of type ''%s'' with id ''%s'' links to inexistant record of type ''%s'' with id ''%s''', [rec.mName, rec.mId, fld.mEBSTypeName, fld.mRecRefId]);
2575 //writeln(' ', rec.mName, '.', rec.mId, ':', fld.mName, ' -> ', rt.mName, '.', rt.mId, ' (', fld.mEBSTypeName, '.', fld.mRecRefId, ')');
2581 begin
2582 //writeln(' ', fld.mName);
2587 begin
2590 try
2592 begin
2593 // parse map file as sequence of blocks
2597 // parse blocks
2599 begin
2605 if (bsize < 0) or (bsize > $1fffffff) then raise TDynRecException.CreateFmt('block of type %d has invalid size %d', [btype, bsize]);
2606 if loaded[btype] then raise TDynRecException.CreateFmt('block of type %d already loaded', [btype]);
2608 // find record type for this block
2611 if (rect = nil) then raise TDynRecException.CreateFmt('block of type %d has no corresponding record', [btype]);
2612 //writeln('found type ''', rec.mName, ''' for block type ', btype);
2613 if (rec.mSize = 0) or ((bsize mod rec.mSize) <> 0) then raise TDynRecException.CreateFmt('block of type %d has invalid number of records', [btype]);
2614 // header?
2616 begin
2617 if (bsize <> mSize) then raise TDynRecException.CreateFmt('header block of type %d has invalid number of records', [btype]);
2622 end
2623 else
2624 begin
2625 // create list for this type
2630 begin
2634 begin
2641 //writeln('parsed ''', rec.mId, '''...');
2647 //st.position := st.position+bsize;
2649 // link fields
2651 begin
2655 exit;
2658 // read fields
2660 if (mSize < 1) then raise TDynRecException.CreateFmt('cannot read record of type ''%s'' with unknown size', [mTypeName]);
2664 begin
2667 if (fld.mBinOfs >= st.size) then raise TDynRecException.CreateFmt('record of type ''%s'' has invalid field ''%s''', [fld.mName]);
2669 //writeln('parsing ''', mName, '.', fld.mName, '''...');
2672 finally
2679 procedure TDynRecord.writeBinTo (st: TStream; trigbufsz: Integer=-1; onlyFields: Boolean=false);
2680 var
2686 //f, c: Integer;
2689 begin
2691 begin
2692 if (mBinBlock < 1) then raise TDynRecException.Create('cannot write binary record without block number');
2695 end
2696 else
2697 begin
2700 try
2705 // write normal fields
2707 begin
2708 // record list?
2712 if (fld.mBinOfs >= bufsz) then raise TDynRecException.Create('binary value offset is outside of the buffer');
2714 //writeln('writing field <', fld.mName, '>');
2718 // write block with normal fields
2720 begin
2721 //writeln('writing header...');
2722 // signature and version
2733 // write other blocks, if any
2735 begin
2736 // calculate blkmax
2739 begin
2740 // record list?
2742 begin
2750 // write blocks
2752 begin
2756 begin
2757 // record list?
2759 begin
2768 // flush block
2770 begin
2781 // write end marker
2786 finally
2794 var
2797 begin
2799 begin
2806 try
2808 begin
2809 // record list?
2811 begin
2814 begin
2816 begin
2822 continue;
2829 finally
2837 {$IF DEFINED(D2D_DYNREC_PROFILER)}
2838 var
2849 begin
2851 writeln('record cloning: ', profCloneRec div 1000, '.', profCloneRec mod 1000, ' milliseconds');
2852 writeln('findRecType : ', profFindRecType div 1000, '.', profFindRecType mod 1000, ' milliseconds');
2853 writeln('field[] : ', profFieldSearching div 1000, '.', profFieldSearching mod 1000, ' milliseconds');
2854 writeln('list dup check: ', profListDupChecking div 1000, '.', profListDupChecking mod 1000, ' milliseconds');
2855 writeln('addRecByType : ', profAddRecByType div 1000, '.', profAddRecByType mod 1000, ' milliseconds');
2856 writeln('field valparse: ', profFieldValParsing div 1000, '.', profFieldValParsing mod 1000, ' milliseconds');
2857 writeln('fix defaults : ', profFixDefaults div 1000, '.', profFixDefaults mod 1000, ' milliseconds');
2858 writeln('recvalparse : ', profRecValParse div 1000, '.', profRecValParse mod 1000, ' milliseconds');
2860 {$ENDIF}
2864 var
2868 {$IF DEFINED(D2D_DYNREC_PROFILER)}
2870 {$ENDIF}
2873 var
2876 begin
2877 //writeln('*** rec: ', rec.mName, '.', rec.mId, ' (', rec.mFields.count, ')');
2879 begin
2881 begin
2883 continue;
2889 begin
2890 //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);
2891 raise TDynParseException.CreateFmt(pr, 'record of type ''%s'' with id ''%s'' links to inexistant record of type ''%s'' with id ''%s''', [rec.mTypeName, rec.mId, fld.mEBSTypeName, fld.mRecRefId]);
2893 //writeln(' ', rec.mName, '.', rec.mId, ':', fld.mName, ' -> ', rt.mName, '.', rt.mId, ' (', fld.mEBSTypeName, '.', fld.mRecRefId, ')');
2899 begin
2900 //writeln(' ', fld.mName);
2905 begin
2906 if (mOwner = nil) then raise TDynParseException.CreateFmt(pr, 'can''t parse record ''%s'' value without owner', [mTypeName]);
2910 // not a header?
2912 begin
2913 // id?
2915 end
2916 else
2917 begin
2921 //writeln('parsing record <', mName, '>');
2924 begin
2926 //writeln('<', mName, '.', pr.tokStr, '>');
2928 // records
2930 begin
2931 // add records with this type (if any)
2936 begin
2941 // on error, it will be freed by memowner
2947 continue;
2951 // fields
2953 //writeln('0: <', mName, '.', pr.tokStr, '>');
2955 //writeln('1: <', mName, '.', pr.tokStr, '>');
2958 begin
2959 //writeln('2: <', mName, '.', pr.tokStr, '>');
2960 if fld.defined then raise TDynParseException.CreateFmt(pr, 'duplicate field ''%s'' in record ''%s''', [fld.mName, mTypeName]);
2961 if fld.internal then raise TDynParseException.CreateFmt(pr, 'internal field ''%s'' in record ''%s''', [fld.mName, mTypeName]);
2963 //writeln('3: <', mName, '.', pr.tokStr, '>:', pr.tokType);
2967 continue;
2970 // something is wrong
2971 raise TDynParseException.CreateFmt(pr, 'unknown field ''%s'' in record ''%s''', [pr.tokStr, mTypeName]);
2976 begin
2977 // link fields
2979 begin
2985 // fix field defaults
2989 //writeln('done parsing record <', mName, '>');
2990 //{$IF DEFINED(D2D_DYNREC_PROFILER)}writeln('stall: ', curTimeMicro()-stall);{$ENDIF}
2995 // ////////////////////////////////////////////////////////////////////////// //
2997 begin
3004 begin
3011 begin
3022 begin
3025 begin
3034 begin
3040 var
3042 begin
3049 var
3051 begin
3055 // fields
3058 begin
3062 begin
3066 end
3067 else
3068 begin
3073 // max field
3080 var
3082 begin
3084 // fields
3086 begin
3093 var
3095 begin
3097 begin
3105 var
3111 begin
3120 begin
3123 begin
3124 if StrEqu(mIds[f], idname) then raise TDynParseException.CreateFmt(pr, 'duplicate field ''%s'' in enum/bitset ''%s''', [idname, mTypeName]);
3126 if StrEqu(mMaxName, idname) then raise TDynParseException.CreateFmt(pr, 'duplicate field ''%s'' in enum/bitset ''%s''', [idname, mTypeName]);
3130 // has value?
3132 begin
3134 begin
3135 if (Length(mMaxName) > 0) then raise TDynParseException.CreateFmt(pr, 'duplicate max field ''%s'' in enum/bitset ''%s''', [idname, mTypeName]);
3138 end
3139 else
3140 begin
3146 // append it?
3148 begin
3149 // fix maxvalue
3151 begin
3158 // next cv
3160 begin
3169 // add max field
3171 begin
3180 // ////////////////////////////////////////////////////////////////////////// //
3182 begin
3191 var
3194 begin
3195 //!!!FIXME!!! check who owns trigs and recs!
3210 begin
3217 var
3219 begin
3221 begin
3229 var
3231 begin
3233 begin
3241 var
3243 begin
3245 begin
3253 var
3258 // setup header links and type links
3260 var
3262 begin
3265 begin
3270 begin
3272 if (fld.mEBSType = nil) then raise TDynParseException.CreateFmt(pr, 'field ''%s'' of type ''%s'' has no correcponding record definition', [fld.mName, fld.mEBSTypeName]);
3276 begin
3278 if (fld.mEBSType = nil) then raise TDynParseException.CreateFmt(pr, 'field ''%s'' of type ''%s'' has no correcponding enum/bitset', [fld.mName, fld.mEBSTypeName]);
3279 if ((fld.mEBS = TDynField.TEBS.TEnum) <> (fld.mEBSType as TDynEBS).mIsEnum) then raise TDynParseException.CreateFmt(pr, 'field ''%s'' of type ''%s'' enum/bitset type conflict', [fld.mName, fld.mEBSTypeName]);
3285 // setup default values
3287 var
3289 begin
3293 begin
3296 begin
3300 begin
3301 // enum or bitset
3303 begin
3306 begin
3312 //writeln(eb.definition); writeln;
3313 continue;
3316 // triggerdata
3318 begin
3321 begin
3323 begin
3330 //writeln(dr.definition); writeln;
3331 continue;
3336 //writeln(dr.definition); writeln;
3337 if (findRecType(rec.typeName) <> nil) then begin rec.Free(); raise TDynParseException.CreateFmt(pr, 'duplicate record ''%s''', [rec.typeName]); end;
3338 if (hdr <> nil) and StrEqu(rec.typeName, hdr.typeName) then begin rec.Free(); raise TDynParseException.CreateFmt(pr, 'duplicate record ''%s''', [rec.typeName]); end;
3341 begin
3342 if (hdr <> nil) then begin rec.Free(); raise TDynParseException.CreateFmt(pr, 'duplicate header record ''%s'' (previous is ''%s'')', [rec.typeName, hdr.typeName]); end;
3344 end
3345 else
3346 begin
3351 // put header record to top
3352 if (hdr = nil) then raise TDynParseException.Create(pr, 'header definition not found in mapdef');
3357 // setup header links and type links
3361 // setup default values
3367 // ////////////////////////////////////////////////////////////////////////// //
3369 var
3371 begin
3373 try
3380 finally
3387 var
3389 begin
3391 try
3397 finally
3403 // WARNING! stream must be seekable
3405 var
3408 begin
3413 begin
3415 begin
3417 exit;
3420 end
3421 else
3422 begin
3424 try
3425 try
3430 finally
3437 // returns `true` if the given stream can be a map file
3438 // stream position is 0 on return
3439 // WARNING! stream must be seekable
3441 var
3444 begin
3449 begin
3451 end
3452 else
3453 begin
3464 var
3466 begin
3468 result += '// ////////////////////////////////////////////////////////////////////////// //'#10;
3475 function TDynMapDef.getRecTypeAt (idx: Integer): TDynRecord; inline; begin if (idx >= 0) and (idx < recTypes.count) then result := recTypes[idx] else result := nil; end;
3478 function TDynMapDef.getEBSTypeAt (idx: Integer): TDynEBS; inline; begin if (idx >= 0) and (idx < ebsTypes.count) then result := ebsTypes[idx] else result := nil; end;
3480 function TDynMapDef.getTrigTypeCount (): Integer; inline; begin result := trigTypes.count; end;
3481 function TDynMapDef.getTrigTypeAt (idx: Integer): TDynRecord; inline; begin if (idx >= 0) and (idx < trigTypes.count) then result := trigTypes[idx] else result := nil; end;