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
93 mAsMonsterId: Boolean; // special hack for triggers: monster record number+1 in binary (so 0 means "none")
94 // default value
101 mEBSType: TObject; // either TDynRecord or TDynEBS; nil means "simple type"; nil for `TTrigData` too
103 // for binary parser
106 // for userdata
110 // for pasgen
113 private
116 procedure parseDefaultValue (); // parse `mDefUnparsed` to `mDefSVal`, `mDefIVal`, `mDefIVal2`, `mDefRecRef`
134 protected
135 // returns `true` for duplicate record id
139 public
140 // get string name for the given type
143 public
149 // clone this field; register all list records in `registerIn`
150 // "registration" is required to manage record lifetime; use header record if in doubt
151 // owner will be set to `newOwner`, if it is not `nil`, or to `owner`
152 // for lists, cloning will clone all list members
155 // compare field values (including trigdata)
156 // WARNING: won't work for lists
159 // parse string value to appropriate type and set new field value
162 // supports `for rec in field do` (for lists)
165 public
166 // text parser and writer
170 // binary parser and writer (DO NOT USE!)
174 public
175 // the following functions are here only for 'mapgen'! DO NOT USE!
176 // build "alias name" for pascal code
179 public
185 property ival: Integer read mIVal; // integer value for int field (for speed), first field (x/w) for `TPoint` and `TSize`
188 property hasDefault: Boolean read mHasDefault; // `true` if this field has default value in mapdef
191 property ebstype: TObject read mEBSType; // reference type (nil, TDynRecord, TDynEBS); WARNING: don't modify type!
193 property recref: TDynRecord read mRecRef write setRecRef; // referenced record (actual one, you can modify it)
194 property recrefIndex: Integer read getRecRefIndex; // index of referenced record in header; -1: not found
195 // for record lists
198 property item[const aname: AnsiString]: TDynRecord read getListItem; default; // alas, FPC 3+ lost property overloading feature
199 // field value as Variant
205 public
206 // userdata (you can use these properties as you want to; they won't be written or read to files)
210 public
211 // the following properties are here only for 'mapgen'! DO NOT USE!
220 // record, either with actual values, or with type definitions
222 private
230 {$IF DEFINED(XDYNREC_USE_FIELDHASH)}
232 {$ENDIF}
236 mHeaderRec: TDynRecord; // for "value" records this is header record with data, for "type" records this is header type record
238 // for userdata
244 private
267 protected
270 function addRecordByType (const atypename: AnsiString; rc: TDynRecord): Boolean; // `true`: duplicate record id
275 public
280 // clone this record; register all list records in `registerIn`
281 // "registration" is required to manage record lifetime; use header record if in doubt
282 // all fields are cloned too
285 // compare records (values of all fields, including trigdata)
286 // WARNING: won't work for records with list fields
289 // find field with `TriggerType` type
292 // number of records of the given instance
295 // only for headers: create new record with the given type
296 // will return cloned record ready for use, or `nil` on unknown type name
297 // `aid` must not be empty, and must be unique
300 // remove record with the given type and id
301 // return `true` if record was successfully found and removed
302 // this will do all necessary recref cleanup too
303 // WARNING: not tested yet
306 //TODO:
307 // [.] API to create triggers
308 // [.] API to properly remove triggers (remove trigdata)
309 // [.] check if `removeTypedRecord()` does the right thing with inline records
310 // [.] for fields: assigning `recref` should remove previously assigned inline record (record without id)
311 // [.] other API i forgot
313 public
314 // text parser
315 // `beginEaten`: `true` if "{" was eaten
318 // text writer
319 // `putHeader`: `true` to write complete header, otherwise only "{...}"
322 // binary parser and writer (DO NOT USE!)
324 procedure writeBinTo (var hasLostData: Boolean; st: TStream; trigbufsz: Integer=-1; onlyFields: Boolean=false);
326 public
330 property has[const aname: AnsiString]: Boolean read hasByName; // do we have field with the given name?
332 property field[const aname: AnsiString]: TDynField read getFieldByName; default; // get field by name
335 property isForTrig[const aname: AnsiString]: Boolean read getIsForTrig; // can this "TriggerData" be used for the trigger with the given type?
336 property forTrigCount: Integer read getForTrigCount; // number of trigger type names for "TriggerData"
337 property forTrigAt[idx: Integer]: AnsiString read getForTrigAt; // trigger type name at the given index for "TriggerData"
338 property headerRec: TDynRecord read mHeaderRec; // get header record for this one (header contains all other records, enums, bitsets, etc.)
344 public
345 // user fields; user can add arbitrary custom fields
346 // by default, any user field will be marked as "internal"
347 // note: you can use this to manipulate non-user fields too
350 public
351 // userdata (you can use these properties as you want to; they won't be written or read to files)
357 // bitset/enum definition
359 private
370 private
382 public
386 // find name for the given value
387 // return empty string if not found
390 public
402 // parsed "mapdef.txt"
404 public
409 private
423 // creates new header record
426 // creates new header record
429 public
437 public
438 // parse text or binary map, return new header record
439 // WARNING! stream must be seekable
442 // returns `true` if the given stream can be a map file
443 // stream position is 0 on return
444 // WARNING! stream must be seekable
447 public
448 // the following functions are here only for 'mapgen'! DO NOT USE!
451 public
453 // for record types
457 // for enum/bitset types
461 // for trigtypes
468 {$IF DEFINED(D2D_DYNREC_PROFILER)}
470 {$ENDIF}
473 implementation
475 uses
476 e_log
480 // ////////////////////////////////////////////////////////////////////////// //
484 // ////////////////////////////////////////////////////////////////////////// //
486 begin
491 begin
496 // ////////////////////////////////////////////////////////////////////////// //
498 begin
499 if (pr <> nil) then begin tokLine := pr.tokLine; tokCol := pr.tokCol; end else begin tokLine := 0; tokCol := 0; end;
503 constructor TDynParseException.CreateFmt (pr: TTextParser; const afmt: AnsiString; const args: array of const);
504 begin
505 if (pr <> nil) then begin tokLine := pr.tokLine; tokCol := pr.tokCol; end else begin tokLine := 0; tokCol := 0; end;
510 // ////////////////////////////////////////////////////////////////////////// //
512 begin
513 //result := TListEnumerator.Create(mRVal);
514 if (mRVal <> nil) then result := mRVal.GetEnumerator else result := TDynRecList.TEnumerator.Create(nil, 0);
518 // ////////////////////////////////////////////////////////////////////////// //
520 begin
528 begin
536 begin
544 begin
568 else
572 begin
609 begin
616 begin
656 var
658 begin
670 begin
703 var
706 begin
708 begin
709 if firstUp then result := UpCase1251(mAlias[1])+Copy(mAlias, 2, Length(mAlias)-1) else result := mAlias;
710 end
711 else
712 begin
716 begin
726 var
728 begin
730 TEBS.TNone: raise TDynRecException.CreateFmt('cannot set refrec for non-reference field ''%s''', [mName]);
732 begin
734 begin
736 if (trc = nil) then raise TDynRecException.CreateFmt('cannot set refrec for field ''%s'' (type conflict: improperly initialized field)', [mName]);
737 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]);
741 exit;
743 TEBS.TEnum: raise TDynRecException.CreateFmt('cannot set refrec for enum field ''%s''', [mName]);
744 TEBS.TBitSet: raise TDynRecException.CreateFmt('cannot set refrec for bitset field ''%s''', [mName]);
751 begin
767 else result := Unassigned; raise TDynRecException.Create('ketmar forgot to handle some field type');
774 begin
798 else
802 begin
813 varString:
815 begin
817 end
818 else
819 begin
823 varBoolean:
835 else
840 varByte,
841 varWord,
842 varShortInt,
843 varSmallint,
844 varInteger:
846 varInt64:
849 else
851 varLongWord:
852 if (val > LongWord($7FFFFFFF)) then raise TDynRecException.Create('cannot convert longword variant to field value')
862 // won't work for lists
864 begin
882 begin
892 var
894 begin
896 try
898 finally
905 var
911 begin
913 begin
918 end
919 else
920 begin
926 try
933 finally
945 // default value should be parsed
947 begin
950 begin
952 raise TDynRecException.CreateFmt('field ''%s'' in record ''%s'' of record type ''%s'' is not set', [mName, mOwner.mId, mOwner.mTypeName]);
962 // default value should be parsed
964 begin
977 begin
983 begin
984 if (mRVal <> nil) and (idx >= 0) and (idx < mRVal.count) then result := mRVal[idx] else result := nil;
989 var
991 begin
997 begin
1000 begin
1008 var
1010 begin
1013 begin
1016 // fix hash and list
1018 begin
1028 begin
1049 begin
1059 TEBS.TBitSet: begin result += ' bitset '; if mBitSetUnique then result += 'unique '; result += mEBSTypeName; end;
1064 begin
1065 if (mType = TType.TPoint) then begin if (mAsT) then result += ' as txy' else result += ' as xy'; end
1066 else if (mType = TType.TSize) then begin if (mAsT) then result += ' as twh' else result += ' as wh'; end;
1074 var
1094 begin
1122 begin
1124 begin
1125 if (Length(fldtype) > 0) then raise TDynParseException.CreateFmt(pr, 'duplicate type definition for field ''%s''', [fldname]);
1130 begin
1132 // arbitrary limits
1133 if (lmaxdim < 1) or (lmaxdim > 32768) then raise TDynParseException.CreateFmt(pr, 'invalid field ''%s'' array size', [fldname]);
1135 end;
1136 continue;
1140 begin
1141 if (Length(xalias) > 0) then raise TDynParseException.CreateFmt(pr, 'duplicate alias definition for field ''%s''', [fldname]);
1143 continue;
1147 begin
1148 if (Length(atip) > 0) then raise TDynParseException.CreateFmt(pr, 'duplicate tip definition for field ''%s''', [fldname]);
1150 continue;
1154 begin
1155 if (Length(ahelp) > 0) then raise TDynParseException.CreateFmt(pr, 'duplicate tip definition for field ''%s''', [fldname]);
1157 continue;
1161 begin
1162 if (fldofs >= 0) then raise TDynParseException.CreateFmt(pr, 'duplicate field ''%s'' offset', [fldname]);
1164 if (fldofs < 0) then raise TDynParseException.CreateFmt(pr, 'invalid field ''%s'' offset', [fldname]);
1165 continue;
1169 begin
1176 continue;
1177 end;
1180 begin
1182 if (Length(fldrecname) <> 0) then raise TDynParseException.CreateFmt(pr, 'field ''%s'' already typed as ''%s''', [fldname, fldrecname]);
1184 continue;
1188 begin
1190 if (Length(fldrecname) <> 0) then raise TDynParseException.CreateFmt(pr, 'field ''%s'' already typed as ''%s''', [fldname, fldrecname]);
1193 continue;
1197 begin
1198 if hasdefStr or hasdefInt or hasdefId then raise TDynParseException.CreateFmt(pr, 'field ''%s'' has duplicate default', [fldname]);
1201 begin
1206 begin
1211 begin
1216 begin
1223 else
1226 continue;
1230 begin
1232 continue;
1236 begin
1238 continue;
1241 // record type, no special modifiers
1242 if (pr.tokType <> pr.TTId) then raise TDynParseException.CreateFmt(pr, 'field ''%s'' has something unexpected in definition', [fldname]);
1244 if (Length(fldrecname) <> 0) then raise TDynParseException.CreateFmt(pr, 'field ''%s'' already typed as ''%s''', [fldname, fldrecname]);
1251 // create field
1266 else
1267 begin
1268 // record types defaults to int
1270 begin
1272 end
1273 else
1274 begin
1275 if (Length(fldtype) = 0) then raise TDynParseException.CreateFmt(pr, 'field ''%s'' has no type', [fldname])
1276 else raise TDynParseException.CreateFmt(pr, 'field ''%s'' has invalid type ''%s''', [fldname, fldtype]);
1280 // check for valid arrays
1281 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]);
1283 // check for valid trigdata or record type
1285 begin
1286 // trigdata
1287 if (lmaxdim < 1) then raise TDynParseException.CreateFmt(pr, 'field ''%s'' of type ''%s'' cannot be non-array', [fldname, 'trigdata']);
1288 if (Length(fldrecname) > 0) then raise TDynParseException.CreateFmt(pr, 'field ''%s'' of type ''%s'' cannot have another type', [fldname, 'trigdata']);
1290 end
1292 begin
1293 // record
1294 if not (mType in [TType.TByte, TType.TUByte, TType.TShort, TType.TUShort, TType.TInt, TType.TUInt]) then
1295 begin
1296 raise TDynParseException.CreateFmt(pr, 'field ''%s'' of record type ''%s'' cannot have type ''%s''', [fldname, fldrecname, fldtype]);
1300 // setup default value
1304 begin
1324 end;
1328 begin
1335 var
1341 begin
1345 begin
1347 begin
1348 // this must be triggerdata
1350 begin
1351 raise TDynRecException.CreateFmt('record reference type ''%s'' in field ''%s'' cannot be written', [mEBSTypeName, mName]);
1353 // write triggerdata
1355 if (buf = nil) then raise TDynRecException.CreateFmt('record reference type ''%s'' in field ''%s'' cannot be written', [mEBSTypeName, mName]);
1356 try
1359 begin
1364 finally
1368 exit;
1370 // record reference
1378 else raise TDynRecException.CreateFmt('record reference type ''%s'' in field ''%s'' cannot be written', [mEBSTypeName, mName]);
1380 // find record number
1382 begin
1384 if (f < 0) then raise TDynRecException.CreateFmt('record reference type ''%s'' in field ''%s'' not found in record list', [mEBSTypeName, mName]);
1386 if (f > maxv) then raise TDynRecException.CreateFmt('record reference type ''%s'' in field ''%s'' has too big index', [mEBSTypeName, mName]);
1387 end
1388 else
1389 begin
1396 else raise TDynRecException.CreateFmt('record reference type ''%s'' in field ''%s'' cannot be written', [mEBSTypeName, mName]);
1398 exit;
1407 begin
1409 begin
1411 end
1412 else
1413 begin
1416 exit;
1419 begin
1420 if (mMaxDim = 0) then raise TDynRecException.CreateFmt('invalid string size definition for field ''%s''', [mName]);
1422 begin
1423 if (Length(mSVal) <> 1) then raise TDynRecException.CreateFmt('invalid string size definition for field ''%s''', [mName]);
1425 end
1426 else
1427 begin
1428 if (Length(mSVal) > mMaxDim) then raise TDynRecException.CreateFmt('invalid string size definition for field ''%s''', [mName]);
1433 exit;
1437 begin
1438 // triggerdata array was processed earlier
1439 if (mMaxDim >= 0) then TDynRecException.CreateFmt('byte array in field ''%s'' cannot be written', [mName]);
1441 exit;
1445 begin
1446 if (mMaxDim >= 0) then raise TDynRecException.CreateFmt('short array in field ''%s'' cannot be written', [mName]);
1448 exit;
1452 begin
1453 if (mMaxDim >= 0) then raise TDynRecException.CreateFmt('int array in field ''%s'' cannot be written', [mName]);
1455 exit;
1458 begin
1462 begin
1463 if (mMaxDim >= 0) then raise TDynRecException.CreateFmt('pos/size array in field ''%s'' cannot be written', [mName]);
1466 exit;
1469 begin
1470 if (mMaxDim >= 0) then raise TDynRecException.CreateFmt('pos/size array in field ''%s'' cannot be written', [mName]);
1473 exit;
1485 var
1489 begin
1495 begin
1497 begin
1499 end
1501 begin
1503 end
1504 else
1505 begin
1509 exit;
1512 begin
1513 //def := mOwner.mOwner;
1514 //es := def.ebsType[mEBSTypeName];
1517 if (es = nil) or (not es.mIsEnum) then raise TDynRecException.CreateFmt('record enum type ''%s'' for field ''%s'' not found', [mEBSTypeName, mName]);
1519 begin
1521 begin
1524 exit;
1527 raise TDynRecException.CreateFmt('value %d in record enum type ''%s'' for field ''%s'' not found', [mIVal, mEBSTypeName, mName]);
1530 begin
1531 //def := mOwner.mOwner;
1532 //es := def.ebsType[mEBSTypeName];
1535 if (es = nil) or es.mIsEnum then raise TDynRecException.CreateFmt('record bitset type ''%s'' for field ''%s'' not found', [mEBSTypeName, mName]);
1536 // none?
1538 begin
1540 begin
1542 begin
1545 exit;
1548 raise TDynRecException.CreateFmt('value %d in record bitset type ''%s'' for field ''%s'' not found', [0, mEBSTypeName, mName]);
1550 // not none
1554 begin
1556 begin
1559 begin
1561 begin
1565 break;
1568 if not found then raise TDynRecException.CreateFmt('value %d in record bitset type ''%s'' for field ''%s'' not found', [mask, mEBSTypeName, mName]);
1573 exit;
1580 begin
1582 exit;
1585 begin
1586 if (mMaxDim = 0) then raise TDynRecException.CreateFmt('invalid string size definition for field ''%s''', [mName]);
1589 exit;
1597 begin
1599 exit;
1602 begin
1605 exit;
1609 begin
1611 exit;
1614 begin
1616 exit;
1619 begin
1621 exit;
1630 var
1637 begin
1641 begin
1642 // this must be triggerdata
1644 begin
1647 // find trigger definition
1649 if (tfld = nil) then raise TDynRecException.CreateFmt('triggerdata value for field ''%s'' in record ''%s'' without TriggerType field', [mName, rec.mTypeName]);
1651 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]);
1654 // on error, it will be freed by memowner
1658 exit;
1659 end
1660 else
1661 begin
1662 // not a trigger data
1670 else raise TDynRecException.CreateFmt('invalid non-numeric type ''%s'' for field ''%s'' of record ''%s''', [getTypeName(mType), mName, mEBSTypeName]);
1676 exit;
1680 begin
1689 else raise TDynRecException.CreateFmt('invalid non-numeric type ''%s'' for field ''%s'' of record ''%s''', [getTypeName(mType), mName, mEBSTypeName]);
1693 if (es = nil) or (es.mIsEnum <> (mEBS = TEBS.TEnum)) then raise TDynRecException.CreateFmt('record enum type ''%s'' for field ''%s'' not found', [mEBSTypeName, mName]);
1695 // build enum/bitfield values
1697 begin
1699 if (Length(mSVal) = 0) then raise TDynRecException.CreateFmt('record enum type ''%s'' for field ''%s'' has invalid value %d', [mEBSTypeName, mName, mIVal]);
1700 end
1701 else
1702 begin
1703 // special for 'none'
1705 begin
1707 if (Length(mSVal) = 0) then raise TDynRecException.CreateFmt('record bitset type ''%s'' for field ''%s'' has invalid value %d', [mEBSTypeName, mName, mIVal]);
1708 end
1709 else
1710 begin
1714 begin
1716 begin
1718 if (Length(s) = 0) then raise TDynRecException.CreateFmt('record bitset type ''%s'' for field ''%s'' has invalid value %d', [mEBSTypeName, mName, mask]);
1726 //writeln('ebs <', es.mName, '>: ', mSVal);
1728 exit;
1735 begin
1741 exit;
1744 begin
1746 begin
1748 end
1749 else
1750 begin
1753 try
1758 begin
1763 finally
1768 exit;
1777 begin
1779 exit;
1782 begin
1786 exit;
1789 begin
1793 exit;
1796 begin
1798 exit;
1801 begin
1803 exit;
1814 begin
1816 if (mIVal < min) or (mIVal > max) then raise TDynParseException.CreateFmt(pr, 'invalid %s value for field ''%s''', [getTypeName(mType), mName]);
1820 var
1826 begin
1829 // if this field should contain struct, convert type and parse struct
1833 begin
1834 // ugly hack. sorry.
1836 begin
1839 begin
1840 // '{}'
1843 end
1844 else
1845 begin
1847 // find trigger definition
1849 if (tfld = nil) then raise TDynParseException.CreateFmt(pr, 'triggerdata value for field ''%s'' in record ''%s'' without ''type'' field', [mName, rec.mTypeName]);
1851 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]);
1854 //writeln(rc.definition);
1855 // on error, it will be freed by memowner
1861 exit;
1863 // other record types
1865 begin
1867 begin
1869 end
1870 else
1871 begin
1874 begin
1876 end
1877 else
1878 begin
1886 exit;
1887 end
1889 begin
1890 //rec := mOwner.mOwner.recType[mEBSTypeName]; // find in mapdef
1893 if (rec = nil) then raise TDynParseException.CreateFmt(pr, 'record type ''%s'' for field ''%s'' not found', [mEBSTypeName, mName]);
1900 begin
1901 raise TDynParseException.CreateFmt(pr, 'duplicate record with id ''%s'' for field ''%s'' in record ''%s''', [rc.mId, mName, mOwner.mTypeName]);
1904 exit;
1909 begin
1910 //es := mOwner.mOwner.ebsType[mEBSTypeName]; // find in mapdef
1913 if (es = nil) or (not es.mIsEnum) then raise TDynParseException.CreateFmt(pr, 'record enum type ''%s'' for field ''%s'' not found', [mEBSTypeName, mName]);
1915 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]);
1918 //writeln('ENUM ', mEBSName, '; element <', mSVal, '> with value ', mIVal);
1921 exit;
1924 begin
1925 //es := mOwner.mOwner.ebsType[mEBSTypeName]; // find in mapdef
1928 if (es = nil) or es.mIsEnum then raise TDynParseException.CreateFmt(pr, 'record bitset type ''%s'' for field ''%s'' not found', [mEBSTypeName, mName]);
1931 begin
1933 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]);
1937 if mBitSetUnique then raise TDynParseException.CreateFmt(pr, 'record bitset of type ''%s'' for field ''%s'' expects only one value', [tk, mEBSTypeName, mName]);
1942 exit;
1949 begin
1955 exit;
1958 begin
1959 if (mMaxDim = 0) then raise TDynParseException.CreateFmt(pr, 'invalid string size definition for field ''%s''', [mName]);
1962 begin
1963 // single char
1964 if (Length(mSVal) <> 1) then raise TDynParseException.CreateFmt(pr, 'invalid string size for field ''%s''', [mName]);
1967 end
1968 else
1969 begin
1970 // string
1971 if (Length(mSVal) > mMaxDim) then raise TDynParseException.CreateFmt(pr, 'invalid string size for field ''%s''', [mName]);
1975 exit;
1978 begin
1981 exit;
1984 begin
1987 exit;
1990 begin
1993 exit;
1996 begin
1999 exit;
2002 begin
2005 exit;
2008 begin
2011 exit;
2014 begin
2018 exit;
2022 begin
2026 begin
2027 if (mIVal < 0) or (mIVal > 32767) then raise TDynParseException.CreateFmt(pr, 'invalid %s value for field ''%s''', [getTypeName(mType), mName]);
2031 begin
2032 if (mIVal2 < 0) or (mIVal2 > 32767) then raise TDynParseException.CreateFmt(pr, 'invalid %s value for field ''%s''', [getTypeName(mType), mName]);
2037 exit;
2040 begin
2042 exit;
2045 begin
2047 exit;
2055 // ////////////////////////////////////////////////////////////////////////// //
2057 begin
2058 if (pr = nil) then raise TDynParseException.Create(pr, 'cannot create record type without type definition');
2063 {$IF DEFINED(XDYNREC_USE_FIELDHASH)}
2065 {$ENDIF}
2077 begin
2081 {$IF DEFINED(XDYNREC_USE_FIELDHASH)}
2083 {$ENDIF}
2094 var
2097 begin
2099 begin
2101 begin
2103 begin
2104 //writeln(formatstrf('freeing: 0x%08x; name=%s; id=%s', [Pointer(rec), rec.mName, rec.mId]));
2115 {$IF DEFINED(XDYNREC_USE_FIELDHASH)}
2118 {$ENDIF}
2128 begin
2130 begin
2138 begin
2141 {$IF DEFINED(XDYNREC_USE_FIELDHASH)}
2143 {$ENDIF}
2147 function TDynRecord.addFieldChecked (fld: TDynField): Boolean; inline; // `true`: duplicate name
2148 begin
2151 {$IF not DEFINED(XDYNREC_USE_FIELDHASH)}
2153 {$ENDIF}
2155 {$IF DEFINED(XDYNREC_USE_FIELDHASH)}
2157 {$ENDIF}
2162 begin
2163 {$IF DEFINED(XDYNREC_USE_FIELDHASH)}
2165 {$ELSE}
2168 begin
2173 {$ENDIF}
2178 begin
2184 var
2186 begin
2193 begin
2199 begin
2205 begin
2211 var
2213 begin
2221 begin
2227 begin
2233 var
2236 begin
2250 begin
2261 var
2264 begin
2267 // find record data
2270 if (fld.mType <> fld.TType.TList) then raise TDynRecException.CreateFmt('cannot get record of type ''%s'' due to name conflict with ordinary field', [atypename]);
2271 // find by id
2273 begin
2276 // alas
2280 function TDynRecord.findRecordNumByType (const atypename: AnsiString; rc: TDynRecord): Integer;
2281 var
2284 begin
2286 // find record data
2289 if (fld.mType <> fld.TType.TList) then raise TDynRecException.CreateFmt('cannot get record of type ''%s'' due to name conflict with ordinary field', [atypename]);
2290 // find by ref
2292 begin
2294 begin
2298 // alas
2303 var
2305 begin
2306 // find record data
2309 begin
2310 // first record
2315 if (fld.mType <> fld.TType.TList) then raise TDynRecException.CreateFmt('cannot append record of type ''%s'' due to name conflict with ordinary field', [atypename]);
2316 // append
2318 begin
2327 var
2329 begin
2335 begin
2343 var
2346 begin
2348 begin
2359 // number of records of the given instance
2361 var
2363 begin
2371 var
2374 begin
2375 if not mHeader then raise TDynRecException.Create('cannot create new records with non-header');
2376 if (Length(aid) = 0) then raise TDynRecException.CreateFmt('cannot create new record of type ''%s'' without id', [atypename]);
2379 // check if aid is unique
2381 if (fld <> nil) and (fld.getListItem(aid) <> nil) then raise TDynRecException.CreateFmt('cannot create record of type ''%s'' with duplicate id ''%s''', [atypename, aid]);
2390 var
2392 begin
2397 var
2399 begin
2405 // remove record with the given type and id
2406 // return `true` if record was successfully found and removed
2407 // this will do all necessary recref cleanup too
2409 var
2414 begin
2426 begin
2428 begin
2438 var
2440 begin
2447 var
2449 begin
2452 begin
2453 if (Length(aname) = 0) then raise TDynRecException.Create('cannot create nameless user field');
2458 end
2459 else
2460 begin
2467 var
2470 begin
2472 begin
2475 begin
2477 begin
2481 if isForTrig[tdn] then raise TDynParseException.CreateFmt(pr, 'duplicate trigdata ''%s'' trigtype ''%s''', [mTypeName, tdn]);
2485 end
2486 else
2487 begin
2493 end
2494 else
2495 begin
2498 begin
2501 begin
2502 if (mSize > 0) then raise TDynParseException.CreateFmt(pr, 'duplicate `size` in record ''%s''', [mTypeName]);
2504 if (mSize < 1) then raise TDynParseException.CreateFmt(pr, 'invalid record ''%s'' size: %d', [mTypeName, mSize]);
2506 continue;
2509 begin
2510 if (mBinBlock >= 0) then raise TDynParseException.CreateFmt(pr, 'duplicate `binblock` in record ''%s''', [mTypeName]);
2512 if (mBinBlock < 1) then raise TDynParseException.CreateFmt(pr, 'invalid record ''%s'' binblock: %d', [mTypeName, mBinBlock]);
2513 continue;
2516 begin
2517 if (Length(mTip) > 0) then raise TDynParseException.CreateFmt(pr, 'duplicate tip definition for record ''%s''', [mTypeName]);
2519 continue;
2522 begin
2523 if (Length(mHelp) > 0) then raise TDynParseException.CreateFmt(pr, 'duplicate help definition for record ''%s''', [mTypeName]);
2525 continue;
2531 // load fields
2533 begin
2535 // append
2538 begin
2542 // done with field
2549 var
2551 begin
2553 begin
2554 // trigger data
2557 begin
2560 begin
2565 end
2566 else
2567 begin
2570 end
2571 else
2572 begin
2573 // record
2580 begin
2590 var
2602 var
2605 begin
2606 //writeln('*** rec: ', rec.mName, '.', rec.mId, ' (', rec.mFields.count, ')');
2608 begin
2610 begin
2612 continue;
2618 begin
2619 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);
2620 //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]);
2622 //writeln(' ', rec.mName, '.', rec.mId, ':', fld.mName, ' -> ', rt.mName, '.', rt.mId, ' (', fld.mEBSTypeName, '.', fld.mRecRefId, ')');
2628 begin
2629 //writeln(' ', fld.mName);
2634 begin
2637 try
2639 begin
2640 // parse map file as sequence of blocks
2644 // parse blocks
2646 begin
2652 if (bsize < 0) or (bsize > $1fffffff) then raise TDynRecException.CreateFmt('block of type %d has invalid size %d', [btype, bsize]);
2653 if loaded[btype] then raise TDynRecException.CreateFmt('block of type %d already loaded', [btype]);
2655 // find record type for this block
2658 if (rect = nil) then raise TDynRecException.CreateFmt('block of type %d has no corresponding record', [btype]);
2659 //writeln('found type ''', rec.mName, ''' for block type ', btype);
2660 if (rec.mSize = 0) or ((bsize mod rec.mSize) <> 0) then raise TDynRecException.CreateFmt('block of type %d has invalid number of records', [btype]);
2661 // header?
2663 begin
2664 if (bsize <> mSize) then raise TDynRecException.CreateFmt('header block of type %d has invalid number of records', [btype]);
2669 end
2670 else
2671 begin
2672 // create list for this type
2677 begin
2681 begin
2688 //writeln('parsed ''', rec.mId, '''...');
2694 //st.position := st.position+bsize;
2696 // link fields
2698 begin
2702 exit;
2705 // read fields
2707 if (mSize < 1) then raise TDynRecException.CreateFmt('cannot read record of type ''%s'' with unknown size', [mTypeName]);
2711 begin
2714 if (fld.mBinOfs >= st.size) then raise TDynRecException.CreateFmt('record of type ''%s'' has invalid field ''%s''', [fld.mName]);
2716 //writeln('parsing ''', mName, '.', fld.mName, '''...');
2719 finally
2726 procedure TDynRecord.writeBinTo (var hasLostData: Boolean; st: TStream; trigbufsz: Integer=-1; onlyFields: Boolean=false);
2727 var
2735 begin
2737 begin
2738 if (mBinBlock < 1) then raise TDynRecException.Create('cannot write binary record without block number');
2741 end
2742 else
2743 begin
2746 try
2751 // write normal fields
2753 begin
2754 // record list?
2758 begin
2760 continue;
2762 if (fld.mBinOfs >= bufsz) then raise TDynRecException.Create('binary value offset is outside of the buffer');
2764 //writeln('writing field <', fld.mName, '>');
2768 // write block with normal fields
2770 begin
2771 //writeln('writing header...');
2772 // signature and version
2783 // write other blocks, if any
2785 begin
2786 // calculate blkmax
2789 begin
2790 // record list?
2792 begin
2800 // write blocks
2802 begin
2806 begin
2807 // record list?
2809 begin
2818 // flush block
2820 begin
2831 // write end marker
2836 finally
2844 var
2849 begin
2851 begin
2858 try
2860 begin
2861 // record list?
2863 begin
2866 begin
2869 begin
2872 begin
2875 begin
2885 end
2886 else
2887 begin
2894 continue;
2901 finally
2909 {$IF DEFINED(D2D_DYNREC_PROFILER)}
2910 var
2921 begin
2923 writeln('record cloning: ', profCloneRec div 1000, '.', profCloneRec mod 1000, ' milliseconds');
2924 writeln('findRecType : ', profFindRecType div 1000, '.', profFindRecType mod 1000, ' milliseconds');
2925 writeln('field[] : ', profFieldSearching div 1000, '.', profFieldSearching mod 1000, ' milliseconds');
2926 writeln('list dup check: ', profListDupChecking div 1000, '.', profListDupChecking mod 1000, ' milliseconds');
2927 writeln('addRecByType : ', profAddRecByType div 1000, '.', profAddRecByType mod 1000, ' milliseconds');
2928 writeln('field valparse: ', profFieldValParsing div 1000, '.', profFieldValParsing mod 1000, ' milliseconds');
2929 writeln('fix defaults : ', profFixDefaults div 1000, '.', profFixDefaults mod 1000, ' milliseconds');
2930 writeln('recvalparse : ', profRecValParse div 1000, '.', profRecValParse mod 1000, ' milliseconds');
2932 {$ENDIF}
2936 var
2940 {$IF DEFINED(D2D_DYNREC_PROFILER)}
2942 {$ENDIF}
2945 var
2948 begin
2949 //writeln('*** rec: ', rec.mName, '.', rec.mId, ' (', rec.mFields.count, ')');
2951 begin
2953 begin
2955 continue;
2961 begin
2962 //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);
2963 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]);
2965 //writeln(' ', rec.mName, '.', rec.mId, ':', fld.mName, ' -> ', rt.mName, '.', rt.mId, ' (', fld.mEBSTypeName, '.', fld.mRecRefId, ')');
2971 begin
2972 //writeln(' ', fld.mName);
2977 begin
2978 if (mOwner = nil) then raise TDynParseException.CreateFmt(pr, 'can''t parse record ''%s'' value without owner', [mTypeName]);
2982 // not a header?
2984 begin
2985 // id?
2987 end
2988 else
2989 begin
2993 //writeln('parsing record <', mName, '>');
2996 begin
2998 //writeln('<', mName, '.', pr.tokStr, '>');
3000 // records
3002 begin
3003 // add records with this type (if any)
3008 begin
3013 // on error, it will be freed by memowner
3019 continue;
3023 // fields
3025 //writeln('0: <', mName, '.', pr.tokStr, '>');
3027 //writeln('1: <', mName, '.', pr.tokStr, '>');
3030 begin
3031 //writeln('2: <', mName, '.', pr.tokStr, '>');
3032 if fld.defined then raise TDynParseException.CreateFmt(pr, 'duplicate field ''%s'' in record ''%s''', [fld.mName, mTypeName]);
3033 if fld.internal then raise TDynParseException.CreateFmt(pr, 'internal field ''%s'' in record ''%s''', [fld.mName, mTypeName]);
3035 //writeln('3: <', mName, '.', pr.tokStr, '>:', pr.tokType);
3039 continue;
3042 // something is wrong
3043 raise TDynParseException.CreateFmt(pr, 'unknown field ''%s'' in record ''%s''', [pr.tokStr, mTypeName]);
3048 begin
3049 // link fields
3051 begin
3057 // fix field defaults
3061 //writeln('done parsing record <', mName, '>');
3062 //{$IF DEFINED(D2D_DYNREC_PROFILER)}writeln('stall: ', curTimeMicro()-stall);{$ENDIF}
3067 // ////////////////////////////////////////////////////////////////////////// //
3069 begin
3076 begin
3083 begin
3096 begin
3099 begin
3108 begin
3114 var
3116 begin
3123 var
3125 begin
3129 // fields
3132 begin
3136 begin
3140 end
3141 else
3142 begin
3147 // max field
3154 var
3156 begin
3158 // fields
3160 begin
3167 var
3169 begin
3171 begin
3179 var
3185 begin
3193 begin
3195 begin
3196 if (Length(mTip) > 0) then raise TDynParseException.CreateFmt(pr, 'duplicate tip definition for enum/bitset ''%s''', [mTypeName]);
3198 continue;
3201 begin
3202 if (Length(mHelp) > 0) then raise TDynParseException.CreateFmt(pr, 'duplicate help definition for enum/bitset ''%s''', [mTypeName]);
3204 continue;
3206 break;
3210 begin
3213 begin
3214 if StrEqu(mIds[f], idname) then raise TDynParseException.CreateFmt(pr, 'duplicate field ''%s'' in enum/bitset ''%s''', [idname, mTypeName]);
3216 if StrEqu(mMaxName, idname) then raise TDynParseException.CreateFmt(pr, 'duplicate field ''%s'' in enum/bitset ''%s''', [idname, mTypeName]);
3220 // has value?
3222 begin
3224 begin
3225 if (Length(mMaxName) > 0) then raise TDynParseException.CreateFmt(pr, 'duplicate max field ''%s'' in enum/bitset ''%s''', [idname, mTypeName]);
3228 end
3229 else
3230 begin
3236 // append it?
3238 begin
3239 // fix maxvalue
3241 begin
3248 // next cv
3250 begin
3259 // add max field
3261 begin
3270 // ////////////////////////////////////////////////////////////////////////// //
3272 begin
3281 var
3284 begin
3285 //!!!FIXME!!! check who owns trigs and recs!
3300 begin
3307 var
3309 begin
3311 begin
3319 var
3321 begin
3323 begin
3331 var
3333 begin
3335 begin
3343 var
3348 // setup header links and type links
3350 var
3352 begin
3355 begin
3360 begin
3362 if (fld.mEBSType = nil) then raise TDynParseException.CreateFmt(pr, 'field ''%s'' of type ''%s'' has no correcponding record definition', [fld.mName, fld.mEBSTypeName]);
3366 begin
3368 if (fld.mEBSType = nil) then raise TDynParseException.CreateFmt(pr, 'field ''%s'' of type ''%s'' has no correcponding enum/bitset', [fld.mName, fld.mEBSTypeName]);
3369 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]);
3375 // setup default values
3377 var
3379 begin
3383 begin
3386 begin
3390 begin
3391 // enum or bitset
3393 begin
3396 begin
3402 //writeln(eb.definition); writeln;
3403 continue;
3406 // triggerdata
3408 begin
3411 begin
3413 begin
3420 //writeln(dr.definition); writeln;
3421 continue;
3426 //writeln(dr.definition); writeln;
3427 if (findRecType(rec.typeName) <> nil) then begin rec.Free(); raise TDynParseException.CreateFmt(pr, 'duplicate record ''%s''', [rec.typeName]); end;
3428 if (hdr <> nil) and StrEqu(rec.typeName, hdr.typeName) then begin rec.Free(); raise TDynParseException.CreateFmt(pr, 'duplicate record ''%s''', [rec.typeName]); end;
3431 begin
3432 if (hdr <> nil) then begin rec.Free(); raise TDynParseException.CreateFmt(pr, 'duplicate header record ''%s'' (previous is ''%s'')', [rec.typeName, hdr.typeName]); end;
3434 end
3435 else
3436 begin
3441 // put header record to top
3442 if (hdr = nil) then raise TDynParseException.Create(pr, 'header definition not found in mapdef');
3447 // setup header links and type links
3451 // setup default values
3457 // ////////////////////////////////////////////////////////////////////////// //
3459 var
3461 begin
3463 try
3470 finally
3477 var
3479 begin
3481 try
3487 finally
3493 // WARNING! stream must be seekable
3495 var
3498 begin
3504 begin
3506 begin
3509 exit;
3512 end
3513 else
3514 begin
3516 try
3517 try
3522 finally
3529 // returns `true` if the given stream can be a map file
3530 // stream position is 0 on return
3531 // WARNING! stream must be seekable
3533 var
3536 begin
3541 begin
3543 end
3544 else
3545 begin
3556 var
3558 begin
3560 result += '// ////////////////////////////////////////////////////////////////////////// //'#10;
3567 function TDynMapDef.getRecTypeAt (idx: Integer): TDynRecord; inline; begin if (idx >= 0) and (idx < recTypes.count) then result := recTypes[idx] else result := nil; end;
3570 function TDynMapDef.getEBSTypeAt (idx: Integer): TDynEBS; inline; begin if (idx >= 0) and (idx < ebsTypes.count) then result := ebsTypes[idx] else result := nil; end;
3572 function TDynMapDef.getTrigTypeCount (): Integer; inline; begin result := trigTypes.count; end;
3573 function TDynMapDef.getTrigTypeAt (idx: Integer): TDynRecord; inline; begin if (idx >= 0) and (idx < trigTypes.count) then result := trigTypes[idx] else result := nil; end;