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!
215 // record, either with actual values, or with type definitions
217 private
223 {$IF DEFINED(XDYNREC_USE_FIELDHASH)}
225 {$ENDIF}
229 mHeaderRec: TDynRecord; // for "value" records this is header record with data, for "type" records this is header type record
231 // for userdata
237 private
260 protected
263 function addRecordByType (const atypename: AnsiString; rc: TDynRecord): Boolean; // `true`: duplicate record id
268 public
273 // clone this record; register all list records in `registerIn`
274 // "registration" is required to manage record lifetime; use header record if in doubt
275 // all fields are cloned too
278 // compare records (values of all fields, including trigdata)
279 // WARNING: won't work for records with list fields
282 // find field with `TriggerType` type
285 // number of records of the given instance
288 // only for headers: create new record with the given type
289 // will return cloned record ready for use, or `nil` on unknown type name
290 // `aid` must not be empty, and must be unique
293 // remove record with the given type and id
294 // return `true` if record was successfully found and removed
295 // this will do all necessary recref cleanup too
296 // WARNING: not tested yet
299 //TODO:
300 // [.] API to create triggers
301 // [.] API to properly remove triggers (remove trigdata)
302 // [.] check if `removeTypedRecord()` does the right thing with inline records
303 // [.] for fields: assigning `recref` should remove previously assigned inline record (record without id)
304 // [.] other API i forgot
306 public
307 // text parser
308 // `beginEaten`: `true` if "{" was eaten
311 // text writer
312 // `putHeader`: `true` to write complete header, otherwise only "{...}"
315 // binary parser and writer (DO NOT USE!)
317 procedure writeBinTo (var hasLostData: Boolean; st: TStream; trigbufsz: Integer=-1; onlyFields: Boolean=false);
319 public
323 property has[const aname: AnsiString]: Boolean read hasByName; // do we have field with the given name?
325 property field[const aname: AnsiString]: TDynField read getFieldByName; default; // get field by name
328 property isForTrig[const aname: AnsiString]: Boolean read getIsForTrig; // can this "TriggerData" be used for the trigger with the given type?
329 property forTrigCount: Integer read getForTrigCount; // number of trigger type names for "TriggerData"
330 property forTrigAt[idx: Integer]: AnsiString read getForTrigAt; // trigger type name at the given index for "TriggerData"
331 property headerRec: TDynRecord read mHeaderRec; // get header record for this one (header contains all other records, enums, bitsets, etc.)
334 public
335 // user fields; user can add arbitrary custom fields
336 // by default, any user field will be marked as "internal"
337 // note: you can use this to manipulate non-user fields too
340 public
341 // userdata (you can use these properties as you want to; they won't be written or read to files)
347 // bitset/enum definition
349 private
358 private
370 public
374 // find name for the given value
375 // return empty string if not found
378 public
387 // parsed "mapdef.txt"
389 public
394 private
408 // creates new header record
411 // creates new header record
414 public
422 public
423 // parse text or binary map, return new header record
424 // WARNING! stream must be seekable
427 // returns `true` if the given stream can be a map file
428 // stream position is 0 on return
429 // WARNING! stream must be seekable
432 public
433 // the following functions are here only for 'mapgen'! DO NOT USE!
436 public
438 // for record types
442 // for enum/bitset types
446 // for trigtypes
453 {$IF DEFINED(D2D_DYNREC_PROFILER)}
455 {$ENDIF}
458 implementation
460 uses
461 e_log
465 // ////////////////////////////////////////////////////////////////////////// //
469 // ////////////////////////////////////////////////////////////////////////// //
471 begin
476 begin
481 // ////////////////////////////////////////////////////////////////////////// //
483 begin
484 if (pr <> nil) then begin tokLine := pr.tokLine; tokCol := pr.tokCol; end else begin tokLine := 0; tokCol := 0; end;
488 constructor TDynParseException.CreateFmt (pr: TTextParser; const afmt: AnsiString; const args: array of const);
489 begin
490 if (pr <> nil) then begin tokLine := pr.tokLine; tokCol := pr.tokCol; end else begin tokLine := 0; tokCol := 0; end;
495 // ////////////////////////////////////////////////////////////////////////// //
497 begin
498 //result := TListEnumerator.Create(mRVal);
499 if (mRVal <> nil) then result := mRVal.GetEnumerator else result := TDynRecList.TEnumerator.Create(nil, 0);
503 // ////////////////////////////////////////////////////////////////////////// //
505 begin
513 begin
521 begin
529 begin
553 else
557 begin
594 begin
601 begin
639 var
641 begin
651 begin
684 var
687 begin
689 begin
690 if firstUp then result := UpCase1251(mAlias[1])+Copy(mAlias, 2, Length(mAlias)-1) else result := mAlias;
691 end
692 else
693 begin
697 begin
707 var
709 begin
711 TEBS.TNone: raise TDynRecException.CreateFmt('cannot set refrec for non-reference field ''%s''', [mName]);
713 begin
715 begin
717 if (trc = nil) then raise TDynRecException.CreateFmt('cannot set refrec for field ''%s'' (type conflict: improperly initialized field)', [mName]);
718 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]);
722 exit;
724 TEBS.TEnum: raise TDynRecException.CreateFmt('cannot set refrec for enum field ''%s''', [mName]);
725 TEBS.TBitSet: raise TDynRecException.CreateFmt('cannot set refrec for bitset field ''%s''', [mName]);
732 begin
748 else result := Unassigned; raise TDynRecException.Create('ketmar forgot to handle some field type');
755 begin
779 else
783 begin
794 varString:
796 begin
798 end
799 else
800 begin
804 varBoolean:
816 else
821 varByte,
822 varWord,
823 varShortInt,
824 varSmallint,
825 varInteger:
827 varInt64:
830 else
832 varLongWord:
833 if (val > LongWord($7FFFFFFF)) then raise TDynRecException.Create('cannot convert longword variant to field value')
843 // won't work for lists
845 begin
863 begin
873 var
875 begin
877 try
879 finally
886 var
892 begin
894 begin
899 end
900 else
901 begin
907 try
914 finally
926 // default value should be parsed
928 begin
931 begin
933 raise TDynRecException.CreateFmt('field ''%s'' in record ''%s'' of record type ''%s'' is not set', [mName, mOwner.mId, mOwner.mTypeName]);
943 // default value should be parsed
945 begin
958 begin
964 begin
965 if (mRVal <> nil) and (idx >= 0) and (idx < mRVal.count) then result := mRVal[idx] else result := nil;
970 var
972 begin
978 begin
981 begin
989 var
991 begin
994 begin
997 // fix hash and list
999 begin
1009 begin
1030 begin
1040 TEBS.TBitSet: begin result += ' bitset '; if mBitSetUnique then result += 'unique '; result += mEBSTypeName; end;
1045 begin
1046 if (mType = TType.TPoint) then begin if (mAsT) then result += ' as txy' else result += ' as xy'; end
1047 else if (mType = TType.TSize) then begin if (mAsT) then result += ' as twh' else result += ' as wh'; end;
1055 var
1074 begin
1100 begin
1102 begin
1103 if (Length(fldtype) > 0) then raise TDynParseException.CreateFmt(pr, 'duplicate type definition for field ''%s''', [fldname]);
1108 begin
1110 // arbitrary limits
1111 if (lmaxdim < 1) or (lmaxdim > 32768) then raise TDynParseException.CreateFmt(pr, 'invalid field ''%s'' array size', [fldname]);
1113 end;
1114 continue;
1118 begin
1119 if (Length(xalias) > 0) then raise TDynParseException.CreateFmt(pr, 'duplicate alias definition for field ''%s''', [fldname]);
1121 continue;
1125 begin
1126 if (fldofs >= 0) then raise TDynParseException.CreateFmt(pr, 'duplicate field ''%s'' offset', [fldname]);
1128 if (fldofs < 0) then raise TDynParseException.CreateFmt(pr, 'invalid field ''%s'' offset', [fldname]);
1129 continue;
1133 begin
1140 continue;
1141 end;
1144 begin
1146 if (Length(fldrecname) <> 0) then raise TDynParseException.CreateFmt(pr, 'field ''%s'' already typed as ''%s''', [fldname, fldrecname]);
1148 continue;
1152 begin
1154 if (Length(fldrecname) <> 0) then raise TDynParseException.CreateFmt(pr, 'field ''%s'' already typed as ''%s''', [fldname, fldrecname]);
1157 continue;
1161 begin
1162 if hasdefStr or hasdefInt or hasdefId then raise TDynParseException.CreateFmt(pr, 'field ''%s'' has duplicate default', [fldname]);
1165 begin
1170 begin
1175 begin
1180 begin
1187 else
1190 continue;
1194 begin
1196 continue;
1200 begin
1202 continue;
1205 // record type, no special modifiers
1206 if (pr.tokType <> pr.TTId) then raise TDynParseException.CreateFmt(pr, 'field ''%s'' has something unexpected in definition', [fldname]);
1208 if (Length(fldrecname) <> 0) then raise TDynParseException.CreateFmt(pr, 'field ''%s'' already typed as ''%s''', [fldname, fldrecname]);
1215 // create field
1230 else
1231 begin
1232 // record types defaults to int
1234 begin
1236 end
1237 else
1238 begin
1239 if (Length(fldtype) = 0) then raise TDynParseException.CreateFmt(pr, 'field ''%s'' has no type', [fldname])
1240 else raise TDynParseException.CreateFmt(pr, 'field ''%s'' has invalid type ''%s''', [fldname, fldtype]);
1244 // check for valid arrays
1245 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]);
1247 // check for valid trigdata or record type
1249 begin
1250 // trigdata
1251 if (lmaxdim < 1) then raise TDynParseException.CreateFmt(pr, 'field ''%s'' of type ''%s'' cannot be non-array', [fldname, 'trigdata']);
1252 if (Length(fldrecname) > 0) then raise TDynParseException.CreateFmt(pr, 'field ''%s'' of type ''%s'' cannot have another type', [fldname, 'trigdata']);
1254 end
1256 begin
1257 // record
1258 if not (mType in [TType.TByte, TType.TUByte, TType.TShort, TType.TUShort, TType.TInt, TType.TUInt]) then
1259 begin
1260 raise TDynParseException.CreateFmt(pr, 'field ''%s'' of record type ''%s'' cannot have type ''%s''', [fldname, fldrecname, fldtype]);
1264 // setup default value
1268 begin
1286 end;
1290 begin
1297 var
1303 begin
1307 begin
1309 begin
1310 // this must be triggerdata
1312 begin
1313 raise TDynRecException.CreateFmt('record reference type ''%s'' in field ''%s'' cannot be written', [mEBSTypeName, mName]);
1315 // write triggerdata
1317 if (buf = nil) then raise TDynRecException.CreateFmt('record reference type ''%s'' in field ''%s'' cannot be written', [mEBSTypeName, mName]);
1318 try
1321 begin
1326 finally
1330 exit;
1332 // record reference
1340 else raise TDynRecException.CreateFmt('record reference type ''%s'' in field ''%s'' cannot be written', [mEBSTypeName, mName]);
1342 // find record number
1344 begin
1346 if (f < 0) then raise TDynRecException.CreateFmt('record reference type ''%s'' in field ''%s'' not found in record list', [mEBSTypeName, mName]);
1348 if (f > maxv) then raise TDynRecException.CreateFmt('record reference type ''%s'' in field ''%s'' has too big index', [mEBSTypeName, mName]);
1349 end
1350 else
1351 begin
1358 else raise TDynRecException.CreateFmt('record reference type ''%s'' in field ''%s'' cannot be written', [mEBSTypeName, mName]);
1360 exit;
1369 begin
1371 begin
1373 end
1374 else
1375 begin
1378 exit;
1381 begin
1382 if (mMaxDim = 0) then raise TDynRecException.CreateFmt('invalid string size definition for field ''%s''', [mName]);
1384 begin
1385 if (Length(mSVal) <> 1) then raise TDynRecException.CreateFmt('invalid string size definition for field ''%s''', [mName]);
1387 end
1388 else
1389 begin
1390 if (Length(mSVal) > mMaxDim) then raise TDynRecException.CreateFmt('invalid string size definition for field ''%s''', [mName]);
1395 exit;
1399 begin
1400 // triggerdata array was processed earlier
1401 if (mMaxDim >= 0) then TDynRecException.CreateFmt('byte array in field ''%s'' cannot be written', [mName]);
1403 exit;
1407 begin
1408 if (mMaxDim >= 0) then raise TDynRecException.CreateFmt('short array in field ''%s'' cannot be written', [mName]);
1410 exit;
1414 begin
1415 if (mMaxDim >= 0) then raise TDynRecException.CreateFmt('int array in field ''%s'' cannot be written', [mName]);
1417 exit;
1420 begin
1424 begin
1425 if (mMaxDim >= 0) then raise TDynRecException.CreateFmt('pos/size array in field ''%s'' cannot be written', [mName]);
1428 exit;
1431 begin
1432 if (mMaxDim >= 0) then raise TDynRecException.CreateFmt('pos/size array in field ''%s'' cannot be written', [mName]);
1435 exit;
1447 var
1451 begin
1457 begin
1459 begin
1461 end
1463 begin
1465 end
1466 else
1467 begin
1471 exit;
1474 begin
1475 //def := mOwner.mOwner;
1476 //es := def.ebsType[mEBSTypeName];
1479 if (es = nil) or (not es.mIsEnum) then raise TDynRecException.CreateFmt('record enum type ''%s'' for field ''%s'' not found', [mEBSTypeName, mName]);
1481 begin
1483 begin
1486 exit;
1489 raise TDynRecException.CreateFmt('value %d in record enum type ''%s'' for field ''%s'' not found', [mIVal, mEBSTypeName, mName]);
1492 begin
1493 //def := mOwner.mOwner;
1494 //es := def.ebsType[mEBSTypeName];
1497 if (es = nil) or es.mIsEnum then raise TDynRecException.CreateFmt('record bitset type ''%s'' for field ''%s'' not found', [mEBSTypeName, mName]);
1498 // none?
1500 begin
1502 begin
1504 begin
1507 exit;
1510 raise TDynRecException.CreateFmt('value %d in record bitset type ''%s'' for field ''%s'' not found', [0, mEBSTypeName, mName]);
1512 // not none
1516 begin
1518 begin
1521 begin
1523 begin
1527 break;
1530 if not found then raise TDynRecException.CreateFmt('value %d in record bitset type ''%s'' for field ''%s'' not found', [mask, mEBSTypeName, mName]);
1535 exit;
1542 begin
1544 exit;
1547 begin
1548 if (mMaxDim = 0) then raise TDynRecException.CreateFmt('invalid string size definition for field ''%s''', [mName]);
1551 exit;
1559 begin
1561 exit;
1564 begin
1567 exit;
1571 begin
1573 exit;
1576 begin
1578 exit;
1581 begin
1583 exit;
1592 var
1599 begin
1603 begin
1604 // this must be triggerdata
1606 begin
1609 // find trigger definition
1611 if (tfld = nil) then raise TDynRecException.CreateFmt('triggerdata value for field ''%s'' in record ''%s'' without TriggerType field', [mName, rec.mTypeName]);
1613 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]);
1616 // on error, it will be freed by memowner
1620 exit;
1621 end
1622 else
1623 begin
1624 // not a trigger data
1632 else raise TDynRecException.CreateFmt('invalid non-numeric type ''%s'' for field ''%s'' of record ''%s''', [getTypeName(mType), mName, mEBSTypeName]);
1638 exit;
1642 begin
1651 else raise TDynRecException.CreateFmt('invalid non-numeric type ''%s'' for field ''%s'' of record ''%s''', [getTypeName(mType), mName, mEBSTypeName]);
1655 if (es = nil) or (es.mIsEnum <> (mEBS = TEBS.TEnum)) then raise TDynRecException.CreateFmt('record enum type ''%s'' for field ''%s'' not found', [mEBSTypeName, mName]);
1657 // build enum/bitfield values
1659 begin
1661 if (Length(mSVal) = 0) then raise TDynRecException.CreateFmt('record enum type ''%s'' for field ''%s'' has invalid value %d', [mEBSTypeName, mName, mIVal]);
1662 end
1663 else
1664 begin
1665 // special for 'none'
1667 begin
1669 if (Length(mSVal) = 0) then raise TDynRecException.CreateFmt('record bitset type ''%s'' for field ''%s'' has invalid value %d', [mEBSTypeName, mName, mIVal]);
1670 end
1671 else
1672 begin
1676 begin
1678 begin
1680 if (Length(s) = 0) then raise TDynRecException.CreateFmt('record bitset type ''%s'' for field ''%s'' has invalid value %d', [mEBSTypeName, mName, mask]);
1688 //writeln('ebs <', es.mName, '>: ', mSVal);
1690 exit;
1697 begin
1703 exit;
1706 begin
1708 begin
1710 end
1711 else
1712 begin
1715 try
1720 begin
1725 finally
1730 exit;
1739 begin
1741 exit;
1744 begin
1748 exit;
1751 begin
1755 exit;
1758 begin
1760 exit;
1763 begin
1765 exit;
1776 begin
1778 if (mIVal < min) or (mIVal > max) then raise TDynParseException.CreateFmt(pr, 'invalid %s value for field ''%s''', [getTypeName(mType), mName]);
1782 var
1788 begin
1791 // if this field should contain struct, convert type and parse struct
1795 begin
1796 // ugly hack. sorry.
1798 begin
1801 begin
1802 // '{}'
1805 end
1806 else
1807 begin
1809 // find trigger definition
1811 if (tfld = nil) then raise TDynParseException.CreateFmt(pr, 'triggerdata value for field ''%s'' in record ''%s'' without ''type'' field', [mName, rec.mTypeName]);
1813 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]);
1816 //writeln(rc.definition);
1817 // on error, it will be freed by memowner
1823 exit;
1825 // other record types
1827 begin
1829 begin
1831 end
1832 else
1833 begin
1836 begin
1838 end
1839 else
1840 begin
1848 exit;
1849 end
1851 begin
1852 //rec := mOwner.mOwner.recType[mEBSTypeName]; // find in mapdef
1855 if (rec = nil) then raise TDynParseException.CreateFmt(pr, 'record type ''%s'' for field ''%s'' not found', [mEBSTypeName, mName]);
1862 begin
1863 raise TDynParseException.CreateFmt(pr, 'duplicate record with id ''%s'' for field ''%s'' in record ''%s''', [rc.mId, mName, mOwner.mTypeName]);
1866 exit;
1871 begin
1872 //es := mOwner.mOwner.ebsType[mEBSTypeName]; // find in mapdef
1875 if (es = nil) or (not es.mIsEnum) then raise TDynParseException.CreateFmt(pr, 'record enum type ''%s'' for field ''%s'' not found', [mEBSTypeName, mName]);
1877 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]);
1880 //writeln('ENUM ', mEBSName, '; element <', mSVal, '> with value ', mIVal);
1883 exit;
1886 begin
1887 //es := mOwner.mOwner.ebsType[mEBSTypeName]; // find in mapdef
1890 if (es = nil) or es.mIsEnum then raise TDynParseException.CreateFmt(pr, 'record bitset type ''%s'' for field ''%s'' not found', [mEBSTypeName, mName]);
1893 begin
1895 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]);
1899 if mBitSetUnique then raise TDynParseException.CreateFmt(pr, 'record bitset of type ''%s'' for field ''%s'' expects only one value', [tk, mEBSTypeName, mName]);
1904 exit;
1911 begin
1917 exit;
1920 begin
1921 if (mMaxDim = 0) then raise TDynParseException.CreateFmt(pr, 'invalid string size definition for field ''%s''', [mName]);
1924 begin
1925 // single char
1926 if (Length(mSVal) <> 1) then raise TDynParseException.CreateFmt(pr, 'invalid string size for field ''%s''', [mName]);
1929 end
1930 else
1931 begin
1932 // string
1933 if (Length(mSVal) > mMaxDim) then raise TDynParseException.CreateFmt(pr, 'invalid string size for field ''%s''', [mName]);
1937 exit;
1940 begin
1943 exit;
1946 begin
1949 exit;
1952 begin
1955 exit;
1958 begin
1961 exit;
1964 begin
1967 exit;
1970 begin
1973 exit;
1976 begin
1980 exit;
1984 begin
1988 begin
1989 if (mIVal < 0) or (mIVal > 32767) then raise TDynParseException.CreateFmt(pr, 'invalid %s value for field ''%s''', [getTypeName(mType), mName]);
1993 begin
1994 if (mIVal2 < 0) or (mIVal2 > 32767) then raise TDynParseException.CreateFmt(pr, 'invalid %s value for field ''%s''', [getTypeName(mType), mName]);
1999 exit;
2002 begin
2004 exit;
2007 begin
2009 exit;
2017 // ////////////////////////////////////////////////////////////////////////// //
2019 begin
2020 if (pr = nil) then raise TDynParseException.Create(pr, 'cannot create record type without type definition');
2025 {$IF DEFINED(XDYNREC_USE_FIELDHASH)}
2027 {$ENDIF}
2039 begin
2043 {$IF DEFINED(XDYNREC_USE_FIELDHASH)}
2045 {$ENDIF}
2056 var
2059 begin
2061 begin
2063 begin
2065 begin
2066 //writeln(formatstrf('freeing: 0x%08x; name=%s; id=%s', [Pointer(rec), rec.mName, rec.mId]));
2077 {$IF DEFINED(XDYNREC_USE_FIELDHASH)}
2080 {$ENDIF}
2090 begin
2092 begin
2100 begin
2103 {$IF DEFINED(XDYNREC_USE_FIELDHASH)}
2105 {$ENDIF}
2109 function TDynRecord.addFieldChecked (fld: TDynField): Boolean; inline; // `true`: duplicate name
2110 begin
2113 {$IF not DEFINED(XDYNREC_USE_FIELDHASH)}
2115 {$ENDIF}
2117 {$IF DEFINED(XDYNREC_USE_FIELDHASH)}
2119 {$ENDIF}
2124 begin
2125 {$IF DEFINED(XDYNREC_USE_FIELDHASH)}
2127 {$ELSE}
2130 begin
2135 {$ENDIF}
2140 begin
2146 var
2148 begin
2155 begin
2161 begin
2167 begin
2173 var
2175 begin
2183 begin
2189 begin
2195 var
2198 begin
2210 begin
2221 var
2224 begin
2227 // find record data
2230 if (fld.mType <> fld.TType.TList) then raise TDynRecException.CreateFmt('cannot get record of type ''%s'' due to name conflict with ordinary field', [atypename]);
2231 // find by id
2233 begin
2236 // alas
2240 function TDynRecord.findRecordNumByType (const atypename: AnsiString; rc: TDynRecord): Integer;
2241 var
2244 begin
2246 // find record data
2249 if (fld.mType <> fld.TType.TList) then raise TDynRecException.CreateFmt('cannot get record of type ''%s'' due to name conflict with ordinary field', [atypename]);
2250 // find by ref
2252 begin
2254 begin
2258 // alas
2263 var
2265 begin
2266 // find record data
2269 begin
2270 // first record
2275 if (fld.mType <> fld.TType.TList) then raise TDynRecException.CreateFmt('cannot append record of type ''%s'' due to name conflict with ordinary field', [atypename]);
2276 // append
2278 begin
2287 var
2289 begin
2295 begin
2303 var
2306 begin
2308 begin
2319 // number of records of the given instance
2321 var
2323 begin
2331 var
2334 begin
2335 if not mHeader then raise TDynRecException.Create('cannot create new records with non-header');
2336 if (Length(aid) = 0) then raise TDynRecException.CreateFmt('cannot create new record of type ''%s'' without id', [atypename]);
2339 // check if aid is unique
2341 if (fld <> nil) and (fld.getListItem(aid) <> nil) then raise TDynRecException.CreateFmt('cannot create record of type ''%s'' with duplicate id ''%s''', [atypename, aid]);
2350 var
2352 begin
2357 var
2359 begin
2365 // remove record with the given type and id
2366 // return `true` if record was successfully found and removed
2367 // this will do all necessary recref cleanup too
2369 var
2374 begin
2386 begin
2388 begin
2398 var
2400 begin
2407 var
2409 begin
2412 begin
2413 if (Length(aname) = 0) then raise TDynRecException.Create('cannot create nameless user field');
2418 end
2419 else
2420 begin
2427 var
2430 begin
2432 begin
2435 begin
2437 begin
2441 if isForTrig[tdn] then raise TDynParseException.CreateFmt(pr, 'duplicate trigdata ''%s'' trigtype ''%s''', [mTypeName, tdn]);
2445 end
2446 else
2447 begin
2453 end
2454 else
2455 begin
2458 begin
2461 begin
2462 if (mSize > 0) then raise TDynParseException.CreateFmt(pr, 'duplicate `size` in record ''%s''', [mTypeName]);
2464 if (mSize < 1) then raise TDynParseException.CreateFmt(pr, 'invalid record ''%s'' size: %d', [mTypeName, mSize]);
2466 continue;
2469 begin
2470 if (mBinBlock >= 0) then raise TDynParseException.CreateFmt(pr, 'duplicate `binblock` in record ''%s''', [mTypeName]);
2472 if (mBinBlock < 1) then raise TDynParseException.CreateFmt(pr, 'invalid record ''%s'' binblock: %d', [mTypeName, mBinBlock]);
2473 continue;
2479 // load fields
2481 begin
2483 // append
2486 begin
2490 // done with field
2497 var
2499 begin
2501 begin
2502 // trigger data
2505 begin
2508 begin
2513 end
2514 else
2515 begin
2518 end
2519 else
2520 begin
2521 // record
2528 begin
2538 var
2550 var
2553 begin
2554 //writeln('*** rec: ', rec.mName, '.', rec.mId, ' (', rec.mFields.count, ')');
2556 begin
2558 begin
2560 continue;
2566 begin
2567 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);
2568 //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]);
2570 //writeln(' ', rec.mName, '.', rec.mId, ':', fld.mName, ' -> ', rt.mName, '.', rt.mId, ' (', fld.mEBSTypeName, '.', fld.mRecRefId, ')');
2576 begin
2577 //writeln(' ', fld.mName);
2582 begin
2585 try
2587 begin
2588 // parse map file as sequence of blocks
2592 // parse blocks
2594 begin
2600 if (bsize < 0) or (bsize > $1fffffff) then raise TDynRecException.CreateFmt('block of type %d has invalid size %d', [btype, bsize]);
2601 if loaded[btype] then raise TDynRecException.CreateFmt('block of type %d already loaded', [btype]);
2603 // find record type for this block
2606 if (rect = nil) then raise TDynRecException.CreateFmt('block of type %d has no corresponding record', [btype]);
2607 //writeln('found type ''', rec.mName, ''' for block type ', btype);
2608 if (rec.mSize = 0) or ((bsize mod rec.mSize) <> 0) then raise TDynRecException.CreateFmt('block of type %d has invalid number of records', [btype]);
2609 // header?
2611 begin
2612 if (bsize <> mSize) then raise TDynRecException.CreateFmt('header block of type %d has invalid number of records', [btype]);
2617 end
2618 else
2619 begin
2620 // create list for this type
2625 begin
2629 begin
2636 //writeln('parsed ''', rec.mId, '''...');
2642 //st.position := st.position+bsize;
2644 // link fields
2646 begin
2650 exit;
2653 // read fields
2655 if (mSize < 1) then raise TDynRecException.CreateFmt('cannot read record of type ''%s'' with unknown size', [mTypeName]);
2659 begin
2662 if (fld.mBinOfs >= st.size) then raise TDynRecException.CreateFmt('record of type ''%s'' has invalid field ''%s''', [fld.mName]);
2664 //writeln('parsing ''', mName, '.', fld.mName, '''...');
2667 finally
2674 procedure TDynRecord.writeBinTo (var hasLostData: Boolean; st: TStream; trigbufsz: Integer=-1; onlyFields: Boolean=false);
2675 var
2683 begin
2685 begin
2686 if (mBinBlock < 1) then raise TDynRecException.Create('cannot write binary record without block number');
2689 end
2690 else
2691 begin
2694 try
2699 // write normal fields
2701 begin
2702 // record list?
2706 begin
2708 continue;
2710 if (fld.mBinOfs >= bufsz) then raise TDynRecException.Create('binary value offset is outside of the buffer');
2712 //writeln('writing field <', fld.mName, '>');
2716 // write block with normal fields
2718 begin
2719 //writeln('writing header...');
2720 // signature and version
2731 // write other blocks, if any
2733 begin
2734 // calculate blkmax
2737 begin
2738 // record list?
2740 begin
2748 // write blocks
2750 begin
2754 begin
2755 // record list?
2757 begin
2766 // flush block
2768 begin
2779 // write end marker
2784 finally
2792 var
2797 begin
2799 begin
2806 try
2808 begin
2809 // record list?
2811 begin
2814 begin
2817 begin
2820 begin
2823 begin
2833 end
2834 else
2835 begin
2842 continue;
2849 finally
2857 {$IF DEFINED(D2D_DYNREC_PROFILER)}
2858 var
2869 begin
2871 writeln('record cloning: ', profCloneRec div 1000, '.', profCloneRec mod 1000, ' milliseconds');
2872 writeln('findRecType : ', profFindRecType div 1000, '.', profFindRecType mod 1000, ' milliseconds');
2873 writeln('field[] : ', profFieldSearching div 1000, '.', profFieldSearching mod 1000, ' milliseconds');
2874 writeln('list dup check: ', profListDupChecking div 1000, '.', profListDupChecking mod 1000, ' milliseconds');
2875 writeln('addRecByType : ', profAddRecByType div 1000, '.', profAddRecByType mod 1000, ' milliseconds');
2876 writeln('field valparse: ', profFieldValParsing div 1000, '.', profFieldValParsing mod 1000, ' milliseconds');
2877 writeln('fix defaults : ', profFixDefaults div 1000, '.', profFixDefaults mod 1000, ' milliseconds');
2878 writeln('recvalparse : ', profRecValParse div 1000, '.', profRecValParse mod 1000, ' milliseconds');
2880 {$ENDIF}
2884 var
2888 {$IF DEFINED(D2D_DYNREC_PROFILER)}
2890 {$ENDIF}
2893 var
2896 begin
2897 //writeln('*** rec: ', rec.mName, '.', rec.mId, ' (', rec.mFields.count, ')');
2899 begin
2901 begin
2903 continue;
2909 begin
2910 //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);
2911 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]);
2913 //writeln(' ', rec.mName, '.', rec.mId, ':', fld.mName, ' -> ', rt.mName, '.', rt.mId, ' (', fld.mEBSTypeName, '.', fld.mRecRefId, ')');
2919 begin
2920 //writeln(' ', fld.mName);
2925 begin
2926 if (mOwner = nil) then raise TDynParseException.CreateFmt(pr, 'can''t parse record ''%s'' value without owner', [mTypeName]);
2930 // not a header?
2932 begin
2933 // id?
2935 end
2936 else
2937 begin
2941 //writeln('parsing record <', mName, '>');
2944 begin
2946 //writeln('<', mName, '.', pr.tokStr, '>');
2948 // records
2950 begin
2951 // add records with this type (if any)
2956 begin
2961 // on error, it will be freed by memowner
2967 continue;
2971 // fields
2973 //writeln('0: <', mName, '.', pr.tokStr, '>');
2975 //writeln('1: <', mName, '.', pr.tokStr, '>');
2978 begin
2979 //writeln('2: <', mName, '.', pr.tokStr, '>');
2980 if fld.defined then raise TDynParseException.CreateFmt(pr, 'duplicate field ''%s'' in record ''%s''', [fld.mName, mTypeName]);
2981 if fld.internal then raise TDynParseException.CreateFmt(pr, 'internal field ''%s'' in record ''%s''', [fld.mName, mTypeName]);
2983 //writeln('3: <', mName, '.', pr.tokStr, '>:', pr.tokType);
2987 continue;
2990 // something is wrong
2991 raise TDynParseException.CreateFmt(pr, 'unknown field ''%s'' in record ''%s''', [pr.tokStr, mTypeName]);
2996 begin
2997 // link fields
2999 begin
3005 // fix field defaults
3009 //writeln('done parsing record <', mName, '>');
3010 //{$IF DEFINED(D2D_DYNREC_PROFILER)}writeln('stall: ', curTimeMicro()-stall);{$ENDIF}
3015 // ////////////////////////////////////////////////////////////////////////// //
3017 begin
3024 begin
3031 begin
3042 begin
3045 begin
3054 begin
3060 var
3062 begin
3069 var
3071 begin
3075 // fields
3078 begin
3082 begin
3086 end
3087 else
3088 begin
3093 // max field
3100 var
3102 begin
3104 // fields
3106 begin
3113 var
3115 begin
3117 begin
3125 var
3131 begin
3140 begin
3143 begin
3144 if StrEqu(mIds[f], idname) then raise TDynParseException.CreateFmt(pr, 'duplicate field ''%s'' in enum/bitset ''%s''', [idname, mTypeName]);
3146 if StrEqu(mMaxName, idname) then raise TDynParseException.CreateFmt(pr, 'duplicate field ''%s'' in enum/bitset ''%s''', [idname, mTypeName]);
3150 // has value?
3152 begin
3154 begin
3155 if (Length(mMaxName) > 0) then raise TDynParseException.CreateFmt(pr, 'duplicate max field ''%s'' in enum/bitset ''%s''', [idname, mTypeName]);
3158 end
3159 else
3160 begin
3166 // append it?
3168 begin
3169 // fix maxvalue
3171 begin
3178 // next cv
3180 begin
3189 // add max field
3191 begin
3200 // ////////////////////////////////////////////////////////////////////////// //
3202 begin
3211 var
3214 begin
3215 //!!!FIXME!!! check who owns trigs and recs!
3230 begin
3237 var
3239 begin
3241 begin
3249 var
3251 begin
3253 begin
3261 var
3263 begin
3265 begin
3273 var
3278 // setup header links and type links
3280 var
3282 begin
3285 begin
3290 begin
3292 if (fld.mEBSType = nil) then raise TDynParseException.CreateFmt(pr, 'field ''%s'' of type ''%s'' has no correcponding record definition', [fld.mName, fld.mEBSTypeName]);
3296 begin
3298 if (fld.mEBSType = nil) then raise TDynParseException.CreateFmt(pr, 'field ''%s'' of type ''%s'' has no correcponding enum/bitset', [fld.mName, fld.mEBSTypeName]);
3299 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]);
3305 // setup default values
3307 var
3309 begin
3313 begin
3316 begin
3320 begin
3321 // enum or bitset
3323 begin
3326 begin
3332 //writeln(eb.definition); writeln;
3333 continue;
3336 // triggerdata
3338 begin
3341 begin
3343 begin
3350 //writeln(dr.definition); writeln;
3351 continue;
3356 //writeln(dr.definition); writeln;
3357 if (findRecType(rec.typeName) <> nil) then begin rec.Free(); raise TDynParseException.CreateFmt(pr, 'duplicate record ''%s''', [rec.typeName]); end;
3358 if (hdr <> nil) and StrEqu(rec.typeName, hdr.typeName) then begin rec.Free(); raise TDynParseException.CreateFmt(pr, 'duplicate record ''%s''', [rec.typeName]); end;
3361 begin
3362 if (hdr <> nil) then begin rec.Free(); raise TDynParseException.CreateFmt(pr, 'duplicate header record ''%s'' (previous is ''%s'')', [rec.typeName, hdr.typeName]); end;
3364 end
3365 else
3366 begin
3371 // put header record to top
3372 if (hdr = nil) then raise TDynParseException.Create(pr, 'header definition not found in mapdef');
3377 // setup header links and type links
3381 // setup default values
3387 // ////////////////////////////////////////////////////////////////////////// //
3389 var
3391 begin
3393 try
3400 finally
3407 var
3409 begin
3411 try
3417 finally
3423 // WARNING! stream must be seekable
3425 var
3428 begin
3434 begin
3436 begin
3439 exit;
3442 end
3443 else
3444 begin
3446 try
3447 try
3452 finally
3459 // returns `true` if the given stream can be a map file
3460 // stream position is 0 on return
3461 // WARNING! stream must be seekable
3463 var
3466 begin
3471 begin
3473 end
3474 else
3475 begin
3486 var
3488 begin
3490 result += '// ////////////////////////////////////////////////////////////////////////// //'#10;
3497 function TDynMapDef.getRecTypeAt (idx: Integer): TDynRecord; inline; begin if (idx >= 0) and (idx < recTypes.count) then result := recTypes[idx] else result := nil; end;
3500 function TDynMapDef.getEBSTypeAt (idx: Integer): TDynEBS; inline; begin if (idx >= 0) and (idx < ebsTypes.count) then result := ebsTypes[idx] else result := nil; end;
3502 function TDynMapDef.getTrigTypeCount (): Integer; inline; begin result := trigTypes.count; end;
3503 function TDynMapDef.getTrigTypeAt (idx: Integer): TDynRecord; inline; begin if (idx >= 0) and (idx < trigTypes.count) then result := trigTypes[idx] else result := nil; end;