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
38 // this is base type for all scalars (and arrays)
40 public
41 type
42 TType = (TBool, TChar, TByte, TUByte, TShort, TUShort, TInt, TUInt, TString, TPoint, TSize, TList, TTrigData);
43 // TPoint: pair of Integers
44 // TSize: pair of UShorts
45 // TList: actually, array of records
46 // TTrigData: array of mMaxDim bytes, but internally a record (mRecRef)
47 // in binary: arrays of chars are pascal shortstrings (with counter in the first byte)
49 private
50 type
53 private
73 mAsMonsterId: Boolean; // special hack for triggers: monster record number+1 in binary (so 0 means "none")
74 // default value
81 mEBSType: TObject; // either TDynRecord or TDynEBS; nil means "simple type"; nil for `TTrigData` too
83 // for binary parser
86 // for userdata
90 // for pasgen
93 private
98 procedure parseDefaultValue (); // parse `mDefUnparsed` to `mDefSVal`, `mDefIVal`, `mDefIVal2`, `mDefRecRef`
113 protected
114 // returns `true` for duplicate record id
117 public
125 // build "alias name" for pascal code
138 // won't work for lists
145 public
163 property recrefIndex: Integer read getRecRefIndex; // search for this record in header; -1: not found
164 // for lists
167 property items[const aname: AnsiString]: TDynRecord read getListItem; default; // alas, FPC 3+ lost property overloading feature
168 // userdata
171 //
176 // "value" header record contains TList fields, with name equal to record type
178 private
184 {$IF DEFINED(XDYNREC_USE_FIELDHASH)}
186 {$ENDIF}
190 mHeaderRec: TDynRecord; // for "value" records this is header record with data, for "type" records this is header type record
192 // for userdata
198 private
215 protected
218 function addRecordByType (const atypename: AnsiString; rc: TDynRecord): Boolean; // `true`: duplicate record id
223 public
240 // find field with `TriggerType` type
243 // number of records of the given instance
249 public
253 //property fields: TDynFieldList read mFields;
264 // userdata
267 // userfields
272 private
281 private
290 public
297 // return empty string if not found
300 public
309 public
314 private
322 public
332 // creates new header record
335 // creates new header record
338 public
345 {$IF DEFINED(D2D_DYNREC_PROFILER)}
347 {$ENDIF}
350 implementation
352 uses
353 SysUtils, e_log
357 // ////////////////////////////////////////////////////////////////////////// //
361 // ////////////////////////////////////////////////////////////////////////// //
363 begin
364 //result := TListEnumerator.Create(mRVal);
365 if (mRVal <> nil) then result := mRVal.GetEnumerator else result := TDynRecList.TEnumerator.Create(nil, 0);
369 // ////////////////////////////////////////////////////////////////////////// //
371 begin
379 begin
387 begin
395 begin
419 else
423 begin
460 begin
467 begin
505 var
507 begin
517 begin
550 var
553 begin
555 begin
556 if firstUp then result := UpCase1251(mAlias[1])+Copy(mAlias, 2, Length(mAlias)-1) else result := mAlias;
557 end
558 else
559 begin
563 begin
573 begin
574 //FIXME: check type
581 begin
604 begin
628 else
632 begin
643 varString:
645 begin
647 end
648 else
649 begin
653 varBoolean:
665 else
670 varByte,
671 varWord,
672 varShortInt,
673 varSmallint,
674 varInteger:
676 varInt64:
679 else
681 varLongWord:
682 if (val > LongWord($7FFFFFFF)) then raise Exception.Create('cannot convert longword variant to field value')
692 // won't work for lists
694 begin
712 begin
722 var
724 begin
726 try
728 finally
735 var
741 begin
743 begin
748 end
749 else
750 begin
756 try
763 finally
775 // default value should be parsed
777 begin
780 begin
782 raise Exception.Create(Format('field ''%s'' in record ''%s'' of record type ''%s'' is not set', [mName, mOwner.mId, mOwner.mName]));
792 // default value should be parsed
794 begin
807 begin
813 begin
814 if (mRVal <> nil) and (idx >= 0) and (idx < mRVal.count) then result := mRVal[idx] else result := nil;
819 var
821 begin
827 begin
830 begin
838 begin
859 begin
869 TEBS.TBitSet: begin result += ' bitset '; if mBitSetUnique then result += 'unique '; result += mEBSTypeName; end;
874 begin
875 if (mType = TType.TPoint) then begin if (mAsT) then result += ' as txy' else result += ' as xy'; end
876 else if (mType = TType.TSize) then begin if (mAsT) then result += ' as twh' else result += ' as wh'; end;
884 var
903 begin
929 begin
931 begin
932 if (Length(fldtype) > 0) then raise Exception.Create(Format('duplicate type definition for field ''%s''', [fldname]));
937 begin
939 // arbitrary limits
940 if (lmaxdim < 1) or (lmaxdim > 32768) then raise Exception.Create(Format('invalid field ''%s'' array size', [fldname]));
942 end;
943 continue;
947 begin
948 if (Length(xalias) > 0) then raise Exception.Create(Format('duplicate alias definition for field ''%s''', [fldname]));
950 continue;
954 begin
955 if (fldofs >= 0) then raise Exception.Create(Format('duplicate field ''%s'' offset', [fldname]));
958 continue;
962 begin
969 continue;
970 end;
973 begin
975 if (Length(fldrecname) <> 0) then raise Exception.Create(Format('field ''%s'' already typed as ''%s''', [fldname, fldrecname]));
977 continue;
981 begin
983 if (Length(fldrecname) <> 0) then raise Exception.Create(Format('field ''%s'' already typed as ''%s''', [fldname, fldrecname]));
986 continue;
990 begin
991 if hasdefStr or hasdefInt or hasdefId then raise Exception.Create(Format('field ''%s'' has duplicate default', [fldname]));
994 begin
999 begin
1004 begin
1009 begin
1016 else
1019 continue;
1023 begin
1025 continue;
1029 begin
1031 continue;
1034 // record type, no special modifiers
1035 if (pr.tokType <> pr.TTId) then raise Exception.Create(Format('field ''%s'' has something unexpected in definition', [fldname]));
1037 if (Length(fldrecname) <> 0) then raise Exception.Create(Format('field ''%s'' already typed as ''%s''', [fldname, fldrecname]));
1044 // create field
1059 else
1060 begin
1061 // record types defaults to int
1063 begin
1065 end
1066 else
1067 begin
1068 if (Length(fldtype) = 0) then raise Exception.Create(Format('field ''%s'' has no type', [fldname]))
1069 else raise Exception.Create(Format('field ''%s'' has invalid type ''%s''', [fldname, fldtype]));
1073 // check for valid arrays
1074 if (lmaxdim > 0) and (mType <> TType.TChar) and (mType <> TType.TTrigData) then raise Exception.Create(Format('field ''%s'' of type ''%s'' cannot be array', [fldname, fldtype]));
1076 // check for valid trigdata or record type
1078 begin
1079 // trigdata
1080 if (lmaxdim < 1) then raise Exception.Create(Format('field ''%s'' of type ''%s'' cannot be non-array', [fldname, 'trigdata']));
1081 if (Length(fldrecname) > 0) then raise Exception.Create(Format('field ''%s'' of type ''%s'' cannot have another type', [fldname, 'trigdata']));
1083 end
1085 begin
1086 // record
1087 if not (mType in [TType.TByte, TType.TUByte, TType.TShort, TType.TUShort, TType.TInt, TType.TUInt]) then
1088 begin
1089 raise Exception.Create(Format('field ''%s'' of record type ''%s'' cannot have type ''%s''', [fldname, fldrecname, fldtype]));
1093 // setup default value
1097 begin
1115 end;
1119 begin
1126 var
1132 begin
1136 begin
1138 begin
1139 // this must be triggerdata
1141 begin
1142 raise Exception.Create(Format('record reference type ''%s'' in field ''%s'' cannot be written', [mEBSTypeName, mName]));
1144 // write triggerdata
1146 if (buf = nil) then raise Exception.Create(Format('record reference type ''%s'' in field ''%s'' cannot be written', [mEBSTypeName, mName]));
1147 try
1150 begin
1155 finally
1159 exit;
1161 // record reference
1169 else raise Exception.Create(Format('record reference type ''%s'' in field ''%s'' cannot be written', [mEBSTypeName, mName]));
1171 // find record number
1173 begin
1175 if (f < 0) then raise Exception.Create(Format('record reference type ''%s'' in field ''%s'' not found in record list', [mEBSTypeName, mName]));
1177 if (f > maxv) then raise Exception.Create(Format('record reference type ''%s'' in field ''%s'' has too big index', [mEBSTypeName, mName]));
1178 end
1179 else
1180 begin
1187 else raise Exception.Create(Format('record reference type ''%s'' in field ''%s'' cannot be written', [mEBSTypeName, mName]));
1189 exit;
1198 begin
1200 begin
1202 end
1203 else
1204 begin
1207 exit;
1210 begin
1211 if (mMaxDim = 0) then raise Exception.Create(Format('invalid string size definition for field ''%s''', [mName]));
1213 begin
1214 if (Length(mSVal) <> 1) then raise Exception.Create(Format('invalid string size definition for field ''%s''', [mName]));
1216 end
1217 else
1218 begin
1219 if (Length(mSVal) > mMaxDim) then raise Exception.Create(Format('invalid string size definition for field ''%s''', [mName]));
1224 exit;
1228 begin
1229 // triggerdata array was processed earlier
1230 if (mMaxDim >= 0) then Exception.Create(Format('byte array in field ''%s'' cannot be written', [mName]));
1232 exit;
1236 begin
1237 if (mMaxDim >= 0) then raise Exception.Create(Format('short array in field ''%s'' cannot be written', [mName]));
1239 exit;
1243 begin
1244 if (mMaxDim >= 0) then raise Exception.Create(Format('int array in field ''%s'' cannot be written', [mName]));
1246 exit;
1249 begin
1253 begin
1254 if (mMaxDim >= 0) then raise Exception.Create(Format('pos/size array in field ''%s'' cannot be written', [mName]));
1257 exit;
1260 begin
1261 if (mMaxDim >= 0) then raise Exception.Create(Format('pos/size array in field ''%s'' cannot be written', [mName]));
1264 exit;
1267 begin
1269 exit;
1272 begin
1274 exit;
1282 var
1286 begin
1292 begin
1294 begin
1296 end
1298 begin
1300 end
1301 else
1302 begin
1306 exit;
1309 begin
1310 //def := mOwner.mOwner;
1311 //es := def.findEBSType(mEBSTypeName);
1314 if (es = nil) or (not es.mIsEnum) then raise Exception.Create(Format('record enum type ''%s'' for field ''%s'' not found', [mEBSTypeName, mName]));
1316 begin
1318 begin
1321 exit;
1324 raise Exception.Create(Format('value %d in record enum type ''%s'' for field ''%s'' not found', [mIVal, mEBSTypeName, mName]));
1327 begin
1328 //def := mOwner.mOwner;
1329 //es := def.findEBSType(mEBSTypeName);
1332 if (es = nil) or es.mIsEnum then raise Exception.Create(Format('record bitset type ''%s'' for field ''%s'' not found', [mEBSTypeName, mName]));
1333 // none?
1335 begin
1337 begin
1339 begin
1342 exit;
1345 raise Exception.Create(Format('value %d in record bitset type ''%s'' for field ''%s'' not found', [0, mEBSTypeName, mName]));
1347 // not none
1351 begin
1353 begin
1356 begin
1358 begin
1362 break;
1365 if not found then raise Exception.Create(Format('value %d in record bitset type ''%s'' for field ''%s'' not found', [mask, mEBSTypeName, mName]));
1370 exit;
1377 begin
1379 exit;
1382 begin
1383 if (mMaxDim = 0) then raise Exception.Create(Format('invalid string size definition for field ''%s''', [mName]));
1386 exit;
1394 begin
1396 exit;
1399 begin
1402 exit;
1406 begin
1408 exit;
1411 begin
1413 exit;
1416 begin
1418 exit;
1427 var
1434 begin
1438 begin
1439 // this must be triggerdata
1441 begin
1444 // find trigger definition
1446 if (tfld = nil) then raise Exception.Create(Format('triggerdata value for field ''%s'' in record ''%s'' without TriggerType field', [mName, rec.mName]));
1448 if (rc = nil) then raise Exception.Create(Format('triggerdata definition for field ''%s'' in record ''%s'' with type ''%s'' not found', [mName, rec.mName, tfld.mSVal]));
1451 // on error, it will be freed be memowner
1455 exit;
1456 end
1457 else
1458 begin
1459 // not a trigger data
1467 else raise Exception.Create(Format('invalid non-numeric type ''%s'' for field ''%s'' of record ''%s''', [getTypeName(mType), mName, mEBSTypeName]));
1473 exit;
1477 begin
1486 else raise Exception.Create(Format('invalid non-numeric type ''%s'' for field ''%s'' of record ''%s''', [getTypeName(mType), mName, mEBSTypeName]));
1490 if (es = nil) or (es.mIsEnum <> (mEBS = TEBS.TEnum)) then raise Exception.Create(Format('record enum type ''%s'' for field ''%s'' not found', [mEBSTypeName, mName]));
1492 // build enum/bitfield values
1494 begin
1496 if (Length(mSVal) = 0) then raise Exception.Create(Format('record enum type ''%s'' for field ''%s'' has invalid value %d', [mEBSTypeName, mName, mIVal]));
1497 end
1498 else
1499 begin
1500 // special for 'none'
1502 begin
1504 if (Length(mSVal) = 0) then raise Exception.Create(Format('record bitset type ''%s'' for field ''%s'' has invalid value %d', [mEBSTypeName, mName, mIVal]));
1505 end
1506 else
1507 begin
1511 begin
1513 begin
1515 if (Length(s) = 0) then raise Exception.Create(Format('record bitset type ''%s'' for field ''%s'' has invalid value %d', [mEBSTypeName, mName, mask]));
1523 //writeln('ebs <', es.mName, '>: ', mSVal);
1525 exit;
1532 begin
1538 exit;
1541 begin
1543 begin
1545 end
1546 else
1547 begin
1550 try
1555 begin
1560 finally
1565 exit;
1574 begin
1576 exit;
1579 begin
1583 exit;
1586 begin
1590 exit;
1593 begin
1595 exit;
1598 begin
1600 exit;
1611 begin
1613 if (mIVal < min) or (mIVal > max) then raise Exception.Create(Format('invalid %s value for field ''%s''', [getTypeName(mType), mName]));
1617 var
1623 begin
1626 // if this field should contain struct, convert type and parse struct
1630 begin
1631 // ugly hack. sorry.
1633 begin
1636 begin
1637 // '{}'
1640 end
1641 else
1642 begin
1644 // find trigger definition
1646 if (tfld = nil) then raise Exception.Create(Format('triggerdata value for field ''%s'' in record ''%s'' without ''type'' field', [mName, rec.mName]));
1648 if (rc = nil) then raise Exception.Create(Format('triggerdata definition for field ''%s'' in record ''%s'' with type ''%s'' not found', [mName, rec.mName, tfld.mSVal]));
1651 //writeln(rc.definition);
1652 // on error, it will be freed be memowner
1658 exit;
1660 // other record types
1662 begin
1664 begin
1666 end
1667 else
1668 begin
1671 begin
1672 //raise Exception.Create(Format('record ''%s'' (%s) value for field ''%s'' not found', [pr.tokStr, mEBSTypeName, mName]));
1674 end
1675 else
1676 begin
1684 exit;
1685 end
1687 begin
1688 //rec := mOwner.mOwner.findRecType(mEBSTypeName); // find in mapdef
1691 if (rec = nil) then raise Exception.Create(Format('record type ''%s'' for field ''%s'' not found', [mEBSTypeName, mName]));
1698 begin
1699 //raise Exception.Create(Format('record type ''%s'' for field ''%s'' not found', [mEBSTypeName, mName]));
1700 e_LogWritefln('duplicate record with id ''%s'' for field ''%s'' in record ''%s''', [rc.mId, mName, mOwner.mName]);
1703 exit;
1708 begin
1709 //es := mOwner.mOwner.findEBSType(mEBSTypeName); // find in mapdef
1712 if (es = nil) or (not es.mIsEnum) then raise Exception.Create(Format('record enum type ''%s'' for field ''%s'' not found', [mEBSTypeName, mName]));
1714 if not es.has[tk] then raise Exception.Create(Format('record enum value ''%s'' of type ''%s'' for field ''%s'' not found', [tk, mEBSTypeName, mName]));
1717 //writeln('ENUM ', mEBSName, '; element <', mSVal, '> with value ', mIVal);
1720 exit;
1723 begin
1724 //es := mOwner.mOwner.findEBSType(mEBSTypeName); // find in mapdef
1727 if (es = nil) or es.mIsEnum then raise Exception.Create(Format('record bitset type ''%s'' for field ''%s'' not found', [mEBSTypeName, mName]));
1730 begin
1732 if not es.has[tk] then raise Exception.Create(Format('record bitset value ''%s'' of type ''%s'' for field ''%s'' not found', [tk, mEBSTypeName, mName]));
1736 if mBitSetUnique then raise Exception.Create(Format('record bitset of type ''%s'' for field ''%s'' expects only one value', [tk, mEBSTypeName, mName]));
1737 //pr.expectDelim('|');
1742 exit;
1749 begin
1755 exit;
1758 begin
1759 if (mMaxDim = 0) then raise Exception.Create(Format('invalid string size definition for field ''%s''', [mName]));
1762 begin
1763 // single char
1764 if (Length(mSVal) <> 1) then raise Exception.Create(Format('invalid string size for field ''%s''', [mName]));
1767 end
1768 else
1769 begin
1770 // string
1771 if (Length(mSVal) > mMaxDim) then raise Exception.Create(Format('invalid string size for field ''%s''', [mName]));
1775 exit;
1778 begin
1781 exit;
1784 begin
1787 exit;
1790 begin
1793 exit;
1796 begin
1799 exit;
1802 begin
1805 exit;
1808 begin
1811 exit;
1814 begin
1818 exit;
1822 begin
1826 begin
1827 if (mIVal < 0) or (mIVal > 32767) then raise Exception.Create(Format('invalid %s value for field ''%s''', [getTypeName(mType), mName]));
1831 begin
1832 if (mIVal2 < 0) or (mIVal2 > 32767) then raise Exception.Create(Format('invalid %s value for field ''%s''', [getTypeName(mType), mName]));
1837 exit;
1840 begin
1842 exit;
1845 begin
1847 exit;
1855 // ////////////////////////////////////////////////////////////////////////// //
1857 begin
1858 if (pr = nil) then raise Exception.Create('cannot create record type without type definition');
1863 {$IF DEFINED(XDYNREC_USE_FIELDHASH)}
1865 {$ENDIF}
1877 begin
1881 {$IF DEFINED(XDYNREC_USE_FIELDHASH)}
1883 {$ENDIF}
1894 var
1897 begin
1899 begin
1901 begin
1903 begin
1904 //writeln(formatstrf('freeing: 0x%08x; name=%s; id=%s', [Pointer(rec), rec.mName, rec.mId]));
1915 {$IF DEFINED(XDYNREC_USE_FIELDHASH)}
1918 {$ENDIF}
1928 begin
1930 begin
1938 begin
1941 {$IF DEFINED(XDYNREC_USE_FIELDHASH)}
1943 {$ENDIF}
1947 function TDynRecord.addFieldChecked (fld: TDynField): Boolean; inline; // `true`: duplicate name
1948 begin
1951 {$IF not DEFINED(XDYNREC_USE_FIELDHASH)}
1953 {$ENDIF}
1955 {$IF DEFINED(XDYNREC_USE_FIELDHASH)}
1957 {$ENDIF}
1962 begin
1963 {$IF DEFINED(XDYNREC_USE_FIELDHASH)}
1965 {$ELSE}
1968 begin
1973 {$ENDIF}
1978 begin
1984 var
1986 begin
1993 begin
1999 begin
2005 begin
2011 var
2013 begin
2021 begin
2027 begin
2033 var
2036 begin
2048 begin
2059 var
2062 begin
2065 // find record data
2068 if (fld.mType <> fld.TType.TList) then raise Exception.Create(Format('cannot get record of type ''%s'' due to name conflict with ordinary field', [atypename]));
2069 // find by id
2071 begin
2074 // alas
2078 function TDynRecord.findRecordNumByType (const atypename: AnsiString; rc: TDynRecord): Integer;
2079 var
2082 begin
2084 // find record data
2087 if (fld.mType <> fld.TType.TList) then raise Exception.Create(Format('cannot get record of type ''%s'' due to name conflict with ordinary field', [atypename]));
2088 // find by ref
2090 begin
2092 begin
2096 // alas
2101 var
2103 begin
2104 // find record data
2107 begin
2108 // first record
2113 if (fld.mType <> fld.TType.TList) then raise Exception.Create(Format('cannot append record of type ''%s'' due to name conflict with ordinary field', [atypename]));
2114 // append
2116 begin
2125 var
2127 begin
2133 begin
2141 var
2144 begin
2146 begin
2157 // number of records of the given instance
2159 var
2161 begin
2169 var
2171 begin
2178 var
2180 begin
2183 begin
2189 end
2190 else
2191 begin
2198 var
2201 begin
2203 begin
2206 begin
2208 begin
2212 if isForTrig[tdn] then raise Exception.Create(Format('duplicate trigdata ''%s'' trigtype ''%s''', [mName, tdn]));
2216 end
2217 else
2218 begin
2224 end
2225 else
2226 begin
2229 begin
2232 begin
2233 if (mSize > 0) then raise Exception.Create(Format('duplicate `size` in record ''%s''', [mName]));
2235 if (mSize < 1) then raise Exception.Create(Format('invalid record ''%s'' size: %d', [mName, mSize]));
2237 continue;
2240 begin
2241 if (mBinBlock >= 0) then raise Exception.Create(Format('duplicate `binblock` in record ''%s''', [mName]));
2243 if (mBinBlock < 1) then raise Exception.Create(Format('invalid record ''%s'' binblock: %d', [mName, mBinBlock]));
2244 continue;
2250 // load fields
2252 begin
2254 //if hasByName(fld.name) then begin fld.Free(); raise Exception.Create(Format('duplicate field ''%s''', [fld.name])); end;
2255 // append
2258 begin
2262 // done with field
2269 var
2271 begin
2273 begin
2274 // trigger data
2277 begin
2280 begin
2285 end
2286 else
2287 begin
2290 end
2291 else
2292 begin
2293 // record
2300 begin
2310 var
2322 var
2325 begin
2326 //writeln('*** rec: ', rec.mName, '.', rec.mId, ' (', rec.mFields.count, ')');
2328 begin
2330 begin
2332 continue;
2338 begin
2339 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);
2340 //raise Exception.Create(Format('record of type ''%s'' with id ''%s'' links to inexistant record of type ''%s'' with id ''%s''', [rec.mName, rec.mId, fld.mEBSTypeName, fld.mRecRefId]));
2342 //writeln(' ', rec.mName, '.', rec.mId, ':', fld.mName, ' -> ', rt.mName, '.', rt.mId, ' (', fld.mEBSTypeName, '.', fld.mRecRefId, ')');
2348 begin
2349 //writeln(' ', fld.mName);
2354 begin
2357 try
2359 begin
2360 // parse map file as sequence of blocks
2364 // parse blocks
2366 begin
2372 if (bsize < 0) or (bsize > $1fffffff) then raise Exception.Create(Format('block of type %d has invalid size %d', [btype, bsize]));
2373 if loaded[btype] then raise Exception.Create(Format('block of type %d already loaded', [btype]));
2375 // find record type for this block
2378 if (rect = nil) then raise Exception.Create(Format('block of type %d has no corresponding record', [btype]));
2379 //writeln('found type ''', rec.mName, ''' for block type ', btype);
2380 if (rec.mSize = 0) or ((bsize mod rec.mSize) <> 0) then raise Exception.Create(Format('block of type %d has invalid number of records', [btype]));
2381 // header?
2383 begin
2384 if (bsize <> mSize) then raise Exception.Create(Format('header block of type %d has invalid number of records', [btype]));
2389 end
2390 else
2391 begin
2392 // create list for this type
2397 begin
2401 begin
2408 //writeln('parsed ''', rec.mId, '''...');
2414 //st.position := st.position+bsize;
2416 // link fields
2418 begin
2422 exit;
2425 // read fields
2427 if (mSize < 1) then raise Exception.Create(Format('cannot read record of type ''%s'' with unknown size', [mName]));
2431 begin
2434 if (fld.mBinOfs >= st.size) then raise Exception.Create(Format('record of type ''%s'' has invalid field ''%s''', [fld.mName]));
2436 //writeln('parsing ''', mName, '.', fld.mName, '''...');
2439 finally
2446 procedure TDynRecord.writeBinTo (st: TStream; trigbufsz: Integer=-1; onlyFields: Boolean=false);
2447 var
2453 //f, c: Integer;
2456 begin
2458 begin
2459 if (mBinBlock < 1) then raise Exception.Create('cannot write binary record without block number');
2462 end
2463 else
2464 begin
2467 try
2472 // write normal fields
2474 begin
2475 // record list?
2479 if (fld.mBinOfs >= bufsz) then raise Exception.Create('binary value offset is outside of the buffer');
2481 //writeln('writing field <', fld.mName, '>');
2485 // write block with normal fields
2487 begin
2488 //writeln('writing header...');
2489 // signature and version
2500 // write other blocks, if any
2502 begin
2503 // calculate blkmax
2506 begin
2507 // record list?
2509 begin
2517 // write blocks
2519 begin
2523 begin
2524 // record list?
2526 begin
2535 // flush block
2537 begin
2548 // write end marker
2553 finally
2561 var
2564 begin
2566 begin
2573 try
2575 begin
2576 // record list?
2578 begin
2581 begin
2583 begin
2589 continue;
2596 finally
2604 {$IF DEFINED(D2D_DYNREC_PROFILER)}
2605 var
2616 begin
2618 writeln('record cloning: ', profCloneRec div 1000, '.', profCloneRec mod 1000, ' milliseconds');
2619 writeln('findRecType : ', profFindRecType div 1000, '.', profFindRecType mod 1000, ' milliseconds');
2620 writeln('field[] : ', profFieldSearching div 1000, '.', profFieldSearching mod 1000, ' milliseconds');
2621 writeln('list dup check: ', profListDupChecking div 1000, '.', profListDupChecking mod 1000, ' milliseconds');
2622 writeln('addRecByType : ', profAddRecByType div 1000, '.', profAddRecByType mod 1000, ' milliseconds');
2623 writeln('field valparse: ', profFieldValParsing div 1000, '.', profFieldValParsing mod 1000, ' milliseconds');
2624 writeln('fix defaults : ', profFixDefaults div 1000, '.', profFixDefaults mod 1000, ' milliseconds');
2625 writeln('recvalparse : ', profRecValParse div 1000, '.', profRecValParse mod 1000, ' milliseconds');
2627 {$ENDIF}
2631 var
2635 {$IF DEFINED(D2D_DYNREC_PROFILER)}
2637 {$ENDIF}
2640 var
2643 begin
2644 //writeln('*** rec: ', rec.mName, '.', rec.mId, ' (', rec.mFields.count, ')');
2646 begin
2648 begin
2650 continue;
2656 begin
2657 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);
2658 //raise Exception.Create(Format('record of type ''%s'' with id ''%s'' links to inexistant record of type ''%s'' with id ''%s''', [rec.mName, rec.mId, fld.mEBSTypeName, fld.mRecRefId]));
2660 //writeln(' ', rec.mName, '.', rec.mId, ':', fld.mName, ' -> ', rt.mName, '.', rt.mId, ' (', fld.mEBSTypeName, '.', fld.mRecRefId, ')');
2666 begin
2667 //writeln(' ', fld.mName);
2672 begin
2673 if (mOwner = nil) then raise Exception.Create(Format('can''t parse record ''%s'' value without owner', [mName]));
2677 // not a header?
2679 begin
2680 // id?
2682 end
2683 else
2684 begin
2688 //writeln('parsing record <', mName, '>');
2691 begin
2693 //writeln('<', mName, '.', pr.tokStr, '>');
2695 // records
2697 begin
2698 // add records with this type (if any)
2703 begin
2708 // on error, it will be freed be memowner
2711 (*
2712 if (Length(rec.mId) > 0) then
2713 begin
2714 {$IF DEFINED(D2D_DYNREC_PROFILER)}stt := curTimeMicro();{$ENDIF}
2715 fld := field[pr.tokStr];
2716 {$IF DEFINED(D2D_DYNREC_PROFILER)}profFieldSearching := curTimeMicro()-stt;{$ENDIF}
2717 (*
2718 if (fld <> nil) and (fld.mRVal <> nil) then
2719 begin
2720 {$IF DEFINED(D2D_DYNREC_PROFILER)}stt := curTimeMicro();{$ENDIF}
2721 //idtmp := trc.mName+':'+rec.mId;
2722 //if ids.put(idtmp, 1) then raise Exception.Create(Format('duplicate thing ''%s'' in record ''%s''', [fld.mName, mName]));
2723 if fld.mRHash.has(rec.mId) then raise Exception.Create(Format('duplicate thing ''%s'' in record ''%s''', [fld.mName, mName]));
2724 {$IF DEFINED(D2D_DYNREC_PROFILER)}profListDupChecking := curTimeMicro()-stt;{$ENDIF}
2725 end;
2726 end;
2727 *)
2731 continue;
2735 // fields
2737 //writeln('0: <', mName, '.', pr.tokStr, '>');
2739 //writeln('1: <', mName, '.', pr.tokStr, '>');
2742 begin
2743 //writeln('2: <', mName, '.', pr.tokStr, '>');
2744 if fld.defined then raise Exception.Create(Format('duplicate field ''%s'' in record ''%s''', [fld.mName, mName]));
2745 if fld.internal then raise Exception.Create(Format('internal field ''%s'' in record ''%s''', [fld.mName, mName]));
2747 //writeln('3: <', mName, '.', pr.tokStr, '>:', pr.tokType);
2751 continue;
2754 // something is wrong
2760 begin
2761 // link fields
2763 begin
2769 // fix field defaults
2773 //writeln('done parsing record <', mName, '>');
2774 //{$IF DEFINED(D2D_DYNREC_PROFILER)}writeln('stall: ', curTimeMicro()-stall);{$ENDIF}
2779 // ////////////////////////////////////////////////////////////////////////// //
2781 begin
2788 begin
2795 begin
2806 begin
2809 begin
2818 begin
2824 var
2826 begin
2833 var
2835 begin
2839 // fields
2842 begin
2846 begin
2850 end
2851 else
2852 begin
2857 // max field
2864 var
2866 begin
2868 // fields
2870 begin
2877 var
2879 begin
2881 begin
2889 var
2895 begin
2904 begin
2907 begin
2908 if StrEqu(mIds[f], idname) then raise Exception.Create(Format('duplicate field ''%s'' in enum/bitset ''%s''', [idname, mName]));
2910 if StrEqu(mMaxName, idname) then raise Exception.Create(Format('duplicate field ''%s'' in enum/bitset ''%s''', [idname, mName]));
2914 // has value?
2916 begin
2918 begin
2919 if (Length(mMaxName) > 0) then raise Exception.Create(Format('duplicate max field ''%s'' in enum/bitset ''%s''', [idname, mName]));
2922 end
2923 else
2924 begin
2930 // append it?
2932 begin
2933 // fix maxvalue
2935 begin
2942 // next cv
2944 begin
2953 // add max field
2955 begin
2964 // ////////////////////////////////////////////////////////////////////////// //
2966 begin
2975 var
2978 begin
2979 //!!!FIXME!!! check who owns trigs and recs!
2994 begin
3001 var
3003 begin
3005 begin
3013 var
3015 begin
3017 begin
3025 var
3027 begin
3029 begin
3037 var
3042 // setup header links and type links
3044 var
3046 begin
3049 begin
3054 begin
3056 if (fld.mEBSType = nil) then raise Exception.Create(Format('field ''%s'' of type ''%s'' has no correcponding record definition', [fld.mName, fld.mEBSTypeName]));
3060 begin
3062 if (fld.mEBSType = nil) then raise Exception.Create(Format('field ''%s'' of type ''%s'' has no correcponding enum/bitset', [fld.mName, fld.mEBSTypeName]));
3063 if ((fld.mEBS = TDynField.TEBS.TEnum) <> (fld.mEBSType as TDynEBS).mIsEnum) then raise Exception.Create(Format('field ''%s'' of type ''%s'' enum/bitset type conflict', [fld.mName, fld.mEBSTypeName]));
3069 // setup default values
3071 var
3073 begin
3077 begin
3080 begin
3084 begin
3085 // enum or bitset
3087 begin
3090 begin
3096 //writeln(eb.definition); writeln;
3097 continue;
3100 // triggerdata
3102 begin
3105 begin
3107 begin
3114 //writeln(dr.definition); writeln;
3115 continue;
3120 //writeln(dr.definition); writeln;
3121 if (findRecType(rec.name) <> nil) then begin rec.Free(); raise Exception.Create(Format('duplicate record ''%s''', [rec.name])); end;
3122 if (hdr <> nil) and StrEqu(rec.name, hdr.name) then begin rec.Free(); raise Exception.Create(Format('duplicate record ''%s''', [rec.name])); end;
3125 begin
3126 if (hdr <> nil) then begin rec.Free(); raise Exception.Create(Format('duplicate header record ''%s'' (previous is ''%s'')', [rec.name, hdr.name])); end;
3128 end
3129 else
3130 begin
3135 // put header record to top
3141 // setup header links and type links
3145 // setup default values
3151 // ////////////////////////////////////////////////////////////////////////// //
3153 var
3155 begin
3157 try
3164 finally
3171 var
3173 begin
3175 try
3181 finally
3188 var
3190 begin
3192 result += '// ////////////////////////////////////////////////////////////////////////// //'#10;
3198 function TDynMapDef.getTrigTypeCount (): Integer; inline; begin result := trigTypes.count; end;
3199 function TDynMapDef.getTrigTypeAt (idx: Integer): TDynRecord; inline; begin if (idx >= 0) and (idx < trigTypes.count) then result := trigTypes[idx] else result := nil; end;