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
136 public
137 // get string name for the given type
140 public
146 // clone this field; register all list records in `registerIn`
147 // "registration" is required to manage record lifetime; use header record if in doubt
148 // owner will be set to `newOwner`, if it is not `nil`, or to `owner`
149 // for lists, cloning will clone all list members
152 // compare field values (including trigdata)
153 // WARNING: won't work for lists
156 // parse string value to appropriate type and set new field value
159 // supports `for rec in field do` (for lists)
162 public
163 // text parser and writer
167 // binary parser and writer (DO NOT USE!)
171 public
172 // the following functions are here only for 'mapgen'! DO NOT USE!
173 // build "alias name" for pascal code
176 public
182 property ival: Integer read mIVal; // integer value for int field (for speed), first field (x/w) for `TPoint` and `TSize`
185 property hasDefault: Boolean read mHasDefault; // `true` if this field has default value in mapdef
188 property ebstype: TObject read mEBSType; // reference type (nil, TDynRecord, TDynEBS); WARNING: don't modify type!
190 property recref: TDynRecord read mRecRef write setRecRef; // referenced record (actual one, you can modify it)
191 property recrefIndex: Integer read getRecRefIndex; // index of referenced record in header; -1: not found
192 // for record lists
195 property item[const aname: AnsiString]: TDynRecord read getListItem; default; // alas, FPC 3+ lost property overloading feature
196 // field value as Variant
199 public
200 // userdata (you can use these properties as you want to; they won't be written or read to files)
204 public
205 // the following properties are here only for 'mapgen'! DO NOT USE!
213 // record, either with actual values, or with type definitions
215 private
221 {$IF DEFINED(XDYNREC_USE_FIELDHASH)}
223 {$ENDIF}
227 mHeaderRec: TDynRecord; // for "value" records this is header record with data, for "type" records this is header type record
229 // for userdata
235 private
256 protected
259 function addRecordByType (const atypename: AnsiString; rc: TDynRecord): Boolean; // `true`: duplicate record id
264 public
269 // clone this record; register all list records in `registerIn`
270 // "registration" is required to manage record lifetime; use header record if in doubt
271 // all fields are cloned too
274 // compare records (values of all fields, including trigdata)
275 // WARNING: won't work for records with list fields
278 // find field with `TriggerType` type
281 // number of records of the given instance
284 // only for headers: create new record with the given type
285 // will return cloned record ready for use, or `nil` on unknown type name
288 public
289 // text parser
290 // `beginEaten`: `true` if "{" was eaten
293 // text writer
294 // `putHeader`: `true` to write complete header, otherwise only "{...}"
297 // binary parser and writer (DO NOT USE!)
301 public
305 property has[const aname: AnsiString]: Boolean read hasByName; // do we have field with the given name?
307 property field[const aname: AnsiString]: TDynField read getFieldByName; default; // get field by name
310 property isForTrig[const aname: AnsiString]: Boolean read getIsForTrig; // can this "TriggerData" be used for the trigger with the given type?
311 property forTrigCount: Integer read getForTrigCount; // number of trigger type names for "TriggerData"
312 property forTrigAt[idx: Integer]: AnsiString read getForTrigAt; // trigger type name at the given index for "TriggerData"
313 property headerRec: TDynRecord read mHeaderRec; // get header record for this one (header contains all other records, enums, bitsets, etc.)
316 public
317 // user fields; user can add arbitrary custom fields
318 // by default, any user field will be marked as "internal"
319 // note: you can use this to manipulate non-user fields too
322 public
323 // userdata (you can use these properties as you want to; they won't be written or read to files)
329 // bitset/enum definition
331 private
340 private
352 public
356 // find name for the given value
357 // return empty string if not found
360 public
369 // parsed "mapdef.txt"
371 public
376 private
390 // creates new header record
393 // creates new header record
396 public
404 public
405 // parse text or binary map, return new header record
406 // WARNING! stream must be seekable
409 // returns `true` if the given stream can be a map file
410 // stream position is 0 on return
411 // WARNING! stream must be seekable
414 public
415 // the following functions are here only for 'mapgen'! DO NOT USE!
418 public
420 // for record types
424 // for enum/bitset types
428 // for trigtypes
435 {$IF DEFINED(D2D_DYNREC_PROFILER)}
437 {$ENDIF}
440 implementation
442 uses
443 e_log
447 // ////////////////////////////////////////////////////////////////////////// //
451 // ////////////////////////////////////////////////////////////////////////// //
453 begin
458 begin
463 // ////////////////////////////////////////////////////////////////////////// //
465 begin
466 if (pr <> nil) then begin tokLine := pr.tokLine; tokCol := pr.tokCol; end else begin tokLine := 0; tokCol := 0; end;
470 constructor TDynParseException.CreateFmt (pr: TTextParser; const afmt: AnsiString; const args: array of const);
471 begin
472 if (pr <> nil) then begin tokLine := pr.tokLine; tokCol := pr.tokCol; end else begin tokLine := 0; tokCol := 0; end;
477 // ////////////////////////////////////////////////////////////////////////// //
479 begin
480 //result := TListEnumerator.Create(mRVal);
481 if (mRVal <> nil) then result := mRVal.GetEnumerator else result := TDynRecList.TEnumerator.Create(nil, 0);
485 // ////////////////////////////////////////////////////////////////////////// //
487 begin
495 begin
503 begin
511 begin
535 else
539 begin
576 begin
583 begin
621 var
623 begin
633 begin
666 var
669 begin
671 begin
672 if firstUp then result := UpCase1251(mAlias[1])+Copy(mAlias, 2, Length(mAlias)-1) else result := mAlias;
673 end
674 else
675 begin
679 begin
689 var
691 begin
693 TEBS.TNone: raise TDynRecException.CreateFmt('cannot set refrec for non-reference field ''%s''', [mName]);
695 begin
697 begin
699 if (trc = nil) then raise TDynRecException.CreateFmt('cannot set refrec for field ''%s'' (type conflict: improperly initialized field)', [mName]);
700 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]);
704 exit;
706 TEBS.TEnum: raise TDynRecException.CreateFmt('cannot set refrec for enum field ''%s''', [mName]);
707 TEBS.TBitSet: raise TDynRecException.CreateFmt('cannot set refrec for bitset field ''%s''', [mName]);
714 begin
730 else result := Unassigned; raise TDynRecException.Create('ketmar forgot to handle some field type');
737 begin
761 else
765 begin
776 varString:
778 begin
780 end
781 else
782 begin
786 varBoolean:
798 else
803 varByte,
804 varWord,
805 varShortInt,
806 varSmallint,
807 varInteger:
809 varInt64:
812 else
814 varLongWord:
815 if (val > LongWord($7FFFFFFF)) then raise TDynRecException.Create('cannot convert longword variant to field value')
825 // won't work for lists
827 begin
845 begin
855 var
857 begin
859 try
861 finally
868 var
874 begin
876 begin
881 end
882 else
883 begin
889 try
896 finally
908 // default value should be parsed
910 begin
913 begin
915 raise TDynRecException.CreateFmt('field ''%s'' in record ''%s'' of record type ''%s'' is not set', [mName, mOwner.mId, mOwner.mName]);
925 // default value should be parsed
927 begin
940 begin
946 begin
947 if (mRVal <> nil) and (idx >= 0) and (idx < mRVal.count) then result := mRVal[idx] else result := nil;
952 var
954 begin
960 begin
963 begin
971 begin
992 begin
1002 TEBS.TBitSet: begin result += ' bitset '; if mBitSetUnique then result += 'unique '; result += mEBSTypeName; end;
1007 begin
1008 if (mType = TType.TPoint) then begin if (mAsT) then result += ' as txy' else result += ' as xy'; end
1009 else if (mType = TType.TSize) then begin if (mAsT) then result += ' as twh' else result += ' as wh'; end;
1017 var
1036 begin
1062 begin
1064 begin
1065 if (Length(fldtype) > 0) then raise TDynParseException.CreateFmt(pr, 'duplicate type definition for field ''%s''', [fldname]);
1070 begin
1072 // arbitrary limits
1073 if (lmaxdim < 1) or (lmaxdim > 32768) then raise TDynParseException.CreateFmt(pr, 'invalid field ''%s'' array size', [fldname]);
1075 end;
1076 continue;
1080 begin
1081 if (Length(xalias) > 0) then raise TDynParseException.CreateFmt(pr, 'duplicate alias definition for field ''%s''', [fldname]);
1083 continue;
1087 begin
1088 if (fldofs >= 0) then raise TDynParseException.CreateFmt(pr, 'duplicate field ''%s'' offset', [fldname]);
1090 if (fldofs < 0) then raise TDynParseException.CreateFmt(pr, 'invalid field ''%s'' offset', [fldname]);
1091 continue;
1095 begin
1102 continue;
1103 end;
1106 begin
1108 if (Length(fldrecname) <> 0) then raise TDynParseException.CreateFmt(pr, 'field ''%s'' already typed as ''%s''', [fldname, fldrecname]);
1110 continue;
1114 begin
1116 if (Length(fldrecname) <> 0) then raise TDynParseException.CreateFmt(pr, 'field ''%s'' already typed as ''%s''', [fldname, fldrecname]);
1119 continue;
1123 begin
1124 if hasdefStr or hasdefInt or hasdefId then raise TDynParseException.CreateFmt(pr, 'field ''%s'' has duplicate default', [fldname]);
1127 begin
1132 begin
1137 begin
1142 begin
1149 else
1152 continue;
1156 begin
1158 continue;
1162 begin
1164 continue;
1167 // record type, no special modifiers
1168 if (pr.tokType <> pr.TTId) then raise TDynParseException.CreateFmt(pr, 'field ''%s'' has something unexpected in definition', [fldname]);
1170 if (Length(fldrecname) <> 0) then raise TDynParseException.CreateFmt(pr, 'field ''%s'' already typed as ''%s''', [fldname, fldrecname]);
1177 // create field
1192 else
1193 begin
1194 // record types defaults to int
1196 begin
1198 end
1199 else
1200 begin
1201 if (Length(fldtype) = 0) then raise TDynParseException.CreateFmt(pr, 'field ''%s'' has no type', [fldname])
1202 else raise TDynParseException.CreateFmt(pr, 'field ''%s'' has invalid type ''%s''', [fldname, fldtype]);
1206 // check for valid arrays
1207 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]);
1209 // check for valid trigdata or record type
1211 begin
1212 // trigdata
1213 if (lmaxdim < 1) then raise TDynParseException.CreateFmt(pr, 'field ''%s'' of type ''%s'' cannot be non-array', [fldname, 'trigdata']);
1214 if (Length(fldrecname) > 0) then raise TDynParseException.CreateFmt(pr, 'field ''%s'' of type ''%s'' cannot have another type', [fldname, 'trigdata']);
1216 end
1218 begin
1219 // record
1220 if not (mType in [TType.TByte, TType.TUByte, TType.TShort, TType.TUShort, TType.TInt, TType.TUInt]) then
1221 begin
1222 raise TDynParseException.CreateFmt(pr, 'field ''%s'' of record type ''%s'' cannot have type ''%s''', [fldname, fldrecname, fldtype]);
1226 // setup default value
1230 begin
1248 end;
1252 begin
1259 var
1265 begin
1269 begin
1271 begin
1272 // this must be triggerdata
1274 begin
1275 raise TDynRecException.CreateFmt('record reference type ''%s'' in field ''%s'' cannot be written', [mEBSTypeName, mName]);
1277 // write triggerdata
1279 if (buf = nil) then raise TDynRecException.CreateFmt('record reference type ''%s'' in field ''%s'' cannot be written', [mEBSTypeName, mName]);
1280 try
1283 begin
1288 finally
1292 exit;
1294 // record reference
1302 else raise TDynRecException.CreateFmt('record reference type ''%s'' in field ''%s'' cannot be written', [mEBSTypeName, mName]);
1304 // find record number
1306 begin
1308 if (f < 0) then raise TDynRecException.CreateFmt('record reference type ''%s'' in field ''%s'' not found in record list', [mEBSTypeName, mName]);
1310 if (f > maxv) then raise TDynRecException.CreateFmt('record reference type ''%s'' in field ''%s'' has too big index', [mEBSTypeName, mName]);
1311 end
1312 else
1313 begin
1320 else raise TDynRecException.CreateFmt('record reference type ''%s'' in field ''%s'' cannot be written', [mEBSTypeName, mName]);
1322 exit;
1331 begin
1333 begin
1335 end
1336 else
1337 begin
1340 exit;
1343 begin
1344 if (mMaxDim = 0) then raise TDynRecException.CreateFmt('invalid string size definition for field ''%s''', [mName]);
1346 begin
1347 if (Length(mSVal) <> 1) then raise TDynRecException.CreateFmt('invalid string size definition for field ''%s''', [mName]);
1349 end
1350 else
1351 begin
1352 if (Length(mSVal) > mMaxDim) then raise TDynRecException.CreateFmt('invalid string size definition for field ''%s''', [mName]);
1357 exit;
1361 begin
1362 // triggerdata array was processed earlier
1363 if (mMaxDim >= 0) then TDynRecException.CreateFmt('byte array in field ''%s'' cannot be written', [mName]);
1365 exit;
1369 begin
1370 if (mMaxDim >= 0) then raise TDynRecException.CreateFmt('short array in field ''%s'' cannot be written', [mName]);
1372 exit;
1376 begin
1377 if (mMaxDim >= 0) then raise TDynRecException.CreateFmt('int array in field ''%s'' cannot be written', [mName]);
1379 exit;
1382 begin
1386 begin
1387 if (mMaxDim >= 0) then raise TDynRecException.CreateFmt('pos/size array in field ''%s'' cannot be written', [mName]);
1390 exit;
1393 begin
1394 if (mMaxDim >= 0) then raise TDynRecException.CreateFmt('pos/size array in field ''%s'' cannot be written', [mName]);
1397 exit;
1400 begin
1402 exit;
1405 begin
1407 exit;
1415 var
1419 begin
1425 begin
1427 begin
1429 end
1431 begin
1433 end
1434 else
1435 begin
1439 exit;
1442 begin
1443 //def := mOwner.mOwner;
1444 //es := def.ebsType[mEBSTypeName];
1447 if (es = nil) or (not es.mIsEnum) then raise TDynRecException.CreateFmt('record enum type ''%s'' for field ''%s'' not found', [mEBSTypeName, mName]);
1449 begin
1451 begin
1454 exit;
1457 raise TDynRecException.CreateFmt('value %d in record enum type ''%s'' for field ''%s'' not found', [mIVal, mEBSTypeName, mName]);
1460 begin
1461 //def := mOwner.mOwner;
1462 //es := def.ebsType[mEBSTypeName];
1465 if (es = nil) or es.mIsEnum then raise TDynRecException.CreateFmt('record bitset type ''%s'' for field ''%s'' not found', [mEBSTypeName, mName]);
1466 // none?
1468 begin
1470 begin
1472 begin
1475 exit;
1478 raise TDynRecException.CreateFmt('value %d in record bitset type ''%s'' for field ''%s'' not found', [0, mEBSTypeName, mName]);
1480 // not none
1484 begin
1486 begin
1489 begin
1491 begin
1495 break;
1498 if not found then raise TDynRecException.CreateFmt('value %d in record bitset type ''%s'' for field ''%s'' not found', [mask, mEBSTypeName, mName]);
1503 exit;
1510 begin
1512 exit;
1515 begin
1516 if (mMaxDim = 0) then raise TDynRecException.CreateFmt('invalid string size definition for field ''%s''', [mName]);
1519 exit;
1527 begin
1529 exit;
1532 begin
1535 exit;
1539 begin
1541 exit;
1544 begin
1546 exit;
1549 begin
1551 exit;
1560 var
1567 begin
1571 begin
1572 // this must be triggerdata
1574 begin
1577 // find trigger definition
1579 if (tfld = nil) then raise TDynRecException.CreateFmt('triggerdata value for field ''%s'' in record ''%s'' without TriggerType field', [mName, rec.mName]);
1581 if (rc = nil) then raise TDynRecException.CreateFmt('triggerdata definition for field ''%s'' in record ''%s'' with type ''%s'' not found', [mName, rec.mName, tfld.mSVal]);
1584 // on error, it will be freed by memowner
1588 exit;
1589 end
1590 else
1591 begin
1592 // not a trigger data
1600 else raise TDynRecException.CreateFmt('invalid non-numeric type ''%s'' for field ''%s'' of record ''%s''', [getTypeName(mType), mName, mEBSTypeName]);
1606 exit;
1610 begin
1619 else raise TDynRecException.CreateFmt('invalid non-numeric type ''%s'' for field ''%s'' of record ''%s''', [getTypeName(mType), mName, mEBSTypeName]);
1623 if (es = nil) or (es.mIsEnum <> (mEBS = TEBS.TEnum)) then raise TDynRecException.CreateFmt('record enum type ''%s'' for field ''%s'' not found', [mEBSTypeName, mName]);
1625 // build enum/bitfield values
1627 begin
1629 if (Length(mSVal) = 0) then raise TDynRecException.CreateFmt('record enum type ''%s'' for field ''%s'' has invalid value %d', [mEBSTypeName, mName, mIVal]);
1630 end
1631 else
1632 begin
1633 // special for 'none'
1635 begin
1637 if (Length(mSVal) = 0) then raise TDynRecException.CreateFmt('record bitset type ''%s'' for field ''%s'' has invalid value %d', [mEBSTypeName, mName, mIVal]);
1638 end
1639 else
1640 begin
1644 begin
1646 begin
1648 if (Length(s) = 0) then raise TDynRecException.CreateFmt('record bitset type ''%s'' for field ''%s'' has invalid value %d', [mEBSTypeName, mName, mask]);
1656 //writeln('ebs <', es.mName, '>: ', mSVal);
1658 exit;
1665 begin
1671 exit;
1674 begin
1676 begin
1678 end
1679 else
1680 begin
1683 try
1688 begin
1693 finally
1698 exit;
1707 begin
1709 exit;
1712 begin
1716 exit;
1719 begin
1723 exit;
1726 begin
1728 exit;
1731 begin
1733 exit;
1744 begin
1746 if (mIVal < min) or (mIVal > max) then raise TDynParseException.CreateFmt(pr, 'invalid %s value for field ''%s''', [getTypeName(mType), mName]);
1750 var
1756 begin
1759 // if this field should contain struct, convert type and parse struct
1763 begin
1764 // ugly hack. sorry.
1766 begin
1769 begin
1770 // '{}'
1773 end
1774 else
1775 begin
1777 // find trigger definition
1779 if (tfld = nil) then raise TDynParseException.CreateFmt(pr, 'triggerdata value for field ''%s'' in record ''%s'' without ''type'' field', [mName, rec.mName]);
1781 if (rc = nil) then raise TDynParseException.CreateFmt(pr, 'triggerdata definition for field ''%s'' in record ''%s'' with type ''%s'' not found', [mName, rec.mName, tfld.mSVal]);
1784 //writeln(rc.definition);
1785 // on error, it will be freed by memowner
1791 exit;
1793 // other record types
1795 begin
1797 begin
1799 end
1800 else
1801 begin
1804 begin
1806 end
1807 else
1808 begin
1816 exit;
1817 end
1819 begin
1820 //rec := mOwner.mOwner.recType[mEBSTypeName]; // find in mapdef
1823 if (rec = nil) then raise TDynParseException.CreateFmt(pr, 'record type ''%s'' for field ''%s'' not found', [mEBSTypeName, mName]);
1830 begin
1831 raise TDynParseException.CreateFmt(pr, 'duplicate record with id ''%s'' for field ''%s'' in record ''%s''', [rc.mId, mName, mOwner.mName]);
1834 exit;
1839 begin
1840 //es := mOwner.mOwner.ebsType[mEBSTypeName]; // find in mapdef
1843 if (es = nil) or (not es.mIsEnum) then raise TDynParseException.CreateFmt(pr, 'record enum type ''%s'' for field ''%s'' not found', [mEBSTypeName, mName]);
1845 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]);
1848 //writeln('ENUM ', mEBSName, '; element <', mSVal, '> with value ', mIVal);
1851 exit;
1854 begin
1855 //es := mOwner.mOwner.ebsType[mEBSTypeName]; // find in mapdef
1858 if (es = nil) or es.mIsEnum then raise TDynParseException.CreateFmt(pr, 'record bitset type ''%s'' for field ''%s'' not found', [mEBSTypeName, mName]);
1861 begin
1863 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]);
1867 if mBitSetUnique then raise TDynParseException.CreateFmt(pr, 'record bitset of type ''%s'' for field ''%s'' expects only one value', [tk, mEBSTypeName, mName]);
1872 exit;
1879 begin
1885 exit;
1888 begin
1889 if (mMaxDim = 0) then raise TDynParseException.CreateFmt(pr, 'invalid string size definition for field ''%s''', [mName]);
1892 begin
1893 // single char
1894 if (Length(mSVal) <> 1) then raise TDynParseException.CreateFmt(pr, 'invalid string size for field ''%s''', [mName]);
1897 end
1898 else
1899 begin
1900 // string
1901 if (Length(mSVal) > mMaxDim) then raise TDynParseException.CreateFmt(pr, 'invalid string size for field ''%s''', [mName]);
1905 exit;
1908 begin
1911 exit;
1914 begin
1917 exit;
1920 begin
1923 exit;
1926 begin
1929 exit;
1932 begin
1935 exit;
1938 begin
1941 exit;
1944 begin
1948 exit;
1952 begin
1956 begin
1957 if (mIVal < 0) or (mIVal > 32767) then raise TDynParseException.CreateFmt(pr, 'invalid %s value for field ''%s''', [getTypeName(mType), mName]);
1961 begin
1962 if (mIVal2 < 0) or (mIVal2 > 32767) then raise TDynParseException.CreateFmt(pr, 'invalid %s value for field ''%s''', [getTypeName(mType), mName]);
1967 exit;
1970 begin
1972 exit;
1975 begin
1977 exit;
1985 // ////////////////////////////////////////////////////////////////////////// //
1987 begin
1988 if (pr = nil) then raise TDynParseException.Create(pr, 'cannot create record type without type definition');
1993 {$IF DEFINED(XDYNREC_USE_FIELDHASH)}
1995 {$ENDIF}
2007 begin
2011 {$IF DEFINED(XDYNREC_USE_FIELDHASH)}
2013 {$ENDIF}
2024 var
2027 begin
2029 begin
2031 begin
2033 begin
2034 //writeln(formatstrf('freeing: 0x%08x; name=%s; id=%s', [Pointer(rec), rec.mName, rec.mId]));
2045 {$IF DEFINED(XDYNREC_USE_FIELDHASH)}
2048 {$ENDIF}
2058 begin
2060 begin
2068 begin
2071 {$IF DEFINED(XDYNREC_USE_FIELDHASH)}
2073 {$ENDIF}
2077 function TDynRecord.addFieldChecked (fld: TDynField): Boolean; inline; // `true`: duplicate name
2078 begin
2081 {$IF not DEFINED(XDYNREC_USE_FIELDHASH)}
2083 {$ENDIF}
2085 {$IF DEFINED(XDYNREC_USE_FIELDHASH)}
2087 {$ENDIF}
2092 begin
2093 {$IF DEFINED(XDYNREC_USE_FIELDHASH)}
2095 {$ELSE}
2098 begin
2103 {$ENDIF}
2108 begin
2114 var
2116 begin
2123 begin
2129 begin
2135 begin
2141 var
2143 begin
2151 begin
2157 begin
2163 var
2166 begin
2178 begin
2189 var
2192 begin
2195 // find record data
2198 if (fld.mType <> fld.TType.TList) then raise TDynRecException.CreateFmt('cannot get record of type ''%s'' due to name conflict with ordinary field', [atypename]);
2199 // find by id
2201 begin
2204 // alas
2208 function TDynRecord.findRecordNumByType (const atypename: AnsiString; rc: TDynRecord): Integer;
2209 var
2212 begin
2214 // find record data
2217 if (fld.mType <> fld.TType.TList) then raise TDynRecException.CreateFmt('cannot get record of type ''%s'' due to name conflict with ordinary field', [atypename]);
2218 // find by ref
2220 begin
2222 begin
2226 // alas
2231 var
2233 begin
2234 // find record data
2237 begin
2238 // first record
2243 if (fld.mType <> fld.TType.TList) then raise TDynRecException.CreateFmt('cannot append record of type ''%s'' due to name conflict with ordinary field', [atypename]);
2244 // append
2246 begin
2255 var
2257 begin
2263 begin
2271 var
2274 begin
2276 begin
2287 // number of records of the given instance
2289 var
2291 begin
2299 var
2301 begin
2302 if not mHeader then raise TDynRecException.Create('cannot create new records with non-header');
2313 var
2315 begin
2322 var
2324 begin
2327 begin
2328 if (Length(aname) = 0) then raise TDynRecException.Create('cannot create nameless user field');
2333 end
2334 else
2335 begin
2342 var
2345 begin
2347 begin
2350 begin
2352 begin
2356 if isForTrig[tdn] then raise TDynParseException.CreateFmt(pr, 'duplicate trigdata ''%s'' trigtype ''%s''', [mName, tdn]);
2360 end
2361 else
2362 begin
2368 end
2369 else
2370 begin
2373 begin
2376 begin
2377 if (mSize > 0) then raise TDynParseException.CreateFmt(pr, 'duplicate `size` in record ''%s''', [mName]);
2379 if (mSize < 1) then raise TDynParseException.CreateFmt(pr, 'invalid record ''%s'' size: %d', [mName, mSize]);
2381 continue;
2384 begin
2385 if (mBinBlock >= 0) then raise TDynParseException.CreateFmt(pr, 'duplicate `binblock` in record ''%s''', [mName]);
2387 if (mBinBlock < 1) then raise TDynParseException.CreateFmt(pr, 'invalid record ''%s'' binblock: %d', [mName, mBinBlock]);
2388 continue;
2394 // load fields
2396 begin
2398 // append
2401 begin
2405 // done with field
2412 var
2414 begin
2416 begin
2417 // trigger data
2420 begin
2423 begin
2428 end
2429 else
2430 begin
2433 end
2434 else
2435 begin
2436 // record
2443 begin
2453 var
2465 var
2468 begin
2469 //writeln('*** rec: ', rec.mName, '.', rec.mId, ' (', rec.mFields.count, ')');
2471 begin
2473 begin
2475 continue;
2481 begin
2482 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);
2483 //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]);
2485 //writeln(' ', rec.mName, '.', rec.mId, ':', fld.mName, ' -> ', rt.mName, '.', rt.mId, ' (', fld.mEBSTypeName, '.', fld.mRecRefId, ')');
2491 begin
2492 //writeln(' ', fld.mName);
2497 begin
2500 try
2502 begin
2503 // parse map file as sequence of blocks
2507 // parse blocks
2509 begin
2515 if (bsize < 0) or (bsize > $1fffffff) then raise TDynRecException.CreateFmt('block of type %d has invalid size %d', [btype, bsize]);
2516 if loaded[btype] then raise TDynRecException.CreateFmt('block of type %d already loaded', [btype]);
2518 // find record type for this block
2521 if (rect = nil) then raise TDynRecException.CreateFmt('block of type %d has no corresponding record', [btype]);
2522 //writeln('found type ''', rec.mName, ''' for block type ', btype);
2523 if (rec.mSize = 0) or ((bsize mod rec.mSize) <> 0) then raise TDynRecException.CreateFmt('block of type %d has invalid number of records', [btype]);
2524 // header?
2526 begin
2527 if (bsize <> mSize) then raise TDynRecException.CreateFmt('header block of type %d has invalid number of records', [btype]);
2532 end
2533 else
2534 begin
2535 // create list for this type
2540 begin
2544 begin
2551 //writeln('parsed ''', rec.mId, '''...');
2557 //st.position := st.position+bsize;
2559 // link fields
2561 begin
2565 exit;
2568 // read fields
2570 if (mSize < 1) then raise TDynRecException.CreateFmt('cannot read record of type ''%s'' with unknown size', [mName]);
2574 begin
2577 if (fld.mBinOfs >= st.size) then raise TDynRecException.CreateFmt('record of type ''%s'' has invalid field ''%s''', [fld.mName]);
2579 //writeln('parsing ''', mName, '.', fld.mName, '''...');
2582 finally
2589 procedure TDynRecord.writeBinTo (st: TStream; trigbufsz: Integer=-1; onlyFields: Boolean=false);
2590 var
2596 //f, c: Integer;
2599 begin
2601 begin
2602 if (mBinBlock < 1) then raise TDynRecException.Create('cannot write binary record without block number');
2605 end
2606 else
2607 begin
2610 try
2615 // write normal fields
2617 begin
2618 // record list?
2622 if (fld.mBinOfs >= bufsz) then raise TDynRecException.Create('binary value offset is outside of the buffer');
2624 //writeln('writing field <', fld.mName, '>');
2628 // write block with normal fields
2630 begin
2631 //writeln('writing header...');
2632 // signature and version
2643 // write other blocks, if any
2645 begin
2646 // calculate blkmax
2649 begin
2650 // record list?
2652 begin
2660 // write blocks
2662 begin
2666 begin
2667 // record list?
2669 begin
2678 // flush block
2680 begin
2691 // write end marker
2696 finally
2704 var
2707 begin
2709 begin
2716 try
2718 begin
2719 // record list?
2721 begin
2724 begin
2726 begin
2732 continue;
2739 finally
2747 {$IF DEFINED(D2D_DYNREC_PROFILER)}
2748 var
2759 begin
2761 writeln('record cloning: ', profCloneRec div 1000, '.', profCloneRec mod 1000, ' milliseconds');
2762 writeln('findRecType : ', profFindRecType div 1000, '.', profFindRecType mod 1000, ' milliseconds');
2763 writeln('field[] : ', profFieldSearching div 1000, '.', profFieldSearching mod 1000, ' milliseconds');
2764 writeln('list dup check: ', profListDupChecking div 1000, '.', profListDupChecking mod 1000, ' milliseconds');
2765 writeln('addRecByType : ', profAddRecByType div 1000, '.', profAddRecByType mod 1000, ' milliseconds');
2766 writeln('field valparse: ', profFieldValParsing div 1000, '.', profFieldValParsing mod 1000, ' milliseconds');
2767 writeln('fix defaults : ', profFixDefaults div 1000, '.', profFixDefaults mod 1000, ' milliseconds');
2768 writeln('recvalparse : ', profRecValParse div 1000, '.', profRecValParse mod 1000, ' milliseconds');
2770 {$ENDIF}
2774 var
2778 {$IF DEFINED(D2D_DYNREC_PROFILER)}
2780 {$ENDIF}
2783 var
2786 begin
2787 //writeln('*** rec: ', rec.mName, '.', rec.mId, ' (', rec.mFields.count, ')');
2789 begin
2791 begin
2793 continue;
2799 begin
2800 //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);
2801 raise TDynParseException.CreateFmt(pr, '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]);
2803 //writeln(' ', rec.mName, '.', rec.mId, ':', fld.mName, ' -> ', rt.mName, '.', rt.mId, ' (', fld.mEBSTypeName, '.', fld.mRecRefId, ')');
2809 begin
2810 //writeln(' ', fld.mName);
2815 begin
2816 if (mOwner = nil) then raise TDynParseException.CreateFmt(pr, 'can''t parse record ''%s'' value without owner', [mName]);
2820 // not a header?
2822 begin
2823 // id?
2825 end
2826 else
2827 begin
2831 //writeln('parsing record <', mName, '>');
2834 begin
2836 //writeln('<', mName, '.', pr.tokStr, '>');
2838 // records
2840 begin
2841 // add records with this type (if any)
2846 begin
2851 // on error, it will be freed by memowner
2857 continue;
2861 // fields
2863 //writeln('0: <', mName, '.', pr.tokStr, '>');
2865 //writeln('1: <', mName, '.', pr.tokStr, '>');
2868 begin
2869 //writeln('2: <', mName, '.', pr.tokStr, '>');
2870 if fld.defined then raise TDynParseException.CreateFmt(pr, 'duplicate field ''%s'' in record ''%s''', [fld.mName, mName]);
2871 if fld.internal then raise TDynParseException.CreateFmt(pr, 'internal field ''%s'' in record ''%s''', [fld.mName, mName]);
2873 //writeln('3: <', mName, '.', pr.tokStr, '>:', pr.tokType);
2877 continue;
2880 // something is wrong
2881 raise TDynParseException.CreateFmt(pr, 'unknown field ''%s'' in record ''%s''', [pr.tokStr, mName]);
2886 begin
2887 // link fields
2889 begin
2895 // fix field defaults
2899 //writeln('done parsing record <', mName, '>');
2900 //{$IF DEFINED(D2D_DYNREC_PROFILER)}writeln('stall: ', curTimeMicro()-stall);{$ENDIF}
2905 // ////////////////////////////////////////////////////////////////////////// //
2907 begin
2914 begin
2921 begin
2932 begin
2935 begin
2944 begin
2950 var
2952 begin
2959 var
2961 begin
2965 // fields
2968 begin
2972 begin
2976 end
2977 else
2978 begin
2983 // max field
2990 var
2992 begin
2994 // fields
2996 begin
3003 var
3005 begin
3007 begin
3015 var
3021 begin
3030 begin
3033 begin
3034 if StrEqu(mIds[f], idname) then raise TDynParseException.CreateFmt(pr, 'duplicate field ''%s'' in enum/bitset ''%s''', [idname, mName]);
3036 if StrEqu(mMaxName, idname) then raise TDynParseException.CreateFmt(pr, 'duplicate field ''%s'' in enum/bitset ''%s''', [idname, mName]);
3040 // has value?
3042 begin
3044 begin
3045 if (Length(mMaxName) > 0) then raise TDynParseException.CreateFmt(pr, 'duplicate max field ''%s'' in enum/bitset ''%s''', [idname, mName]);
3048 end
3049 else
3050 begin
3056 // append it?
3058 begin
3059 // fix maxvalue
3061 begin
3068 // next cv
3070 begin
3079 // add max field
3081 begin
3090 // ////////////////////////////////////////////////////////////////////////// //
3092 begin
3101 var
3104 begin
3105 //!!!FIXME!!! check who owns trigs and recs!
3120 begin
3127 var
3129 begin
3131 begin
3139 var
3141 begin
3143 begin
3151 var
3153 begin
3155 begin
3163 var
3168 // setup header links and type links
3170 var
3172 begin
3175 begin
3180 begin
3182 if (fld.mEBSType = nil) then raise TDynParseException.CreateFmt(pr, 'field ''%s'' of type ''%s'' has no correcponding record definition', [fld.mName, fld.mEBSTypeName]);
3186 begin
3188 if (fld.mEBSType = nil) then raise TDynParseException.CreateFmt(pr, 'field ''%s'' of type ''%s'' has no correcponding enum/bitset', [fld.mName, fld.mEBSTypeName]);
3189 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]);
3195 // setup default values
3197 var
3199 begin
3203 begin
3206 begin
3210 begin
3211 // enum or bitset
3213 begin
3216 begin
3222 //writeln(eb.definition); writeln;
3223 continue;
3226 // triggerdata
3228 begin
3231 begin
3233 begin
3240 //writeln(dr.definition); writeln;
3241 continue;
3246 //writeln(dr.definition); writeln;
3247 if (findRecType(rec.typeName) <> nil) then begin rec.Free(); raise TDynParseException.CreateFmt(pr, 'duplicate record ''%s''', [rec.typeName]); end;
3248 if (hdr <> nil) and StrEqu(rec.typeName, hdr.typeName) then begin rec.Free(); raise TDynParseException.CreateFmt(pr, 'duplicate record ''%s''', [rec.typeName]); end;
3251 begin
3252 if (hdr <> nil) then begin rec.Free(); raise TDynParseException.CreateFmt(pr, 'duplicate header record ''%s'' (previous is ''%s'')', [rec.typeName, hdr.typeName]); end;
3254 end
3255 else
3256 begin
3261 // put header record to top
3262 if (hdr = nil) then raise TDynParseException.Create(pr, 'header definition not found in mapdef');
3267 // setup header links and type links
3271 // setup default values
3277 // ////////////////////////////////////////////////////////////////////////// //
3279 var
3281 begin
3283 try
3290 finally
3297 var
3299 begin
3301 try
3307 finally
3313 // WARNING! stream must be seekable
3315 var
3318 begin
3323 begin
3325 begin
3327 exit;
3330 end
3331 else
3332 begin
3334 try
3335 try
3340 finally
3347 // returns `true` if the given stream can be a map file
3348 // stream position is 0 on return
3349 // WARNING! stream must be seekable
3351 var
3354 begin
3359 begin
3361 end
3362 else
3363 begin
3374 var
3376 begin
3378 result += '// ////////////////////////////////////////////////////////////////////////// //'#10;
3385 function TDynMapDef.getRecTypeAt (idx: Integer): TDynRecord; inline; begin if (idx >= 0) and (idx < recTypes.count) then result := recTypes[idx] else result := nil; end;
3388 function TDynMapDef.getEBSTypeAt (idx: Integer): TDynEBS; inline; begin if (idx >= 0) and (idx < ebsTypes.count) then result := ebsTypes[idx] else result := nil; end;
3390 function TDynMapDef.getTrigTypeCount (): Integer; inline; begin result := trigTypes.count; end;
3391 function TDynMapDef.getTrigTypeAt (idx: Integer): TDynRecord; inline; begin if (idx >= 0) and (idx < trigTypes.count) then result := trigTypes[idx] else result := nil; end;